Where have I gone wrong

General FreeBASIC programming questions.
Post Reply
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Where have I gone wrong

Post by paul doe »

jj2007 wrote: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
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by 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
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Post by 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
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

jj2007 wrote: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
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by 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
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Post by jj2007 »

Gablea wrote:would you use CSV files
Never, they are a big mess. Tab-delimited is much besser.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by 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.
Last edited by grindstone on Sep 21, 2018 14:35, edited 1 time in total.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Post by 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
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

No problems here. Build opions "fbc -s console", WinXP 32bit.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Where have I gone wrong

Post by paul doe »

grindstone wrote: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
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

paul doe wrote: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
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by 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
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Post by jj2007 »

grindstone wrote: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
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Where have I gone wrong

Post by 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
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Where have I gone wrong

Post by jj2007 »

-> see next post
Last edited by jj2007 on Sep 21, 2018 14:25, edited 3 times in total.
Post Reply