Where have I gone wrong

General FreeBASIC programming questions.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 25, 2018 13:48

@jj2007
That is the sql data dump the csv files will be uploaded tonight once I’m back in the the office. SORRY I though I had uploaded them at the same time
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 25, 2018 23:18

@jj2007

Thank-you for giving me some time to upload the files to the server below is the url you can download the zip file from for all the current data files


http://www.algpos.co.uk/freebasic/DOSData.zip

if you need to to explan any of the files just ask and I will be more then happy to explain them
jj2007
Posts: 1159
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Postby jj2007 » Sep 26, 2018 10:26

Hi Gablea, have a look at the GuiTableControl attachment here. Launch the exe to see your products database. This is just a demo showing what is possible, if you like it we can start arguing how to access your files in FB. Note I will delete that attachment within some days, to protect your privacy.
grindstone
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Postby grindstone » Sep 26, 2018 12:35

jj2007 wrote:if you like it we can start arguing how to access your files in FB.
Nothing could be easier. Of course every data file needs its own Type:

Code: Select all

#Macro declareCommon(typeName)
   Declare Sub init(dataFile As String, thisArray() As typeName)
   Declare Sub saveArray(dataFile As String, thisArray() As typeName)
   Declare Sub addRecord(record As typeName, thisArray() As typeName, place As Integer = 0)
   Declare Sub deleteRecord(recordNumber As Integer, thisArray() As typeName)
#EndMacro


#Macro setCommon(typeName)

Sub typeName.addRecord(record As typeName, thisArray() As typeName, place As Integer = 0)
   
   If place > UBound(thisArray) Then
      Return 'do nothing
   EndIf
   
   ReDim Preserve thisArray(UBound(thisArray) + 1)
   thisArray(UBound(thisArray)) = record 'append new record to the array
   
   If place Then 'shift new record to the desired place
      For x As Integer = UBound(thisArray) To place + 1 Step -1
         Swap thisArray(x), thisArray(x - 1)
      Next
   EndIf
End Sub

Sub typeName.deleteRecord(recordNumber As Integer, thisArray() As typeName)
   
   If (recordNumber < 1) Or (recordNumber > UBound(thisArray)) Then
      Return 'do nothing
   EndIf
   
   For x As Integer = recordNumber + 1 To UBound(thisArray)
      Swap thisArray(x), thisArray(x - 1)
   Next
   
   ReDim Preserve thisArray(UBound(thisArray) - 1)
End Sub
#EndMacro


Type tProducts
   Dim As String BarcodeNumber
  Dim As String posdescription
  Dim As String salelocation
  Dim As String agerestricted
  Dim As String agelimit
   Dim As String pricetype
  Dim As String retailprice
  Dim As String vatcode
  Dim As String print_guarantee_message
  Dim As String print_guarantee_code
  Dim As String displaymessage
  Dim As String messagenumber
  Dim As String sendtoppr
  Dim As String requestserial
  Dim As String itemnotallowed
  Dim As String itemnotallowed_reason
  Dim As String restrict_product_qty
  Dim As String product_qty_allowed
  Dim As String discount_not_allowed
  Dim As String no_refund_allowed
  Dim As String ask_for_qty_before_selling
  Dim As String healthy_start_voucher_ok
       
   declareCommon(tProducts)
         
End Type

Sub tProducts.init(dataFile As String, thisArray() As tProducts)
   Dim As Integer ff, count
   
   ff = FreeFile
   Open datafile For Input Encoding "UTF-8" As #ff
   count = 0
   Do Until Eof(ff)
      count += 1
      ReDim Preserve thisArray(count)
      
      With thisArray(count)
         Input #ff, .BarcodeNumber
        Input #ff, .posdescription
        Input #ff, .salelocation
        Input #ff, .agerestricted
        Input #ff, .agelimit
         Input #ff, .pricetype
        Input #ff, .retailprice
        Input #ff, .vatcode
        Input #ff, .print_guarantee_message
        Input #ff, .print_guarantee_code
        Input #ff, .displaymessage
        Input #ff, .messagenumber
        Input #ff, .sendtoppr
        Input #ff, .requestserial
        Input #ff, .itemnotallowed
        Input #ff, .itemnotallowed_reason
        Input #ff, .restrict_product_qty
        Input #ff, .product_qty_allowed
        Input #ff, .discount_not_allowed
        Input #ff, .no_refund_allowed
        Input #ff, .ask_for_qty_before_selling
        Input #ff, .healthy_start_voucher_ok
      End With 
   Loop
   Close ff
End Sub

