Where have I gone wrong

[paul doe]

Works fine, Paul. I tried the same with products.dat, but the NAME field seems to be one byte off for the second and lollowing records:

Mmm, I didn't tried the other one. Perhaps when Gablea provides the structure for 'products.dat' we could have a go at it.

@Gablea: give us the structure from the VB side, so we can decode it too.

[Gablea]

Good morning everyone

Sorry for the Delay just woke up here (7:19am)

as requested here is the structure of the Product database

Code: Select all

Public Structure ProductStructure
    <VBFixedString(13)> Public BarcodeNumber As String
    <VBFixedString(30)> Public posdescription As String
    <VBFixedString(4)> Public salelocation As String
    <VBFixedString(1)> Public agerestricted As Integer
    <VBFixedString(2)> Public agelimit As String
    <VBFixedString(1)> Public pricetype As String
    <VBFixedString(10)> Public retailprice As String
    <VBFixedString(1)> Public vatcode As String
    <VBFixedString(1)> Public print_guarantee_message As Integer
    <VBFixedString(6)> Public print_guarantee_code As String
    <VBFixedString(1)> Public displaymessage As Integer
    <VBFixedString(6)> Public messagenumber As String
    <VBFixedString(1)> Public sendtoppr As Integer
    <VBFixedString(1)> Public requestserial As Integer
    <VBFixedString(1)> Public itemnotallowed As Integer
    <VBFixedString(255)> Public itemnotallowed_reason As String
    <VBFixedString(1)> Public restrict_product_qty As Integer
    <VBFixedString(1)> Public product_qty_allowed As Integer
    <VBFixedString(1)> Public discount_not_allowed As Integer
    <VBFixedString(1)> Public no_refund_allowed As Integer
    <VBFixedString(1)> Public ask_for_qty_before_selling As Integer
    <VBFixedString(1)> Public healthy_start_voucher_ok As Integer
End Structure


[jj2007]

Now it works:

Code: Select all

Product=        376
Product records 2024

BarcodeNumber  [00001293]
posdescription [VACUUM CLEANERS]
salelocation   [0003]
pricetype      [S]
retailprice    [1299]

BarcodeNumber  [000013010]
posdescription [FILTERS]
salelocation   [0004]
pricetype      [L]
retailprice    [070]

BarcodeNumber  [000013210]
posdescription [VACUUM CLEANERS]
salelocation   [0002]
pricetype      [S]
retailprice    [2599]

BarcodeNumber  [000013310]
posdescription [VACUUM CLEANERS]
salelocation   [0002]
pricetype      [S]
retailprice    [399]

It's important to realise that

Code: Select all

<VBFixedString(1)> Public agerestricted As Integer

leads to a field size of 4, not 1.

[grindstone]

It's important to realise that

Code: Select all

<VBFixedString(1)> Public agerestricted As Integer

leads to a field size of 4, not 1.

Thank you for that hint. Now it matches.

The products list as an array of records, with the fields accessed by properties:

Code: Select all

Type tProduct
   Dim record As String
   
   Declare Property BarcodeNumber As String
  Declare Property posdescription As String
  Declare Property salelocation As String
  Declare Property agerestricted As Integer
  Declare Property agelimit As String
   Declare Property pricetype As String
  Declare Property retailprice As String
  Declare Property vatcode As String
  Declare Property print_guarantee_message As Integer
  Declare Property print_guarantee_code As String
  Declare Property displaymessage As Integer
  Declare Property messagenumber As String
  Declare Property sendtoppr As Integer
  Declare Property requestserial As Integer
  Declare Property itemnotallowed As Integer
  Declare Property itemnotallowed_reason As String
  Declare Property restrict_product_qty As Integer
  Declare Property product_qty_allowed As Integer
  Declare Property discount_not_allowed As Integer
  Declare Property no_refund_allowed As Integer
  Declare Property ask_for_qty_before_selling As Integer
  Declare Property healthy_start_voucher_ok As Integer
         
End Type


Property tProduct.BarcodeNumber As String
   Return Mid(this.record, 1, 13)
End Property

Property tProduct.posdescription As String
   Return Mid(this.record, 14, 30)
End Property

Property tProduct.salelocation As String
   Return Mid(this.record, 44, 4)
End Property

Property tProduct.agerestricted As Integer
   Return Val(Mid(this.record, 48, 4))
End Property

Property tProduct.agelimit As String
   Return Mid(this.record, 52, 2)
End Property

Property tProduct.pricetype As String
   Return Mid(this.record, 54, 1)
End Property

Property tProduct.retailprice As String
   Return Mid(this.record, 55, 10)
End Property

Property tProduct.vatcode As String
   Return Mid(this.record, 65, 1)
End Property

Property tProduct.print_guarantee_message As Integer
   Return Val(Mid(this.record, 66, 4))
End Property

Property tProduct.print_guarantee_code As String
   Return Mid(this.record, 70, 6)
End Property

Property tProduct.displaymessage As Integer
   Return Val(Mid(this.record, 76, 4))
End Property

Property tProduct.messagenumber As String
   Return Mid(this.record, 80, 6)
