Tweet
declare function btrcall lib "wbtrv32.dll" alias "BTRCALL" (byval op as integer,pb as any,db as any,byref dl as integer,kb as any,byval kl as integer,byval kn as integer) as integer
Function PBMain() as long
local posblkz as string * 128
local chiavez as string * 256
local btrbufz as string * 2048
cmd$=ucase$(command$)
cmd$=trim$(command$)
filebtr$=""
fileseq$=""
i%=instr(cmd$," ")
if i% then
filebtr$=trim$(left$(cmd$,i%-1))
fileseq$=trim$(mid$(cmd$,i%+1))
end if
if filebtr$="" or fileseq$="" then
stdout "Error, Btrieve filename or output filename missing"
exit function
end if
stdout filebtr$+" -> "+fileseq$
op%=0 ' open
buffer$=""
buflen%=0
chiave$=filebtr$+chr$(0)
chiave%=-1
gosub Btr
op%=15 ' stat
buffer$=space$(1000)
buflen%=1000
chiave$=space$(255)
chiave%=0
gosub Btr
lun%=cvi(mid$(buffer$,1,2))
lun$=trim$(str$(lun%))
lunlun%=len(lun$)+1
open fileseq$ for output as #1
close #1
open fileseq$ for random as #1 len=lun%+lunlun%+2
rec1$=space$(lun%+lunlun%+2)
mid$(rec1$,1,lunlun%)=lun$+","
mid$(rec1$,lun%+lunlun%+1,2)=chr$(13)+chr$(10)
rec1!=0!
mille%=0
op%=9 ' get >=
buffer$=space$(lun%)
buflen%=lun%
chiave$=string$(255,0)
chiave%=0
gosub Btr
do while status%=0
mid$(rec1$,lunlun%+1,lun%)=buffer$
rec1!=rec1!+1!
put #1, rec1!, abs rec1$
mille%=mille%+1
if mille%=1000 then
mille%=0
if istrue consout then
stdout "*"; ' simple progress display
end if
end if
op%=6 ' get next
buffer$=space$(lun%)
buflen%=lun%
chiave%=0
gosub Btr
loop
op%=1 ' close
buffer$=""
buflen%=0
chiave$=filebtr$+chr$(0)
chiave%=0
gosub Btr
stdout
stdout "Records saved"+str$(rec1!)
exit function
' Btrieve calls (should be #included in source or modified to a sub/function)
' op% ' operation
' buffer$ ' data record or parameters for file create
' buflen% ' data reford length
' chiave$ ' key for get or filename for open/close,
' must be long enough!
' chiave% ' key number or open mode for open
' posblk$ ' file info, set from open/close,
' must be passed on subsequent calls
' status% ' Status
Btr:
select case op%
case 0 ' open
posblk$=space$(128)
gosub ChiamataBtrieve
case 1 ' close
gosub ChiamataBtrieve
posblk$=""
case 14 ' create
posblk$=space$(128)
gosub ChiamataBtrieve
posblk$=""
case else
gosub ChiamataBtrieve
end select
return
ChiamataBtrieve:
status%=0
posblkz=posblk$
btrbufz=buffer$
chiavez=chiave$
keylen%=len(chiave$)
status%=btrcall(op%,posblkz,btrbufz,buflen%,chiavez,keylen%,chiave%)
posblk$=posblkz
buffer$=btrbufz
chiave$=left$(chiavez,keylen%)
posblkz=""
btrbufz=""
chiavez=""
if status%<>0 and status%<>4 and status%<>9 then ' only status ok, not found and eof are returned, other errors are trapped
gosub ErroreBtrieve
end if
return
ErroreBtrieve:
stdout "Btrieve Error (Op"+str$(op%)+", Status"+str$(status%)+")"
while inkey$=""
wend
if status%<>20 then
op%=28 ' reset all resource
buffer$=""
buflen%=0
chiave$=""
chiave%=0
posblk$=space$(128)
gosub ChiamataBtrieve
end if
cls
close
exit function
End Function
Comment