Sub tProducts.saveArray(dataFile As String, thisArray() As tProducts)
   Dim As Integer ff
   
   ff = FreeFile
   Open datafile For Output Encoding "UTF-8" As #ff
   For x As Integer = 1 To UBound(thisArray)
      With thisArray(x)
         Print #ff, .BarcodeNumber;",";
        Print #ff, Chr(34);.posdescription;Chr(34);",";
        Print #ff, .salelocation;",";
        Print #ff, .agerestricted;",";
        Print #ff, .agelimit;",";
         Print #ff, .pricetype;",";
        Print #ff, .retailprice;",";
        Print #ff, .vatcode;",";
        Print #ff, .print_guarantee_message;",";
        Print #ff, .print_guarantee_code;",";
        Print #ff, .displaymessage;",";
        Print #ff, .messagenumber;",";
        Print #ff, .sendtoppr;",";
        Print #ff, .requestserial;",";
        Print #ff, .itemnotallowed;",";
        Print #ff, .itemnotallowed_reason;",";
        Print #ff, .restrict_product_qty;",";
        Print #ff, .product_qty_allowed;",";
        Print #ff, .discount_not_allowed;",";
        Print #ff, .no_refund_allowed;",";
        Print #ff, .ask_for_qty_before_selling;",";
        Print #ff, .healthy_start_voucher_ok;
        If x < UBound(thisArray) Then
           Print #ff, ""
        EndIf
      End With 
   Next
   Close ff
End Sub

setCommon(tProducts)


ReDim As tProducts product(0)

product(0).init("productsDB.dat", product())

product(0).saveArray("productsDBsave.dat", product())

For x As Integer = 1 To UBound(product)
   With product(x)
      Print "             BarcodeNumber ";.BarcodeNumber
     Print "            posdescription ";.posdescription
     Print "              salelocation ";.salelocation
     Print "             agerestricted ";.agerestricted
     Print "                  agelimit ";.agelimit
      Print "                 pricetype ";.pricetype
     Print "               retailprice ";.retailprice
     Print "                   vatcode ";.vatcode
     Print "   print_guarantee_message ";.print_guarantee_message
     Print "      print_guarantee_code ";.print_guarantee_code
     Print "            displaymessage ";.displaymessage
     Print "             messagenumber ";.messagenumber
     Print "                 sendtoppr ";.sendtoppr
     Print "             requestserial ";.requestserial
     Print "            itemnotallowed ";.itemnotallowed
     Print "     itemnotallowed_reason ";.itemnotallowed_reason
     Print "      restrict_product_qty ";.restrict_product_qty
     Print "       product_qty_allowed ";.product_qty_allowed
     Print "      discount_not_allowed ";.discount_not_allowed
     Print "         no_refund_allowed ";.no_refund_allowed
     Print "ask_for_qty_before_selling ";.ask_for_qty_before_selling
     Print "  healthy_start_voucher_ok ";.healthy_start_voucher_ok
      Print "--------------------------------------"
      Sleep
   End With
Next

? "OK"
Sleep
End


EDIT: Sep 27. 2018: Added addRecord and deleteRecord.
EDIT 2: Added a macro for common Subs/Functions
Last edited by grindstone on Sep 27, 2018 8:18, edited 2 times in total.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 26, 2018 21:11

grindstone wrote:Nothing could be easier. Of course every data file needs its own Type