End Property

Property tProduct.sendtoppr As Integer
   Return Val(Mid(this.record, 86, 4))
End Property

Property tProduct.requestserial As Integer
   Return Val(Mid(this.record, 90, 4))
End Property

Property tProduct.itemnotallowed As Integer
   Return Val(Mid(this.record, 94, 4))
End Property

Property tProduct.itemnotallowed_reason As String
   Return Mid(this.record, 98, 255)
End Property

Property tProduct.restrict_product_qty As Integer
   Return Val(Mid(this.record, 353, 4))
End Property

Property tProduct.product_qty_allowed As Integer
   Return Val(Mid(this.record, 357, 4))
End Property

Property tProduct.discount_not_allowed As Integer
   Return Val(Mid(this.record, 361, 4))
End Property

Property tProduct.no_refund_allowed As Integer
   Return Val(Mid(this.record, 365, 4))
End Property

Property tProduct.ask_for_qty_before_selling As Integer
   Return Val(Mid(this.record, 369, 4))
End Property

Property tProduct.healthy_start_voucher_ok As Integer
   Return Val(Mid(this.record, 373, 4))
End Property


ReDim As tProduct product(0)

'read product list into array
Open "products.dat" For Binary Access Read As #1
Do Until Eof(1)
   ReDim Preserve product(UBound(product) + 1)
   product(UBound(product)).record = Input(376, #1)
Loop
Close

'print out product list
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



And analogue, the same with the users list:

Code: Select all

Type tUser
   Dim record As String
   
   Declare Property CashierPassword As String
   Declare Property CashierName As String
   Declare Property CashierNameReceipit As String
   Declare Property ChangePassword As String
   Declare Property RestrictRefund As String
   Declare Property RestrictRefundValue As String
   Declare Property UserCanOverrideLockout As String
   Declare Property useraccesslevel As String
      
End Type

Property tUser.CashierPassword As String
   Return Mid(this.record, 1, 4)
End Property

Property tUser.CashierName As String
   Return Mid(this.record, 5, 255)
End Property

Property tUser.CashierNameReceipit As String
   Return Mid(this.record, 260, 40)
End Property

Property tUser.ChangePassword As String
   Return Mid(this.record, 300, 1)
End Property

Property tUser.RestrictRefund As String
   Return Mid(this.record, 301, 1)
End Property

Property tUser.RestrictRefundValue As String
   Return Mid(this.record, 302, 10)
End Property

Property tUser.UserCanOverrideLockout As String
   Return Mid(this.record, 312, 1)
End Property

Property tUser.useraccesslevel As String
   Return Mid(this.record, 313, 255)
End Property


ReDim As tUser user(0)

'read user list into array
Open "users.dat" For Binary Access Read As #1
Do Until Eof(1)
   ReDim Preserve user(UBound(user) + 1)
   user(UBound(user)).record = Input(571, #1)
Loop
Close

'print out user list
For x As Integer = 1 To UBound(user)
   With user(x)
      Print "        CashierPassword ";.CashierPassword
      Print "            CashierName ";.CashierName
      Print "    CashierNameReceipit ";.CashierNameReceipit
      Print "         ChangePassword ";.CashierNameReceipit
      Print "         RestrictRefund ";.RestrictRefund
      Print "    RestrictRefundValue ";.RestrictRefundValue
      Print " UserCanOverrideLockout ";.UserCanOverrideLockout
      Print "        useraccesslevel ";.useraccesslevel
      Print "---------------------------------------------"
      Sleep
   End With
Next

? "OK"
Sleep



[Gablea]

You guys are amazing.

Does this mean I can use the select case on the ChangePassword and it should work fine now :)

Out of untreated how would you guys update the vb version with data from the FB system (would you use CSV files it would you use things like a ini style file)

The updates could be things like password change stock levels store / recalled sales etc

The database we are using is a MySQL I have tried in the past to connect the FreeBASIC pos to the database but it keep pulling back invalid data (I’ve also got to think about backwards support as some of my customers want to keep the dos tills Going)

[jj2007]

would you use CSV files

Never, they are a big mess. Tab-delimited is much besser.

[grindstone]

With a few modifications you can change every single field in the array simply by writing data to it and then save the array with the same file format (see the file "productsSave.dat" after running the snippet with the modified 1st record).

And -as all fields have the same structure- for simplification of typing the implementation of the properties can be done by a macro:

Code: Select all

#Macro declareproperty(fieldname, retType)
   #If retType = "s"
      Declare Property fieldname As String 'for reading
      Declare Property fieldname(v As String) 'for writing
   #ElseIf retType = "i"
      Declare Property fieldname As Integer 'for reading
      Declare Property fieldname(v As Integer) 'for writing
   #EndIf
#EndMacro

#Macro MakeProperty(fieldname, start, length, retType)
   #If retType = "s"
      Property tProduct.fieldname As String 'for reading
         Return Mid(this.record, start, length)
      End Property
      
      Property tProduct.fieldname(v As String) 'for writing
         Mid(this.record, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tProduct.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
      End Property
      Property tProduct.fieldname(v As Integer) 'for writing
         Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro


Type tProduct
   Dim record As String
   
   declareproperty(BarcodeNumber, "s")
  declareproperty(posdescription, "s")
  declareproperty(salelocation, "s")
  declareproperty(agerestricted, "i")
  declareproperty(agelimit, "s")
   declareproperty(pricetype, "s")
  declareproperty(retailprice, "s")
  declareproperty(vatcode, "s")
  declareproperty(print_guarantee_message, "i")
  declareproperty(print_guarantee_code, "s")
  declareproperty(displaymessage, "i")
  declareproperty(messagenumber, "s")
  declareproperty(sendtoppr, "i")
  declareproperty(requestserial, "i")
  declareproperty(itemnotallowed, "i")
  declareproperty(itemnotallowed_reason, "s")
  declareproperty(restrict_product_qty, "i")
  declareproperty(product_qty_allowed, "i")
  declareproperty(discount_not_allowed, "i")
  declareproperty(no_refund_allowed, "i")
  declareproperty(ask_for_qty_before_selling, "i")
  declareproperty(healthy_start_voucher_ok, "i")
End Type

MakeProperty(BarcodeNumber,                1,  13, "s")
MakeProperty(posdescription,              14,  30, "s")
MakeProperty(salelocation,                44,   4, "s")
MakeProperty(agerestricted,               48,   4, "i")
MakeProperty(agelimit,                    52,   2, "s")
MakeProperty(pricetype,                   54,   1, "s")
MakeProperty(retailprice,                 55,  10, "s")
MakeProperty(vatcode,                     65,   1, "s")
MakeProperty(print_guarantee_message,     66,   4, "i")
MakeProperty(print_guarantee_code,        70,   6, "s")
MakeProperty(displaymessage,              76,   4, "i")
MakeProperty(messagenumber,               80,   6, "s")
MakeProperty(sendtoppr,                   86,   4, "i")
MakeProperty(requestserial,               90,   4, "i")
MakeProperty(itemnotallowed,              94,   4, "i")
MakeProperty(itemnotallowed_reason,       98, 255, "s")
MakeProperty(restrict_product_qty,       353,   4, "i")
MakeProperty(product_qty_allowed,        357,   4, "i")
MakeProperty(discount_not_allowed,       361,   4, "i")
MakeProperty(no_refund_allowed,          365,   4, "i")
MakeProperty(ask_for_qty_before_selling, 369,   4, "i")
MakeProperty(healthy_start_voucher_ok,   373,   4, "i")

ReDim As tProduct product(0)

'read product list into array
Open "products.dat" For Binary Access Read As #1
Do Until Eof(1)
   ReDim Preserve product(UBound(product) + 1)
   product(UBound(product)).record = Input(376, #1)
Loop
Close

'change product no. 1
product(1).BarcodeNumber = "12345"
product(1).posdescription = "WHISKY"
product(1).agerestricted = 18

'save product testfile
Open "productsSave.dat" For Output As #1
For x As Integer = 1 To UBound(product)
   Print #1, product(x).record;
Next
Close

'print out product list
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



Edit: Code updated to fix space issue.

[jj2007]

@grindstone: Does your code build on your machine? Special options needed?

Code: Select all

MakeProperty(BarcodeNumber,                1,  13, "s")
...
error 57: Type mismatch, at parameter 2
...
error 132: Too many errors, exiting

[grindstone]

No problems here. Build opions "fbc -s console", WinXP 32bit.

[paul doe]

No problems here. Build opions "fbc -s console", WinXP 32bit.

Beware of the infamous 'Integer Trap' =D: on 32-bit OSes, an integer is 4 bytes long but on 64-bit ones it's 8 bytes long. Inside the type, the 'integer' needs to be 'long' to avoid issues when saving/loading the file.

[grindstone]

Inside the type, the 'integer' needs to be 'long' to avoid issues when saving/loading the file.

No, because it's converted to a 4 character long string before saving (right-alligned, filled up with zero-bytes).

Code: Select all

Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)

BTW: The maximum "integer" value in this file format is 9999.

[grindstone]

@jj2007: Sorry, but the only way of reproducing a "type mismatch" error here is putting the 1 into quotation marks.

Code: Select all

MakeProperty(BarcodeNumber,                "1",  13, "s")

No clue what's going wrong. Maybe an accidentally keystroke? Perhaps try to copy and paste again.

[jj2007]

Perhaps try to copy and paste again.

No luck, and I have tried three compiler settings (gas-32, gcc-32, gcc-64) that work fine for everything else. The errors happen here, for the "s" variant only:

Code: Select all

Mid(this.record, start, length) = Left(v + String(length, " "), length)

Do I have to update?? FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)

[caseih]

Compiles fine on Linux 64-bit fbc, 1.05. However it will not run. segfaults on one the lines that's assigning to mid(), but I'm not able to determine exactly which line it segfaults on. Somehow with the C code emitter on Linux I've do not have the ability to even step through the code line by line.

Code compiles and runs on Windows 32-bit, though, 1.05 compiler. No compile errors. I just copy and pasted it from the post directly.

[jj2007]

-> see next post