Tweet
Code:
'This is a translation of a sample from
'Visual Basic to Power Basic.
'It compiles fine, but receives an error 11
'(invalid file name) creating the file.
'Does someone have the correct DECLARE statement?
#COMPILE EXE
#REGISTER NONE
#DIM ALL
'Original declare in VB
DECLARE FUNCTION BTRCALL LIB "wbtrv32.dll" (BYVAL OP%,_
BYVAL Pb$,_
Db AS ANY,_
DL AS INTEGER,_
Kb AS ANY,_
BYVAL Kl%,_
BYVAL Kn%) AS INTEGER
DECLARE SUB PrintLb(Msg AS STRING)
' Operation Codes
'===========================================================================
%BOPEN = 0
%BCLOSE = 1
%BINSERT = 2
%BUPDATE = 3
%BDELETE = 4
%BGETEQUAL = 5
%BGETNEXT = 6
%BGETPREV = 7
%BGETGREATER = 8
%BGETGE = 9
%BGETLESS = 10
%BGETLE = 11
%BGETFIRST = 12
%BGETLAST = 13
%BCREATE = 14
%BSTAT = 15
%BGETPOSITION = 22
%BGETDIRECT = 23
%BSTEPNEXT = 24
%BSTOP = 25
%BVERSION = 26
%BUNLOCK = 27
%BRESET = 28
%BSTEPFIRST = 33
%BSTEPLAST = 34
%BSTEPPREV = 35
%BGETPERCENT = 44
%BFINDPERCENT = 45
%BLOCK = 100
%KEY_BUF_LEN = 255
REM Key Flags
%DUP = 1
%MODIFIABLE = 2
%BIN = 4
%NUL = 8
%SEGMENT = 16
%SEQ = 32
%DEC = 64
%SUP = 128
REM Key Types
%EXTTYPE = 256
%MANUAL = 512
%BSTRING = 0
%BINTEGER = 1
%BFLOAT = 2
%BDATE = 3
%BTIME = 4
%BDECIMAL = 5
%BNUMERIC = 8
%BZSTRING = 11
%BAUTOINC = 15
REM ***************************************************************************
REM Btrieve Structures
Type KeySpec
KeyPos AS INTEGER
KeyLen AS INTEGER
KeyFlags AS INTEGER
' KeyTot AS LONG 'may not be in version 5
NotUse AS STRING * 4
KeyType AS STRING * 1
NullValue AS STRING * 1
Reserved AS STRING * 4
END Type
Type FileSpec
RecLen AS INTEGER
PageSize AS INTEGER
IndxCnt AS INTEGER
NotUsed AS STRING * 4
FileFlags AS INTEGER
Reserved AS STRING * 2
Allocation AS INTEGER
KeyBuf0 AS KeySpec
KeyBuf1 AS KeySpec
END Type
Type StatFileSpecs
RecLen AS INTEGER
PageSize AS INTEGER
IndexTot AS INTEGER
RecTot AS LONG
FileFlags AS INTEGER
Reserved AS STRING * 2
UnusedPages AS INTEGER
KeyBuf0 AS KeySpec
KeyBuf1 AS KeySpec
END Type
Type RecordBuffer
Number AS DOUBLE
Dummy AS STRING * 26
END Type
Type VersionBuf
Major AS INTEGER
Minor AS INTEGER
Engine AS STRING * 1
END Type
GLOBAL FileBuf AS FileSpec
GLOBAL DataBuf AS RecordBuffer
GLOBAL StatFileBuffer AS StatFileSpecs
GLOBAL PosBlk AS STRING
GLOBAL BufLen AS INTEGER
GLOBAL DBLen AS INTEGER
SUB RunTest()
PRINTLB "Btrieve Test Started"
REM **************************
DIM FilName AS STRING
DIM KeyBuffer AS STRING
DIM KeyBufLen AS INTEGER
DIM KeyNumber AS INTEGER
DIM Stat AS INTEGER
DIM Msg AS STRING
DIM KeyNum AS INTEGER
DIM x AS LONG
DIM count AS LONG
DIM KBuf#
DIM PatientVar AS STRING 'unsure about this dummy variable
FILNAME$ = "TEST.BTR"
PosBlk = SPACE$(128)
KeyBuffer$ = SPACE$(%KEY_BUF_LEN)
REM
REM ***************** Btrieve CREATE *********************
REM
REM ************* SET UP FILE SPECS
FileBuf.RecLen = 34
FileBuf.PageSize = 1024
FileBuf.IndxCnt = 2
FileBuf.FileFlags = 0
REM ************* SET UP KEY SPECS
FileBuf.KeyBuf0.KeyPos = 1
FileBuf.KeyBuf0.KeyLen = 8
FileBuf.KeyBuf0.KeyFlags = %EXTTYPE + %MODIFIABLE +%DUP
FileBuf.KeyBuf0.KeyType = CHR$(%BFLOAT)
FileBuf.KeyBuf1.KeyPos = 9
FileBuf.KeyBuf1.KeyLen = 26
FileBuf.KeyBuf1.KeyFlags = %EXTTYPE + %MODIFIABLE + %DUP
FileBuf.KeyBuf1.KeyType = CHR$(%BSTRING)
BufLen = LEN(FileBuf)
KeyBufLen = LEN(FILNAME$)
KeyBuffer$ = FILNAME$
PRINT "Values before create call:
PRINT "Operation "%BCREATE
PRINT "PosBlk len ";LEN(PosBlk)
PRINT "FileBufLen ";LEN(FileBuf)
PRINT "BufLen ";Buflen
PRINT "KeyBuffer$ ";KeyBuffer$
PRINT "keyBufferlen ";LEN(KeyBuffer$)
PRINT "KeyBufLen ";keyBufLen
Stat = BTRCALL(BYVAL %BCREATE, _
BYVAL PosBlk, _
FileBuf, _
BufLen, _
KeyBuffer$, _
BYVAL KeyBufLen, _
BYVAL KeyNumber)
PRINT
PRINT "Values after create call:
PRINT "Operation "%BCREATE
PRINT "PosBlk len ";LEN(PosBlk)
PRINT "FileBufLen ";LEN(FileBuf)
PRINT "BufLen ";Buflen
PRINT "KeyBuffer$ ";KeyBuffer$
PRINT "keyBufferlen ";LEN(KeyBuffer$)
PRINT "KeyBufLen ";keyBufLen
IF Stat <> 0 THEN
Msg$ = "Error Creating File. Stat = " + STR$(Stat)
PrintLB Msg$ + " press any key"
EXIT SUB
ELSE
Msg$ = "File " + FilName + " Created Successfully!"
PrintLB (Msg$)
END IF
'Open File
KeyBufLen = %KEY_BUF_LEN
KeyBuffer$ = FILNAME$
BufLen = LEN(DataBuf)
KeyNum = 0
Stat = BTRCALL(%BOPEN, PosBlk, DataBuf, BufLen, KeyBuffer$, KeyBufLen, KeyNum)
IF Stat <> 0 THEN
Msg$ = "Error Opening file! " + STR$(Stat)
PrintLB (Msg$)
GOTO Fini
ELSE
Msg$ = "File Opened Succesfully!"
PrintLB (Msg$)
END IF
FOR x = 1 TO 3
'yr = 1992
'mo = 1
'dy = 1
DataBuf.Number = 1 'was dateserial (yr,no,dy)
BufLen = LEN(DataBuf)
KeyBuffer$ = SPACE$(%KEY_BUF_LEN)
KeyBufLen = %KEY_BUF_LEN
DataBuf.Dummy = "Record" + STR$(x)
Stat = BTRCALL(%BINSERT, PosBlk, DataBuf, BufLen, KeyBuffer$, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error on Insert. " + STR$(Stat)
PrintLB (Msg$)
ELSE
Count = Count + 1
Msg$ = "Insert Record " + STR$(Count)
PrintLB (Msg$)
END IF
NEXT
'Get First Record
BufLen = LEN(DataBuf)
KeyBuffer$ = SPACE$(255)
KeyBufLen = %KEY_BUF_LEN
Stat = BTRCALL(%BGETFIRST, PosBlk, DataBuf, BufLen, KeyBuffer$, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error on BGETFIRST. " + STR$(Stat)
PrintLB (Msg$)
ELSE
'Msg$ = "BGETFIRST okay for : " + STR$(Year(DataBuf.Number)) + DataBuf.Dummy
Msg$ = "BGETFIRST okay for : " + STR$(DataBuf.Number) + DataBuf.Dummy
PrintLB (Msg$)
END IF
'Get Next Record
BufLen = LEN(DataBuf)
KeyBuffer$ = SPACE$(%KEY_BUF_LEN)
KeyBufLen = %KEY_BUF_LEN
Stat = BTRCALL(%BGETNEXT, PosBlk, DataBuf, BufLen, KeyBuffer$, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error on BGETNEXT. " + STR$(Stat)
PrintLB (Msg$)
ELSE
'Msg$ = "BGETNEXT okay for: " + STR$(Year(DataBuf.Number)) + DataBuf.Dummy
Msg$ = "BGETNEXT okay for: " + STR$(DataBuf.Number) + DataBuf.Dummy
PrintLB (Msg$)
END IF
'Get Next Record
BufLen = LEN(DataBuf)
KeyBuffer$ = SPACE$(%KEY_BUF_LEN)
KeyBufLen = %KEY_BUF_LEN
Stat = BTRCALL(%BGETNEXT, PosBlk, DataBuf, BufLen, KeyBuffer$, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error on BGETNEXT. " + STR$(Stat)
PrintLB (Msg$)
ELSE
'Msg$ = "BGETNEXT okay for: " + STR$(Year(DataBuf.Number)) + DataBuf.Dummy
Msg$ = "BGETNEXT okay for: " + STR$(DataBuf.Number) + DataBuf.Dummy
PrintLB (Msg$)
END IF
'Get Equal
BufLen = LEN(DataBuf)
KBuf# = 1
KeyBufLen = 8
Stat = BTRCALL(%BGETEQUAL, PosBlk, DataBuf, BufLen, KBuf#, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error on Get Equal. Stat = " + STR$(Stat)
PrintLB (Msg$)
ELSE
PrintLB ("BGETEQUAL okay on following key: " + STR$(DataBuf.Number))
END IF
'Stat Call
DBLen = LEN(StatFileBuffer)
KeyBuffer$ = SPACE$(%KEY_BUF_LEN)
KeyBufLen = %KEY_BUF_LEN
Stat = BTRCALL(%BSTAT, PosBlk, StatFileBuffer, DBLen, KeyBuffer$, KeyBufLen, 0)
IF Stat <> 0 THEN
Msg$ = "Error in Stat Call. Stat = " + STR$(Stat)
PrintLB (Msg$)
GOTO Fini
ELSE
Msg = "Records + STR$(StatFileBuffer.RecTot)
PrintLB (Msg)
END IF
Fini:
Stat = BTRCALL(%BRESET, PosBlk, PatientVar, BufLen, KeyBuffer$, KeyBufLen, KeyNum)
IF Stat THEN
Msg$ = "Error on B-Reset!" + STR$(Stat)
PrintLB (Msg$)
ELSE
Msg$ = "BRESET okay."
PrintLB (Msg$)
END IF
Stat = BTRCALL(%BSTOP, PosBlk, PatientVar, BufLen, KeyBuffer$, KeyBufLen, KeyNum)
IF Stat THEN
Msg$ = "Error on B-Stop!" + STR$(Stat)
PrintLB (Msg$)
ELSE
Msg$ = "BSTOP okay."
PrintLB (Msg$)
END IF
PrintLB ("")
PrintLB ("Btrieve Sample Test Completed")
END SUB
SUB PrintLb(Msg AS STRING)
PRINT Msg
END SUB
FUNCTION PBMAIN AS LONG
RunTest
WAITKEY$
END FUNCTION
Comment