@grindstone
Does this store in Memory or is it still stored as a physital file? (and I do read from it like I would any normal data file?

EG
get #ProductDB, RecordNumber, tProduct
grindstone
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Postby grindstone » Sep 26, 2018 23:04

With the "init"-Sub the whole data file is read from the hard drive and put into an array of appropriate Types (one array member for each record), and with the "saveArray"-Sub all records are restored to the hard drive as one file. The array of course is stored in the memory. What you do with this opportunities is up to you. You can work with the array and store it once at the end of the day (if you're an optimist), you can store it after every change you made (if you're a realist), or you can automatically make a backup every 10 minutes (as a compromise or an additional security option). It's a matter of data traffic you can afford.

Accessing a certain record directly on the hard disk is not recommendable (although possible, but quite tricky), because the records all have different lengths.

EG
get #ProductDB, RecordNumber, tProduct
Yes, that's possible. You'll have a number of arrays each representing a certain data file (users(), products(), plulist() and so on). A query would have the format "<variable> = <arrayName>(<recordNumber>).<fieldName>"

Yet to implement are Subs/Functions for adding/deleting records.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 27, 2018 0:27

That’s great so I could run every database in memory

It would also mean if I’m reading what your saying right once the update function is done I could use this to control voids etc as well as mutilsavers

Great it would also be the best of both worlds MS-DOS or Linux front end with windows back end using csv files to communicate between the 2 devices (as csv are universal between operating systems)

Thanks grindstone you have given me a to look at and to work on.

Just one thing how would I clear the array say if a file had been Updated (need to load the new file into memory)
grindstone
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Postby grindstone » Sep 27, 2018 6:49

Gablea wrote:how would I clear the array say if a file had been Updated (need to load the new file into memory)
Simply run "init" again.

...as well as mutilsavers
I guess you mean "mutisavers" = duplicated entries. This could be done, but not as easy as eg. "If product(1) = product(2)". To compare UDTs you'll have to overload the "=" Operator first:

Code: Select all

Operator = (p1 As tProducts, p2 As tProducts) As boolean
   If (p1.BarcodeNumber = p2.BarcodeNumber) AndAlso _
       (p1.posdescription = p2.posdescription) AndAlso _
       (p1.salelocation = p2.salelocation) AndAlso _
       ...
       (p1.healthy_start_voucher_ok = p2.healthy_start_voucher_ok)  Then
      Return TRUE
   Else
      Return FALSE
   EndIf
End Operator
In your case you'll have to compare every member individually and you'll have to overload the "=" seperately for every type. It's possible, but it's a diligence work. (If anyone has an idea how it could be done with less work, please let me know!)

I've added the "addRecord" and "deleteRecord" Subs to the snippet above.
Last edited by grindstone on Sep 27, 2018 7:56, edited 1 time in total.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 27, 2018 7:10

Thanks a million. I know what I’m going to be working on this weekend :P

Have you got a example of how I would find a entry I. The database or would it be the same way as you find with a normal Random file?
grindstone
Posts: 640
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Postby grindstone » Sep 27, 2018 8:04

Gablea wrote:Have you got a example of how I would find a entry I. The database or would it be the same way as you find with a normal Random file?
I don't exactly understand what you mean. But to find eg. "CRANBERRY LIGHT" simply scan the array:

Code: Select all

For x As Integer = 1 To UBound(product)
   With product(x)
      If .posdescription = "CRANBERRY LIGHT" Then
         Print "RECORD # ";x
         Print "             BarcodeNumber ";.BarcodeNumber
        Print "            posdescription ";.posdescription
        Print "              salelocation ";.salelocation
        Print "             agerestricted ";.agerestricted
        Print "                  agelimit ";.agelimit
         Print "                 pricetype ";.pricetype
        Print "               retailprice ";.retailprice
        Print "                   vatcode ";.vatcode
        Print "   print_guarantee_message ";.print_guarantee_message
        Print "      print_guarantee_code ";.print_guarantee_code
        Print "            displaymessage ";.displaymessage
        Print "             messagenumber ";.messagenumber
        Print "                 sendtoppr ";.sendtoppr
        Print "             requestserial ";.requestserial
        Print "            itemnotallowed ";.itemnotallowed
        Print "     itemnotallowed_reason ";.itemnotallowed_reason
        Print "      restrict_product_qty ";.restrict_product_qty
        Print "       product_qty_allowed ";.product_qty_allowed
        Print "      discount_not_allowed ";.discount_not_allowed
        Print "         no_refund_allowed ";.no_refund_allowed
        Print "ask_for_qty_before_selling ";.ask_for_qty_before_selling
        Print "  healthy_start_voucher_ok ";.healthy_start_voucher_ok
         Print "--------------------------------------"
         Sleep
      EndIf
   End With
Next

I know what I’m going to be working on this weekend :P
I wish you a lot of fun. <grin> To spare you typing work, I wrote a macro for some common code. Updated the snippet above.

BTW: Maybe it could be worthwile to write a little program that extracts the field names from your old VB sources and generates the corresponding FB code. This would be easier than even copy & paste.
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 27, 2018 10:37

@grindstone

Thanks you for that example. Now I can work on getting the interface sorted :)
jj2007
Posts: 1159
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Postby jj2007 » Sep 29, 2018 3:15

You may not have seen my Spreadsheets: Reading and accessing a two-dimensional string array post yet. Would it be difficult to let your VB program write tab-delimited instead of csv format?
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 29, 2018 10:09

I can change it and update the files on the server if you want a test file
jj2007
Posts: 1159
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Postby jj2007 » Sep 29, 2018 11:02

I have that testfile already, see the spreadsheets post; I just wondered if it wasn't easier for you to work with the tab-delimited format. The solution I posted there is way faster, and easier to handle, than any other option.

Code: Select all

      for row as integer=0 to records
         if Instr(recstr(row), "WHIRLPOOL") then
            matches+=1
            print "Barcode", Element(row, BarcodeNumber)
            print "Description", Element(row, posdescription)
            print "Price", Element(row, retailprice)
            print
         endif
      next
Gablea
Posts: 1049
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Postby Gablea » Sep 29, 2018 13:10

Is it is tab spaced does that mean if a field has a comer in it it would not crash the system when it read it in?

One of the description was like

FILTER DC19,20,25

Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests