home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / BTV200.ZIP / BTV.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  50KB  |  435 lines
  1. (* This file was mangled by Mangler 1.14 (c) Copyright 1993 by Berend de Boer *)
  2.  UNIT BTV ;{$F-} {$V-} {$X+} {$A-} {$IFOPT R+} {$DEFINE __RANGE_ON} {$ENDIF} {$IFOPT Q+} {$DEFINE __OVERFLOW_ON} {$ENDIF}
  3. {$DEFINE BTRIEVE50} INTERFACE USES BTVCONST , {$IFDEF VER70} WINDOS , {$ELSE} DOS , {$ENDIF} {$IFDEF MSDOS} CRT ,
  4. BTRVDOS ;{$ENDIF} {$IFDEF DPMI} CRT , BTRVDPMI ;{$ENDIF} {$IFDEF WINDOWS} WINPROCS , WINTYPES , BTRVWIN ;{$ENDIF}
  5. TYPE {$IFDEF VER70} PATHSTR =STRING [ FSPATHNAME ] ;{$ENDIF} ALLERRORS =BINVALIDOP .. BLASTERROR ;ERRORSET =SET
  6.  OF ALLERRORS ;ERRORACTION =(ERABORT , ERDONE , ERRETRY );PBYTES =^BYTES ;BYTES =ARRAY [ 1 .. 65534 ]  OF BYTE ;
  7. PPROGRESS =^TPROGRESS ;TPROGRESS =OBJECT CONSTRUCTOR INIT ;PROCEDURE DISPLAY (COUNT :LONGINT );VIRTUAL;DESTRUCTOR DONE ;
  8. VIRTUAL;END ;KEYSPEC =RECORD KEYPOS :WORD ;KEYLEN :WORD ;KEYFLAGS :WORD ;KEYCOUNT :LONGINT ;KEYTYPE :BYTE ;
  9. NULLVALUE :BYTE ;RESERVED :ARRAY [ 1 .. 4 ]  OF BYTE ;END ;KEYSPECARRAY =ARRAY [ 1 .. MAXSEGMENTS ]  OF KEYSPEC ;
  10. KEYDEF =RECORD KEYPOS :WORD ;KEYLEN :WORD ;KEYFLAGS :WORD ;KEYTYPE :BYTE ;NULLVALUE :BYTE ;JUSTIFY :BYTE ;END ;
  11. KEYDEFARRAY =ARRAY [ 1 .. MAXSEGMENTS ]  OF KEYDEF ;FILESPEC =RECORD RECORDLEN :WORD ;PAGESIZE :WORD ;INDEXES :WORD ;
  12. RECORDS :LONGINT ;FILEFLAGS :WORD ;RESERVED :ARRAY [ 1 .. 2 ]  OF BYTE ;FREEPAGES :WORD ;KEYBUFF :KEYSPECARRAY ;
  13. EXTRA :ARRAY [ 1 .. 265 ]  OF BYTE ;END ;PERRORDISPLAY =^ERRORDISPLAY ;ERRORDISPLAY =OBJECT CONSTRUCTOR INIT ;
  14. FUNCTION DISPLAY (ERROR :INTEGER ;ERRORMSG :STRING ;OPCODE :INTEGER ;OPCODEMSG :STRING ;
  15. FILENAME :PATHSTR ):ERRORACTION ;VIRTUAL;DESTRUCTOR DONE ;VIRTUAL;END ;PERRORHANDLER =^ERRORHANDLER ;
  16. ERRORHANDLER =OBJECT RETRYCOUNT :WORD ;MAXRETRY :WORD ;RETRYDELAY :WORD ;TRAPPEDERRORS :ERRORSET ;
  17. ERRDISPLAY :PERRORDISPLAY ;ERRORSON :BOOLEAN ;CONSTRUCTOR INIT (DISPLAYOBJECT :PERRORDISPLAY );FUNCTION ERRORDISPACTHER
  18. (ERRORCODE :INTEGER ;OPCODE :INTEGER ;FILENAME :PATHSTR ):ERRORACTION ;VIRTUAL;FUNCTION ERROR (STATUS :INTEGER ;
  19. OPCODE :INTEGER ;FILENAME :PATHSTR ):BOOLEAN ;VIRTUAL;PROCEDURE SETMAXRETRY (RETRY :WORD );FUNCTION GETMAXRETRY :WORD ;
  20. PROCEDURE CLEARRETRY ;PROCEDURE SETDELAY (SECONDS :WORD );FUNCTION GETDELAY :WORD ;PROCEDURE ADDERRORS
  21. (ERRORCODES :ERRORSET );PROCEDURE REMOVEERRORS (ERRORCODES :ERRORSET );PROCEDURE SETERRORS (ERRORCODES :ERRORSET );
  22. PROCEDURE GETERRORS (VAR ERRORCODES :ERRORSET );PROCEDURE ERRORSONOFF (STATE :BOOLEAN );FUNCTION ERRORMSG
  23. (ERRORCODE :INTEGER ):STRING ;VIRTUAL;FUNCTION OPMSG (OPCODE :INTEGER ):STRING ;VIRTUAL;DESTRUCTOR DONE ;VIRTUAL;END ;
  24. PDEFERRORHANDLER =^DEFERRORHANDLER ;DEFERRORHANDLER =OBJECT (ERRORHANDLER)FUNCTION ERRORMSG (ERRORCODE :INTEGER ):STRING
  25. ;VIRTUAL;FUNCTION OPMSG (OPCODE :INTEGER ):STRING ;VIRTUAL;END ;PDISKERRORHANDLER =^DISKERRORHANDLER ;
  26. DISKERRORHANDLER =OBJECT (ERRORHANDLER)POSBLOCK :ARRAY [ 1 .. POSBLOCKSIZE ]  OF BYTE ;FILEOPEN :BOOLEAN ;
  27. CONSTRUCTOR INIT (DISPLAYOBJECT :PERRORDISPLAY ;ERRORPATH :PATHSTR );DESTRUCTOR DONE ;VIRTUAL;FUNCTION ERRORMSG
  28. (ERRORCODE :INTEGER ):STRING ;VIRTUAL;FUNCTION OPMSG (OPCODE :INTEGER ):STRING ;VIRTUAL;END ;
  29. BTRIEVEMSGREC =RECORD TYPEID :INTEGER ;CODE :INTEGER ;NAME :ARRAY [ 0 .. 80 ]  OF CHAR ;MSGTEXT :ARRAY [ 0 .. 900 ]
  30.  OF CHAR ;END ;PBTRIEVEFILE =^BTRIEVEFILE ;BTRIEVEFILE =OBJECT PATH :PATHSTR ;ALTPATH :PATHSTR ;DATA :POINTER ;
  31. DATASIZE :WORD ;ALLOCATEDATA :BOOLEAN ;ALLOCATEKEY :BOOLEAN ;BYTESREAD :WORD ;BYTESTOWRITE :WORD ;KEY :POINTER ;
  32. KEYSIZE :BYTE ;SEGMENTCNT :BYTE ;CURINDEX :WORD ;INDEXCNT :BYTE ;STATUS :INTEGER ;FILEOPEN :BOOLEAN ;
  33. ERRHANDLER :PERRORHANDLER ;KEYLIST :KEYDEFARRAY ;KEYSTART :ARRAY [ 0 .. MAXSEGMENTS - 1 ]  OF BYTE ;POSBLOCK :ARRAY [ 1
  34. .. POSBLOCKSIZE ]  OF BYTE ;VARIABLELEN :BOOLEAN ;SISEGMENTS :BYTE ;READKEYDEFS :BOOLEAN ;CURRENTKEYSIZE :BYTE ;
  35. FILLVALUE :BYTE ;CONSTRUCTOR INIT (FILEPATH :PATHSTR ;ERROROBJECT :PERRORHANDLER ;DATABUF :POINTER ;DATABUFSIZE :WORD );
  36. DESTRUCTOR DONE ;VIRTUAL;PROCEDURE ABORTTRANSACTION ;PROCEDURE ADDALTSEQUENCE (ALTSEQPATH :PATHSTR );PROCEDURE ADDERRORS
  37. (ERRORCODES :ERRORSET );PROCEDURE ADDSUPPLKEYSEGMENT (POSITION :WORD ;SIZE :WORD ;FLAGS :WORD ;KEYTYPE :BYTE ;
  38. NULLVALUE :BYTE ;JUSTIFY :BYTE );PROCEDURE ADDKEYBUFFER (KEYBUF :POINTER ;KEYBUFSIZE :BYTE );PROCEDURE ADDKEYSEGMENT
  39. (POSITION :WORD ;SIZE :WORD ;FLAGS :WORD ;KEYTYPE :BYTE ;NULLVALUE :BYTE ;JUSTIFY :BYTE );FUNCTION BRESULT :INTEGER ;
  40. PROCEDURE CHANGEBUFFERSIZE (SIZE :WORD );PROCEDURE CLEARBUFFER ;PROCEDURE CLEARKEY ;PROCEDURE CLEAROWNER ;
  41. PROCEDURE CLONE (NEWFILEPATH :PATHSTR ;MODE :INTEGER );PROCEDURE CLOSE ;FUNCTION COPY (OUTFILE :PBTRIEVEFILE ;
  42. DISPLAYOBJ :PPROGRESS ):INTEGER ;PROCEDURE CREATE (FLAGS :WORD ;RECORDSIZE :WORD ;PAGESIZE :WORD ;PAGES :WORD ;
  43. MODE :INTEGER );PROCEDURE CREATEINDEX ;PROCEDURE DELETE ;PROCEDURE DROPINDEX (INDEX :INTEGER );PROCEDURE ENDTRANSACTION ;
  44. FUNCTION ERROR (ERRSTATUS :INTEGER ;OPCODE :INTEGER ;FILENAME :PATHSTR ):BOOLEAN ;PROCEDURE ERRORSONOFF
  45. (STATE :BOOLEAN );PROCEDURE FILLKEYBUFFER (VAR BUFF ;SIZE :BYTE );PROCEDURE GET (OP :INTEGER ;LOCK :WORD );
  46. PROCEDURE GETDIRECT (LOCK :WORD ;POSITION :LONGINT );PROCEDURE GETERRORS (VAR ERRORCODES :ERRORSET );
  47. FUNCTION GETFILLVALUE :BYTE ;FUNCTION GETPOSITION :LONGINT ;PROCEDURE INSERT ;FUNCTION ISOPEN :BOOLEAN ;FUNCTION LOAD
  48. (INPUTFILEPATH :PATHSTR ;DISPLAYOBJ :PPROGRESS ):INTEGER ;PROCEDURE MAKEKEY (V1 :POINTER ;V2 :POINTER ;V3 :POINTER ;
  49. V4 :POINTER ;V5 :POINTER ;V6 :POINTER );VIRTUAL;FUNCTION NUMBEROFRECORDS :LONGINT ;PROCEDURE OPEN (MODE :INTEGER ;
  50. OWNER :STRING );FUNCTION RECOVER (NEWFILEPATH :PATHSTR ;DISPLAYOBJ :PPROGRESS ):INTEGER ;PROCEDURE REMOVEERRORS
  51. (ERRORCODES :ERRORSET );PROCEDURE RESET ;PROCEDURE RESETSTATION (CONNECTION :WORD );FUNCTION SAVE (NEWFILEPATH :PATHSTR ;
  52. DISPLAYOBJ :PPROGRESS ):INTEGER ;PROCEDURE SETERRORS (ERRORCODES :ERRORSET );PROCEDURE SETFILLVALUE (VALUE :BYTE );
  53. PROCEDURE SETKEYPATH (NUMBER :WORD );PROCEDURE SETOUTPUTSIZE (SIZE :WORD );PROCEDURE SETOWNER (OWNER :STRING ;
  54. MODE :INTEGER );PROCEDURE STARTTRANSACTION (LOCK :WORD );PROCEDURE STAT (VAR FDATA :FILESPEC );PROCEDURE UPDATE ;
  55. PROCEDURE UNLOAD ;PROCEDURE UNLOCKALL (LOCK :WORD );PROCEDURE VERSION (VAR VER :WORD ;VAR REV :WORD ;VAR OSFLAG :CHAR );
  56. PRIVATE PROCEDURE FIXKEYSTRINGS ;PROCEDURE JUSTIFYSTRING (BUFF :PBYTES ;SIZE :BYTE ;KEYTYPE :BYTE ;JUSTIFY :BYTE );END ;
  57. PROCEDURE CHECKFORBTRIEVE ;PROCEDURE GETBTRIEVEVERSION (VAR VER :WORD ;VAR REV :WORD ;VAR OSFLAG :CHAR );
  58. PROCEDURE UNLOADBTRIEVE ;IMPLEMENTATION PROCEDURE OI1I11I01OO (VAR OO1O:STRING ;OIO0O1I11lO:BYTE);
  59. VAR OOlIllI1Ol0O:BYTE ABSOLUTE OO1O;BEGIN IF (OOlIllI1Ol0O < OIO0O1I11lO )THEN BEGIN FILLCHAR (OO1O [ OOlIllI1Ol0O + 1 ]
  60. , OIO0O1I11lO - OOlIllI1Ol0O , ' ');OOlIllI1Ol0O := OIO0O1I11lO ;END ;END ;PROCEDURE O1Ill101O1 (VAR OO1O:STRING ;
  61. OIO0O1I11lO:BYTE);VAR OOlIllI1Ol0O:BYTE ABSOLUTE OO1O;OOIO:BYTE;BEGIN IF (OOlIllI1Ol0O < OIO0O1I11lO )THEN BEGIN OOIO :=
  62. OIO0O1I11lO - OOlIllI1Ol0O ;MOVE (OO1O [ 1 ] , OO1O [ OOIO + 1 ] , OOlIllI1Ol0O );FILLCHAR (OO1O [ 1 ] , OOIO , ' ');
  63. OOlIllI1Ol0O := OIO0O1I11lO ;END ;END ;PROCEDURE OI10OIO00IOO (VAR OO1O:STRING );VAR OIlO:WORD;
  64. OOlIllI1Ol0O:BYTE ABSOLUTE OO1O;BEGIN WHILE (OOlIllI1Ol0O > 0 )AND (OO1O [ OOlIllI1Ol0O ] <= ' ') DO DEC (OOlIllI1Ol0O );
  65. OIlO := 1 ;WHILE (OIlO <= OOlIllI1Ol0O )AND (OO1O [ OIlO ] <= ' ') DO INC (OIlO );IF (OIlO > 1 )THEN BEGIN OOlIllI1Ol0O
  66. := OOlIllI1Ol0O - OIlO + 1 ;MOVE (OO1O [ OIlO ] , OO1O [ 1 ] , OOlIllI1Ol0O );END ;END ;CONSTRUCTOR BTRIEVEFILE.INIT
  67. (FILEPATH:PATHSTR;ERROROBJECT:PERRORHANDLER;DATABUF:POINTER;DATABUFSIZE:WORD);BEGIN PATH := FILEPATH ;ALTPATH := '';DATA
  68. := DATABUF ;ALLOCATEDATA := (DATA =NIL );ALLOCATEKEY := TRUE ;IF ALLOCATEDATA THEN DATASIZE := 0 ELSE DATASIZE :=
  69. DATABUFSIZE ;BYTESREAD := 0 ;BYTESTOWRITE := 0 ;KEY := NIL ;KEYSIZE := 0 ;CURRENTKEYSIZE := 0 ;SEGMENTCNT := 0 ;
  70. SISEGMENTS := 0 ;INDEXCNT := 0 ;STATUS := BOKAY ;FILEOPEN := FALSE ;ERRHANDLER := ERROROBJECT ;CURINDEX := 0 ;
  71. READKEYDEFS := TRUE ;FILLVALUE := 0 ;FILLCHAR (KEYLIST , SIZEOF (KEYLIST ), 0 );FILLCHAR (KEYSTART , SIZEOF (KEYSTART ),
  72. 0 );FILLCHAR (POSBLOCK , SIZEOF (POSBLOCK ), 0 );END ;PROCEDURE BTRIEVEFILE.SETKEYPATH (NUMBER:WORD);BEGIN IF (NUMBER <
  73. INDEXCNT )THEN CURINDEX := NUMBER ;END ;PROCEDURE BTRIEVEFILE.ADDALTSEQUENCE (ALTSEQPATH:PATHSTR);BEGIN ALTPATH :=
  74. ALTSEQPATH ;END ;PROCEDURE BTRIEVEFILE.ADDKEYSEGMENT (POSITION:WORD;SIZE:WORD;FLAGS:WORD;KEYTYPE:BYTE;NULLVALUE:BYTE;
  75. JUSTIFY:BYTE);BEGIN READKEYDEFS := FALSE ;IF (SEGMENTCNT < MAXSEGMENTS )THEN BEGIN CURRENTKEYSIZE := CURRENTKEYSIZE +
  76. SIZE ;INC (SEGMENTCNT );IF (KEYSTART [ INDEXCNT ] =0 )THEN KEYSTART [ INDEXCNT ] := SEGMENTCNT ;KEYLIST [ SEGMENTCNT ] .
  77. KEYPOS := POSITION ;KEYLIST [ SEGMENTCNT ] . KEYLEN := SIZE ;KEYLIST [ SEGMENTCNT ] . KEYFLAGS := FLAGS ;KEYLIST [
  78. SEGMENTCNT ] . KEYTYPE := KEYTYPE ;KEYLIST [ SEGMENTCNT ] . NULLVALUE := NULLVALUE ;KEYLIST [ SEGMENTCNT ] . JUSTIFY :=
  79. JUSTIFY ;IF (FLAGS AND BSEGMENTED =0 )THEN BEGIN INC (INDEXCNT );IF (CURRENTKEYSIZE > KEYSIZE )THEN KEYSIZE :=
  80. CURRENTKEYSIZE ;CURRENTKEYSIZE := 0 ;END ;END ;END ;PROCEDURE BTRIEVEFILE.SETFILLVALUE (VALUE:BYTE);BEGIN FILLVALUE :=
  81. VALUE ;END ;FUNCTION BTRIEVEFILE.GETFILLVALUE :BYTE ;BEGIN GETFILLVALUE := FILLVALUE ;END ;
  82. PROCEDURE BTRIEVEFILE.ADDKEYBUFFER (KEYBUF:POINTER;KEYBUFSIZE:BYTE);BEGIN IF ALLOCATEKEY AND (KEY <> NIL )THEN FREEMEM
  83. (KEY , KEYSIZE );ALLOCATEKEY := FALSE ;READKEYDEFS := FALSE ;KEY := KEYBUF ;KEYSIZE := KEYBUFSIZE ;END ;
  84. PROCEDURE BTRIEVEFILE.OPEN (MODE:INTEGER;OWNER:STRING );VAR OIlO,OIll:BYTE;O1010OOllllOl:WORD;OOlIlOl0l100:ARRAY [ 0 .. 8
  85. ]  OF CHAR;OIlIl0O0010:ARRAY [ 0 .. 80 ]  OF CHAR;OI1II1O1OO0l:FILESPEC;BEGIN IF NOT FILEOPEN THEN BEGIN MOVE (PATH [ 1 ]
  86. , OIlIl0O0010 [ 0 ] , LENGTH (PATH ));OIlIl0O0010 [ LENGTH (PATH )] := #0;OI10OIO00IOO (OWNER );O1010OOllllOl := 0 ;IF
  87. (OWNER <> '')THEN BEGIN O1010OOllllOl := LENGTH (OWNER );IF (O1010OOllllOl > 8 )THEN O1010OOllllOl := 8 ;MOVE (OWNER [ 1
  88. ] , OOlIlOl0l100 [ 0 ] , O1010OOllllOl );OOlIlOl0l100 [ O1010OOllllOl ] := #0;INC (O1010OOllllOl );END ;REPEAT
  89. {$IFDEF MSDOS} STATUS := BTRV (BOPEN , POSBLOCK , OOlIlOl0l100 , O1010OOllllOl , OIlIl0O0010 , MODE );{$ELSE} STATUS :=
  90. BTRV (BOPEN , POSBLOCK , OOlIlOl0l100 , O1010OOllllOl , OIlIl0O0010 , LENGTH (PATH )+ 1 , MODE );{$ENDIF} UNTIL (NOT
  91. ERROR (STATUS , BOPEN , PATH ));FILEOPEN := (STATUS =BOKAY );IF FILEOPEN THEN BEGIN FILLCHAR (OI1II1O1OO0l , SIZEOF
  92. (OI1II1O1OO0l ), 0 );STAT (OI1II1O1OO0l );IF (STATUS =BOKAY )THEN BEGIN INDEXCNT := OI1II1O1OO0l.INDEXES ;VARIABLELEN :=
  93. ((OI1II1O1OO0l.FILEFLAGS AND BVARIABLELEN )<> 0 );BYTESTOWRITE := OI1II1O1OO0l.RECORDLEN ;IF READKEYDEFS THEN
  94. BEGIN SEGMENTCNT := 0 ;FOR OIlO := 0 TO INDEXCNT - 1  DO BEGIN KEYSTART [ OIlO ] := SEGMENTCNT + 1 ;REPEAT INC
  95. (SEGMENTCNT );CURRENTKEYSIZE := CURRENTKEYSIZE + OI1II1O1OO0l.KEYBUFF [ SEGMENTCNT ] . KEYLEN ;UNTIL
  96. ((OI1II1O1OO0l.KEYBUFF [ SEGMENTCNT ] . KEYFLAGS AND BSEGMENTED )=0 );IF (CURRENTKEYSIZE > KEYSIZE )THEN KEYSIZE :=
  97. CURRENTKEYSIZE ;CURRENTKEYSIZE := 0 ;END ;FOR OIlO := 1 TO SEGMENTCNT  DO BEGIN KEYLIST [ OIlO ] . KEYPOS :=
  98. OI1II1O1OO0l.KEYBUFF [ OIlO ] . KEYPOS ;KEYLIST [ OIlO ] . KEYLEN := OI1II1O1OO0l.KEYBUFF [ OIlO ] . KEYLEN ;KEYLIST [
  99. OIlO ] . KEYFLAGS := OI1II1O1OO0l.KEYBUFF [ OIlO ] . KEYFLAGS ;KEYLIST [ OIlO ] . KEYTYPE := OI1II1O1OO0l.KEYBUFF [ OIlO
  100. ] . KEYTYPE ;KEYLIST [ OIlO ] . NULLVALUE := OI1II1O1OO0l.KEYBUFF [ OIlO ] . NULLVALUE ;KEYLIST [ OIlO ] . JUSTIFY :=
  101. BNORMAL ;END ;END ;IF ALLOCATEDATA THEN BEGIN IF VARIABLELEN THEN DATASIZE := MAXBUFFSIZE ELSE DATASIZE :=
  102. OI1II1O1OO0l.RECORDLEN ;GETMEM (DATA , DATASIZE );CLEARBUFFER ;END ;IF ALLOCATEKEY THEN BEGIN GETMEM (KEY , KEYSIZE );
  103. CLEARKEY ;CURRENTKEYSIZE := 0 ;END ;IF ((DATA =NIL )AND (DATASIZE > 0 ))OR ((KEY =NIL )AND (KEYSIZE > 0 ))THEN
  104. BEGIN STATUS := BOUTOFMEMORY ;ERROR (STATUS , BOPEN , PATH );EXIT ;END ;END ;END ;END ;END ;PROCEDURE BTRIEVEFILE.CREATE
  105. (FLAGS:WORD;RECORDSIZE:WORD;PAGESIZE:WORD;PAGES:WORD;MODE:INTEGER);VAR OIlO:INTEGER;O1lO01OlI1lO:WORD;OI111IlIO100:ARRAY
  106. [ 0 .. 80 ]  OF CHAR;OOlO0IO0I1OI:FILESPEC;OIOI100IlI0:ARRAY [ 1 .. 1024 ]  OF BYTE ABSOLUTE OOlO0IO0I1OI;
  107. O1lI1lO0O011:FILE ;BEGIN FILLCHAR (OOlO0IO0I1OI , SIZEOF (OOlO0IO0I1OI ), 0 );OOlO0IO0I1OI.RECORDLEN := RECORDSIZE ;
  108. OOlO0IO0I1OI.PAGESIZE := PAGESIZE ;OOlO0IO0I1OI.INDEXES := INDEXCNT ;OOlO0IO0I1OI.FILEFLAGS := FLAGS ;
  109. OOlO0IO0I1OI.FREEPAGES := PAGES ;FOR OIlO := 1 TO SEGMENTCNT  DO BEGIN OOlO0IO0I1OI.KEYBUFF [ OIlO ] . KEYPOS := KEYLIST
  110. [ OIlO ] . KEYPOS ;OOlO0IO0I1OI.KEYBUFF [ OIlO ] . KEYLEN := KEYLIST [ OIlO ] . KEYLEN ;OOlO0IO0I1OI.KEYBUFF [ OIlO ] .
  111. KEYFLAGS := KEYLIST [ OIlO ] . KEYFLAGS ;OOlO0IO0I1OI.KEYBUFF [ OIlO ] . KEYTYPE := KEYLIST [ OIlO ] . KEYTYPE ;
  112. OOlO0IO0I1OI.KEYBUFF [ OIlO ] . NULLVALUE := KEYLIST [ OIlO ] . NULLVALUE ;END ;O1lO01OlI1lO := SEGMENTCNT * SIZEOF
  113. (KEYSPEC )+ 16 ;{$I-} IF (ALTPATH <> '')THEN BEGIN SYSTEM.ASSIGN (O1lI1lO0O011 , ALTPATH );SYSTEM.RESET (O1lI1lO0O011 , 1
  114. );IF (IORESULT =0 )THEN BEGIN SYSTEM.BLOCKREAD (O1lI1lO0O011 , OIOI100IlI0 [ O1lO01OlI1lO + 1 ] , 265 );SYSTEM.CLOSE
  115. (O1lI1lO0O011 );O1lO01OlI1lO := O1lO01OlI1lO + 265 ;ALTPATH := '';OIlO := IORESULT ;END ;END ;{$I+} MOVE (PATH [ 1 ] ,
  116. OI111IlIO100 [ 0 ] , LENGTH (PATH ));OI111IlIO100 [ LENGTH (PATH )] := CHR (0 );REPEAT {$IFDEF MSDOS} STATUS := BTRV
  117. (BCREATE , POSBLOCK , OOlO0IO0I1OI , O1lO01OlI1lO , OI111IlIO100 , MODE );{$ELSE} STATUS := BTRV (BCREATE , POSBLOCK ,
  118. OOlO0IO0I1OI , O1lO01OlI1lO , OI111IlIO100 , LENGTH (PATH )+ 1 , MODE );{$ENDIF} UNTIL (NOT ERROR (STATUS , BCREATE ,
  119. PATH ));END ;FUNCTION BTRIEVEFILE.COPY (OUTFILE:PBTRIEVEFILE;DISPLAYOBJ:PPROGRESS):INTEGER ;VAR OOIO:BYTE;
  120. OI1I01OI0Ol:LONGINT;O1l100llOIIl:BOOLEAN;OOlIlOO0OOOO:WORD;BEGIN IF NOT OUTFILE ^. ISOPEN THEN BEGIN OUTFILE ^. OPEN
  121. (BACCELERATED , '');O1l100llOIIl := TRUE ;END ELSE O1l100llOIIl := FALSE ;{$IFNDEF BTRIEVE50} GET (BSTEPNEXT , BNOLOCK );
  122. {$ELSE} GET (BSTEPFIRST , BNOLOCK );{$ENDIF} OOIO := 0 ;OI1I01OI0Ol := 0 ;WHILE (STATUS =BOKAY )AND (OUTFILE ^. BRESULT
  123. =BOKAY ) DO BEGIN OOlIlOO0OOOO := BYTESREAD ;IF (OOlIlOO0OOOO > OUTFILE ^. DATASIZE )THEN OOlIlOO0OOOO := OUTFILE ^.
  124. DATASIZE ;MOVE (DATA , OUTFILE ^. DATA , OOlIlOO0OOOO );OUTFILE ^. SETOUTPUTSIZE (OOlIlOO0OOOO );OUTFILE ^. INSERT ;INC
  125. (OOIO );INC (OI1I01OI0Ol );IF (OOIO =10 )THEN BEGIN IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );
  126. OOIO := 0 ;END ;GET (BSTEPNEXT , BNOLOCK );END ;IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );IF
  127. (STATUS <> BEOF )THEN COPY := STATUS ELSE IF (OUTFILE ^. BRESULT <> BOKAY )THEN COPY := OUTFILE ^. BRESULT ELSE COPY := 0
  128. ;IF O1l100llOIIl THEN OUTFILE ^. CLOSE ;END ;FUNCTION BTRIEVEFILE.SAVE (NEWFILEPATH:PATHSTR;
  129. DISPLAYOBJ:PPROGRESS):INTEGER ;VAR OOIO:BYTE;OIOl01I00IO:INTEGER;OI1I01OI0Ol:LONGINT;O11lIOII:STRING [ 6 ] ;
  130. O1lII00000l1:FILE ;BEGIN IF (PATH =NEWFILEPATH )THEN BEGIN SAVE := BDUPLICATEFILENAME ;EXIT ;END ;{$I-} ASSIGN
  131. (O1lII00000l1 , NEWFILEPATH );REWRITE (O1lII00000l1 , 1 );OIOl01I00IO := IORESULT ;GET (BGETFIRST , BNOLOCK );OOIO := 0 ;
  132. OI1I01OI0Ol := 0 ;WHILE (STATUS <> BEOF )AND (OIOl01I00IO =0 ) DO BEGIN IF (STATUS =BOKAY )THEN BEGIN STR (BYTESREAD ,
  133. O11lIOII );O11lIOII := O11lIOII + ',';BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , LENGTH (O11lIOII ));OIOl01I00IO :=
  134. IORESULT ;IF (OIOl01I00IO =0 )THEN BEGIN BLOCKWRITE (O1lII00000l1 , DATA ^, BYTESREAD );OIOl01I00IO := IORESULT ;END ;IF
  135. (OIOl01I00IO =0 )THEN BEGIN O11lIOII := #13#10;BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , 2 );OIOl01I00IO := IORESULT ;
  136. INC (OI1I01OI0Ol );INC (OOIO );IF (OOIO =10 )THEN BEGIN IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );
  137. OOIO := 0 ;END ;END ;END ;GET (BGETNEXT , BNOLOCK );END ;O11lIOII := #26;BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , 1 );
  138. IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );IF (OIOl01I00IO =0 )THEN OIOl01I00IO := IORESULT ;IF
  139. (STATUS <> BEOF )THEN SAVE := STATUS ELSE IF (OIOl01I00IO <> 0 )THEN SAVE := OIOl01I00IO ELSE SAVE := 0 ;SYSTEM.CLOSE
  140. (O1lII00000l1 );{$I+} END ;FUNCTION BTRIEVEFILE.RECOVER (NEWFILEPATH:PATHSTR;DISPLAYOBJ:PPROGRESS):INTEGER ;
  141. VAR OOIO:BYTE;OIOl01I00IO:INTEGER;OI1I01OI0Ol:LONGINT;O11lIOII:STRING [ 6 ] ;O1lII00000l1:FILE ;O10OIIlll00I1:LONGINT;
  142. O101l00l1OllI:LONGINT;PROCEDURE OI11OlIIl00 (O11IlI1l:INTEGER);BEGIN WHILE (STATUS =BOKAY )AND (OIOl01I00IO =0
  143. ) DO BEGIN {$IFDEF BTRIEVE50} O101l00l1OllI := GETPOSITION ;IF (O101l00l1OllI =O10OIIlll00I1 )THEN EXIT ;{$ENDIF} STR
  144. (BYTESREAD , O11lIOII );O11lIOII := O11lIOII + ',';BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , LENGTH (O11lIOII ));
  145. OIOl01I00IO := IORESULT ;IF (OIOl01I00IO =0 )THEN BEGIN BLOCKWRITE (O1lII00000l1 , DATA ^, BYTESREAD );OIOl01I00IO :=
  146. IORESULT ;END ;IF (OIOl01I00IO =0 )THEN BEGIN O11lIOII := #13#10;BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , 2 );
  147. OIOl01I00IO := IORESULT ;INC (OI1I01OI0Ol );INC (OOIO );IF (OOIO =10 )THEN BEGIN IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ
  148. ^. DISPLAY (OI1I01OI0Ol );OOIO := 0 ;END ;END ;GET (O11IlI1l , BNOLOCK );END ;END ;BEGIN IF (PATH =NEWFILEPATH )THEN
  149. BEGIN RECOVER := BDUPLICATEFILENAME ;EXIT ;END ;{$I-} ASSIGN (O1lII00000l1 , NEWFILEPATH );REWRITE (O1lII00000l1 , 1 );
  150. OIOl01I00IO := IORESULT ;OOIO := 0 ;OI1I01OI0Ol := 0 ;{$IFNDEF BTRIEVE50} GET (BSTEPNEXT , BNOLOCK );OI11OlIIl00
  151. (BSTEPNEXT );{$ELSE} O10OIIlll00I1 := 0 ;GET (BSTEPFIRST , BNOLOCK );OI11OlIIl00 (BSTEPNEXT );IF (STATUS <> BEOF )THEN
  152. BEGIN O10OIIlll00I1 := O101l00l1OllI ;GET (BSTEPLAST , BNOLOCK );OI11OlIIl00 (BSTEPPREV );END ;{$ENDIF} O11lIOII := #26;
  153. BLOCKWRITE (O1lII00000l1 , O11lIOII [ 1 ] , 1 );IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );IF
  154. (OIOl01I00IO =0 )THEN OIOl01I00IO := IORESULT ;IF (STATUS <> BEOF )THEN RECOVER := STATUS ELSE IF (OIOl01I00IO <> 0 )THEN
  155. RECOVER := OIOl01I00IO ELSE RECOVER := 0 ;SYSTEM.CLOSE (O1lII00000l1 );{$I+} END ;FUNCTION BTRIEVEFILE.LOAD
  156. (INPUTFILEPATH:PATHSTR;DISPLAYOBJ:PPROGRESS):INTEGER ;VAR OOIO:BYTE;O10lIlll:CHAR;OIOl01I00IO:INTEGER;OI1OIIIl0lO1:WORD;
  157. OI1I01OI0Ol:LONGINT;O11lIOII:STRING [ 5 ] ;OI110IOl00lO:FILE ;OOlO0IO0I1OI:POINTER;BEGIN GETMEM (OOlO0IO0I1OI , $FFF0 );
  158. IF (OOlO0IO0I1OI =NIL )THEN BEGIN LOAD := BOUTOFMEMORY ;EXIT ;END ;{$I-} ASSIGN (OI110IOl00lO , INPUTFILEPATH );
  159. SYSTEM.RESET (OI110IOl00lO , 1 );OIOl01I00IO := IORESULT ;OOIO := 0 ;OI1I01OI0Ol := 0 ;WHILE (STATUS =BOKAY )AND
  160. (OIOl01I00IO =0 )AND NOT EOF (OI110IOl00lO ) DO BEGIN BLOCKREAD (OI110IOl00lO , O10lIlll , 1 );OIOl01I00IO := IORESULT ;
  161. O11lIOII := '';WHILE (O10lIlll <> ',')AND (O10lIlll <> ' ')AND (O10lIlll <> #26)AND (OIOl01I00IO =0 ) DO BEGIN O11lIOII
  162. := O11lIOII + O10lIlll ;BLOCKREAD (OI110IOl00lO , O10lIlll , 1 );OIOl01I00IO := IORESULT ;END ;IF (OIOl01I00IO =0 )AND
  163. (O10lIlll <> #26)THEN BEGIN VAL (O11lIOII , OI1OIIIl0lO1 , OIOl01I00IO );IF (OIOl01I00IO <> 0 )THEN BEGIN LOAD :=
  164. BLOADINPUTERR ;EXIT ;END ELSE BEGIN BLOCKREAD (OI110IOl00lO , OOlO0IO0I1OI ^, OI1OIIIl0lO1 );OIOl01I00IO := IORESULT ;IF
  165. (OIOl01I00IO =0 )THEN BEGIN BLOCKREAD (OI110IOl00lO , O11lIOII , 2 );OIOl01I00IO := IORESULT ;END ;IF NOT VARIABLELEN AND
  166. (OI1OIIIl0lO1 > DATASIZE )THEN OI1OIIIl0lO1 := DATASIZE ;MOVE (OOlO0IO0I1OI ^, DATA ^, OI1OIIIl0lO1 );SETOUTPUTSIZE
  167. (OI1OIIIl0lO1 );INSERT ;INC (OOIO );INC (OI1I01OI0Ol );IF (OOIO =10 )THEN BEGIN IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^.
  168. DISPLAY (OI1I01OI0Ol );OOIO := 0 ;END ;END ;END ;END ;IF (DISPLAYOBJ <> NIL )THEN DISPLAYOBJ ^. DISPLAY (OI1I01OI0Ol );
  169. IF (STATUS <> BOKAY )THEN LOAD := STATUS ELSE IF (OIOl01I00IO <> 0 )THEN LOAD := OIOl01I00IO ELSE LOAD := 0 ;
  170. SYSTEM.CLOSE (OI110IOl00lO );{$I+} END ;PROCEDURE BTRIEVEFILE.CLONE (NEWFILEPATH:PATHSTR;MODE:INTEGER);
  171. VAR OI111IlIO100:ARRAY [ 0 .. SIZEOF(PATHSTR)- 1 ]  OF CHAR;OI1II1O1OO0l:FILESPEC;O10O0IO0lOllI:ARRAY [ 1 ..
  172. POSBLOCKSIZE]  OF BYTE;BEGIN IF (PATH =NEWFILEPATH )THEN BEGIN STATUS := BDUPLICATEFILENAME ;EXIT ;END ;STAT
  173. (OI1II1O1OO0l );MOVE (NEWFILEPATH [ 1 ] , OI111IlIO100 [ 0 ] , LENGTH (NEWFILEPATH ));OI111IlIO100 [ LENGTH (NEWFILEPATH
  174. )] := #0;REPEAT {$IFDEF MSDOS} STATUS := BTRV (BCREATE , O10O0IO0lOllI , OI1II1O1OO0l , BYTESREAD , OI111IlIO100 , MODE
  175. );{$ELSE} STATUS := BTRV (BCREATE , O10O0IO0lOllI , OI1II1O1OO0l , BYTESREAD , OI111IlIO100 , LENGTH (NEWFILEPATH )+ 1 ,
  176. MODE );{$ENDIF} UNTIL (NOT ERROR (STATUS , BCREATE , NEWFILEPATH ));END ;PROCEDURE BTRIEVEFILE.ADDSUPPLKEYSEGMENT
  177. (POSITION:WORD;SIZE:WORD;FLAGS:WORD;KEYTYPE:BYTE;NULLVALUE:BYTE;JUSTIFY:BYTE);BEGIN IF (SEGMENTCNT + SISEGMENTS <
  178. MAXSEGMENTS )THEN BEGIN CURRENTKEYSIZE := CURRENTKEYSIZE + SIZE ;INC (SISEGMENTS );IF (KEYSTART [ INDEXCNT ] =0 )THEN
  179. KEYSTART [ INDEXCNT ] := SEGMENTCNT + 1 ;KEYLIST [ SEGMENTCNT + SISEGMENTS ] . KEYPOS := POSITION ;KEYLIST [ SEGMENTCNT +
  180. SISEGMENTS ] . KEYLEN := SIZE ;KEYLIST [ SEGMENTCNT + SISEGMENTS ] . KEYFLAGS := FLAGS ;KEYLIST [ SEGMENTCNT + SISEGMENTS
  181. ] . KEYTYPE := KEYTYPE ;KEYLIST [ SEGMENTCNT + SISEGMENTS ] . NULLVALUE := NULLVALUE ;KEYLIST [ SEGMENTCNT + SISEGMENTS ]
  182. . JUSTIFY := JUSTIFY ;END ;END ;PROCEDURE BTRIEVEFILE.CREATEINDEX ;VAR OIlO:INTEGER;O1lO01OlI1lO:WORD;
  183. OOlO0IO0I1OI:KEYSPECARRAY;OIOI100IlI0:ARRAY [ 1 .. 1024 ]  OF BYTE ABSOLUTE OOlO0IO0I1OI;O1lI1lO0O011:FILE ;
  184. BEGIN FOR OIlO := 1 TO SISEGMENTS  DO BEGIN OOlO0IO0I1OI [ OIlO ] . KEYPOS := KEYLIST [ OIlO + SEGMENTCNT ] . KEYPOS ;
  185. OOlO0IO0I1OI [ OIlO ] . KEYLEN := KEYLIST [ OIlO + SEGMENTCNT ] . KEYLEN ;OOlO0IO0I1OI [ OIlO ] . KEYFLAGS := KEYLIST [
  186. OIlO + SEGMENTCNT ] . KEYFLAGS ;OOlO0IO0I1OI [ OIlO ] . KEYTYPE := KEYLIST [ OIlO + SEGMENTCNT ] . KEYTYPE ;OOlO0IO0I1OI
  187. [ OIlO ] . NULLVALUE := KEYLIST [ OIlO + SEGMENTCNT ] . NULLVALUE ;END ;O1lO01OlI1lO := SISEGMENTS * SIZEOF (KEYSPEC );
  188. {$I-} IF (ALTPATH <> '')THEN BEGIN SYSTEM.ASSIGN (O1lI1lO0O011 , ALTPATH );SYSTEM.RESET (O1lI1lO0O011 , 1 );IF (IORESULT
  189. =0 )THEN BEGIN SYSTEM.BLOCKREAD (O1lI1lO0O011 , OIOI100IlI0 [ O1lO01OlI1lO + 1 ] , 265 );SYSTEM.CLOSE (O1lI1lO0O011 );
  190. O1lO01OlI1lO := O1lO01OlI1lO + 265 ;OIlO := IORESULT ;END ;END ;{$I+} REPEAT {$IFDEF MSDOS} STATUS := BTRV (BCREATEINDEX
  191. , POSBLOCK , OOlO0IO0I1OI , O1lO01OlI1lO , OIlO , OIlO );{$ELSE} OIlO := 0 ;STATUS := BTRV (BCREATEINDEX , POSBLOCK ,
  192. OOlO0IO0I1OI , O1lO01OlI1lO , OIlO , OIlO , OIlO );{$ENDIF} UNTIL (NOT ERROR (STATUS , BCREATEINDEX , PATH ));IF (STATUS
  193. =BOKAY )THEN BEGIN INC (INDEXCNT );INC (SEGMENTCNT , SISEGMENTS );IF (CURRENTKEYSIZE > KEYSIZE )THEN BEGIN FREEMEM (KEY ,
  194. KEYSIZE );KEYSIZE := CURRENTKEYSIZE ;CURRENTKEYSIZE := 0 ;GETMEM (KEY , KEYSIZE );IF ((KEY =NIL )AND (KEYSIZE > 0 ))THEN
  195. BEGIN STATUS := BOUTOFMEMORY ;ERROR (STATUS , BCREATEINDEX , PATH );END ;END ;END ;END ;PROCEDURE BTRIEVEFILE.DROPINDEX
  196. (INDEX:INTEGER);VAR OIlO:INTEGER;OOII:WORD;BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BDROPINDEX ,
  197. POSBLOCK , OIlO , OOII , OIlO , INDEX );{$ELSE} STATUS := BTRV (BDROPINDEX , POSBLOCK , OIlO , OOII , OIlO , OIlO , INDEX
  198. );{$ENDIF} UNTIL (NOT ERROR (STATUS , BDROPINDEX , PATH ));END ;PROCEDURE BTRIEVEFILE.CHANGEBUFFERSIZE (SIZE:WORD);
  199. BEGIN IF (SIZE =DATASIZE )THEN EXIT ;IF (SIZE > MAXAVAIL )THEN SIZE := MAXAVAIL ;IF (DATA <> NIL )THEN FREEMEM (DATA ,
  200. DATASIZE );DATASIZE := SIZE ;GETMEM (DATA , DATASIZE );IF ((DATA =NIL )AND (DATASIZE > 0 ))THEN BEGIN STATUS :=
  201. BOUTOFMEMORY ;ERROR (STATUS , 0 , PATH );END ;END ;PROCEDURE BTRIEVEFILE.SETOWNER (OWNER:STRING ;MODE:INTEGER);
  202. VAR O1010OOllllOl:WORD;OOlIlOl0l100:ARRAY [ 0 .. 8 ]  OF CHAR;BEGIN OI10OIO00IOO (OWNER );IF (OWNER ='')THEN EXIT ;
  203. O1010OOllllOl := LENGTH (OWNER );IF (O1010OOllllOl > 8 )THEN O1010OOllllOl := 8 ;MOVE (OWNER [ 1 ] , OOlIlOl0l100 [ 0 ] ,
  204. O1010OOllllOl );OOlIlOl0l100 [ O1010OOllllOl ] := #0;INC (O1010OOllllOl );REPEAT {$IFDEF MSDOS} STATUS := BTRV (BSETOWNER
  205. , POSBLOCK , OOlIlOl0l100 , O1010OOllllOl , OOlIlOl0l100 , MODE );{$ELSE} STATUS := BTRV (BSETOWNER , POSBLOCK ,
  206. OOlIlOl0l100 , O1010OOllllOl , OOlIlOl0l100 , O1010OOllllOl , MODE );{$ENDIF} UNTIL (NOT ERROR (STATUS , BSETOWNER , PATH
  207. ));END ;PROCEDURE BTRIEVEFILE.CLEAROWNER ;VAR OIlO:INTEGER;OOII:WORD;BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS}
  208. STATUS := BTRV (BCLEAROWNER , POSBLOCK , OIlO , OOII , OIlO , OIlO );{$ELSE} STATUS := BTRV (BCLEAROWNER , POSBLOCK ,
  209. OIlO , OOII , OIlO , OIlO , OIlO );{$ENDIF} UNTIL (NOT ERROR (STATUS , BCLEAROWNER , PATH ));END ;
  210. PROCEDURE BTRIEVEFILE.CLOSE ;VAR OIlO:INTEGER;OOII:WORD;BEGIN IF FILEOPEN THEN BEGIN REPEAT OIlO := 0 ;OOII := 0 ;
  211. {$IFDEF MSDOS} STATUS := BTRV (BCLOSE , POSBLOCK , OIlO , OOII , OIlO , 0 );{$ELSE} STATUS := BTRV (BCLOSE , POSBLOCK ,
  212. OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BCLOSE , PATH ));FILEOPEN := NOT (STATUS =BOKAY );
  213. END ;END ;FUNCTION BTRIEVEFILE.ERROR (ERRSTATUS:INTEGER;OPCODE:INTEGER;FILENAME:PATHSTR):BOOLEAN ;BEGIN IF (ERRHANDLER <>
  214. NIL )THEN ERROR := ERRHANDLER ^. ERROR (ERRSTATUS , OPCODE , FILENAME )ELSE ERROR := FALSE ;END ;
  215. PROCEDURE BTRIEVEFILE.GET (OP:INTEGER;LOCK:WORD);BEGIN BYTESREAD := DATASIZE ;REPEAT {$IFDEF MSDOS} STATUS := BTRV (OP +
  216. LOCK , POSBLOCK , DATA ^, BYTESREAD , KEY ^, CURINDEX );{$ELSE} STATUS := BTRV (OP + LOCK , POSBLOCK , DATA ^, BYTESREAD
  217. , KEY ^, KEYSIZE , CURINDEX );{$ENDIF} UNTIL (NOT ERROR (STATUS , OP , PATH ));END ;PROCEDURE BTRIEVEFILE.GETDIRECT
  218. (LOCK:WORD;POSITION:LONGINT);BEGIN BYTESREAD := DATASIZE ;MOVE (POSITION , DATA ^, 4 );REPEAT {$IFDEF MSDOS} STATUS :=
  219. BTRV (BGETDIRECT + LOCK , POSBLOCK , DATA ^, BYTESREAD , KEY ^, CURINDEX );{$ELSE} STATUS := BTRV (BGETDIRECT + LOCK ,
  220. POSBLOCK , DATA ^, BYTESREAD , KEY ^, KEYSIZE , CURINDEX );{$ENDIF} UNTIL (NOT ERROR (STATUS , BGETDIRECT , PATH ));
  221. END ;PROCEDURE BTRIEVEFILE.INSERT ;BEGIN FIXKEYSTRINGS ;REPEAT {$IFDEF MSDOS} STATUS := BTRV (BINSERT , POSBLOCK , DATA
  222. ^, BYTESTOWRITE , KEY ^, CURINDEX );{$ELSE} STATUS := BTRV (BINSERT , POSBLOCK , DATA ^, BYTESTOWRITE , KEY ^, KEYSIZE ,
  223. CURINDEX );{$ENDIF} UNTIL (NOT ERROR (STATUS , BINSERT , PATH ));END ;PROCEDURE BTRIEVEFILE.UPDATE ;BEGIN FIXKEYSTRINGS ;
  224. REPEAT {$IFDEF MSDOS} STATUS := BTRV (BUPDATE , POSBLOCK , DATA ^, BYTESTOWRITE , KEY ^, CURINDEX );{$ELSE} STATUS :=
  225. BTRV (BUPDATE , POSBLOCK , DATA ^, BYTESTOWRITE , KEY ^, KEYSIZE , CURINDEX );{$ENDIF} UNTIL (NOT ERROR (STATUS , BUPDATE
  226. , PATH ));END ;PROCEDURE BTRIEVEFILE.DELETE ;VAR OIlO:INTEGER;BEGIN BYTESREAD := DATASIZE ;REPEAT OIlO := 0 ;
  227. {$IFDEF MSDOS} STATUS := BTRV (BDELETE , POSBLOCK , OIlO , BYTESREAD , OIlO , 0 );{$ELSE} STATUS := BTRV (BDELETE ,
  228. POSBLOCK , DATA ^, BYTESREAD , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BDELETE , PATH ));BYTESREAD := 0 ;
  229. END ;FUNCTION BTRIEVEFILE.GETPOSITION :LONGINT ;VAR OIlO:INTEGER;OIOllI0O1OI:LONGINT;O1lO01OlI1lO:WORD;
  230. BEGIN O1lO01OlI1lO := 4 ;REPEAT OIlO := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BGETPOSITION , POSBLOCK , OIOllI0O1OI ,
  231. O1lO01OlI1lO , OIlO , 0 );{$ELSE} STATUS := BTRV (BGETPOSITION , POSBLOCK , OIOllI0O1OI , O1lO01OlI1lO , OIlO , OIlO , 0
  232. );{$ENDIF} UNTIL (NOT ERROR (STATUS , BGETPOSITION , PATH ));IF (STATUS =BOKAY )THEN GETPOSITION := OIOllI0O1OI ELSE
  233. GETPOSITION := - 1 ;END ;PROCEDURE BTRIEVEFILE.UNLOCKALL (LOCK:WORD);VAR OIlO:INTEGER;OOII:WORD;OI1IO1Ol101O:INTEGER;
  234. BEGIN IF (LOCK <= BSINGLENOWAIT )THEN OI1IO1Ol101O := 1 ELSE OI1IO1Ol101O := - 2 ;REPEAT OIlO := 0 ;OOII := 0 ;
  235. {$IFDEF MSDOS} STATUS := BTRV (BUNLOCK , POSBLOCK , OIlO , OOII , OIlO , OI1IO1Ol101O );{$ELSE} STATUS := BTRV (BUNLOCK ,
  236. POSBLOCK , OIlO , OOII , OIlO , OIlO , OI1IO1Ol101O );{$ENDIF} UNTIL (NOT ERROR (STATUS , BUNLOCK , PATH ));END ;
  237. PROCEDURE BTRIEVEFILE.ADDERRORS (ERRORCODES:ERRORSET);BEGIN IF (ERRHANDLER <> NIL )THEN ERRHANDLER ^. ADDERRORS
  238. (ERRORCODES );END ;PROCEDURE BTRIEVEFILE.REMOVEERRORS (ERRORCODES:ERRORSET);BEGIN IF (ERRHANDLER <> NIL )THEN ERRHANDLER
  239. ^. REMOVEERRORS (ERRORCODES );END ;PROCEDURE BTRIEVEFILE.SETERRORS (ERRORCODES:ERRORSET);BEGIN IF (ERRHANDLER <> NIL
  240. )THEN ERRHANDLER ^. SETERRORS (ERRORCODES );END ;PROCEDURE BTRIEVEFILE.GETERRORS (VAR ERRORCODES:ERRORSET);BEGIN IF
  241. (ERRHANDLER <> NIL )THEN ERRHANDLER ^. GETERRORS (ERRORCODES )ELSE ERRORCODES := [ ] ;END ;
  242. PROCEDURE BTRIEVEFILE.ERRORSONOFF (STATE:BOOLEAN);BEGIN IF (ERRHANDLER <> NIL )THEN ERRHANDLER ^. ERRORSONOFF (STATE );
  243. END ;PROCEDURE BTRIEVEFILE.CLEARBUFFER ;BEGIN IF (DATA <> NIL )THEN FILLCHAR (DATA ^, DATASIZE , FILLVALUE );BYTESREAD :=
  244. 0 ;END ;PROCEDURE BTRIEVEFILE.SETOUTPUTSIZE (SIZE:WORD);BEGIN BYTESTOWRITE := SIZE ;END ;PROCEDURE BTRIEVEFILE.CLEARKEY ;
  245. BEGIN IF (KEY <> NIL )THEN FILLCHAR (KEY ^, KEYSIZE , FILLVALUE );END ;PROCEDURE BTRIEVEFILE.FILLKEYBUFFER (VAR BUFF;
  246. SIZE:BYTE);BEGIN IF (SIZE > KEYSIZE )THEN SIZE := KEYSIZE ;CLEARKEY ;MOVE (BUFF , KEY ^, SIZE );END ;
  247. PROCEDURE BTRIEVEFILE.MAKEKEY (V1:POINTER;V2:POINTER;V3:POINTER;V4:POINTER;V5:POINTER;V6:POINTER);
  248. VAR O100lll01I0IO:POINTER;OI0l1l010OIO:BYTE;O10OIIll10l01:BYTE;O1OO1lIO1OO1:BYTE;O1Ol1IO01O11:WORD;O11lIOII:STRING ;
  249. OOIO:BYTE;BEGIN CLEARKEY ;O10OIIll10l01 := 1 ;OI0l1l010OIO := 1 ;O1OO1lIO1OO1 := KEYSTART [ CURINDEX ] ;REPEAT
  250. CASE OI0l1l010OIO  OF 1 :O100lll01I0IO := V1 ;2 :O100lll01I0IO := V2 ;3 :O100lll01I0IO := V3 ;4 :O100lll01I0IO := V4 ;5
  251. :O100lll01I0IO := V5 ;6 :O100lll01I0IO := V6 ;END ;MOVE (O100lll01I0IO ^, PBYTES (KEY )^[ O10OIIll10l01 ] , KEYLIST [
  252. O1OO1lIO1OO1 ] . KEYLEN );CASE KEYLIST [ O1OO1lIO1OO1 ] . KEYTYPE  OF BSTRING , BZSTRING , BLSTRING :BEGIN CASE KEYLIST [
  253. O1OO1lIO1OO1 ] . JUSTIFY  OF BRJUSTIFY , BLJUSTIFY :BEGIN JUSTIFYSTRING (@ (PBYTES (KEY )^[ O10OIIll10l01 ] ), KEYLIST [
  254. O1OO1lIO1OO1 ] . KEYLEN , KEYLIST [ O1OO1lIO1OO1 ] . KEYTYPE , KEYLIST [ O1OO1lIO1OO1 ] . JUSTIFY );END ;END ;END ;END ;
  255. O1Ol1IO01O11 := KEYLIST [ O1OO1lIO1OO1 ] . KEYFLAGS AND BSEGMENTED ;O10OIIll10l01 := O10OIIll10l01 + KEYLIST [
  256. O1OO1lIO1OO1 ] . KEYLEN ;INC (O1OO1lIO1OO1 );INC (OI0l1l010OIO );UNTIL (O1Ol1IO01O11 =0 );END ;
  257. PROCEDURE BTRIEVEFILE.FIXKEYSTRINGS ;VAR OIlO:BYTE;BEGIN FOR OIlO := 1 TO SEGMENTCNT  DO BEGIN CASE KEYLIST [ OIlO ] .
  258. KEYTYPE  OF BSTRING , BZSTRING , BLSTRING :BEGIN CASE KEYLIST [ OIlO ] . JUSTIFY  OF BRJUSTIFY , BLJUSTIFY
  259. :BEGIN JUSTIFYSTRING (@ (PBYTES (DATA )^[ KEYLIST [ OIlO ] . KEYPOS ] ), KEYLIST [ OIlO ] . KEYLEN , KEYLIST [ OIlO ] .
  260. KEYTYPE , KEYLIST [ OIlO ] . JUSTIFY );END ;END ;END ;END ;END ;END ;PROCEDURE BTRIEVEFILE.JUSTIFYSTRING (BUFF:PBYTES;
  261. SIZE:BYTE;KEYTYPE:BYTE;JUSTIFY:BYTE);VAR OIll:BYTE;OOIO:BYTE;OIO0O1I11lO:BYTE;O11lIOII:STRING ;BEGIN CASE KEYTYPE
  262.  OF BLSTRING :BEGIN MOVE (BUFF ^, O11lIOII [ 0 ] , SIZE );OIO0O1I11lO := SIZE - 1 ;END ;BZSTRING :BEGIN OOIO := 1 ;
  263. WHILE (OOIO < SIZE )AND (BUFF ^[ OOIO ] <> 0 ) DO BEGIN O11lIOII [ OOIO ] := CHR (BUFF ^[ OOIO ] );INC (OOIO );END ;
  264. O11lIOII [ 0 ] := CHR (OOIO - 1 );OIO0O1I11lO := SIZE - 1 ;END ;BSTRING :BEGIN OOIO := 0 ;WHILE (OOIO < SIZE )AND (BUFF
  265. ^[ OOIO + 1 ] > 31 ) DO BEGIN INC (OOIO );O11lIOII [ OOIO ] := CHR (BUFF ^[ OOIO ] );END ;O11lIOII [ 0 ] := CHR (OOIO );
  266. OIO0O1I11lO := SIZE ;END ;END ;CASE JUSTIFY  OF BRJUSTIFY :BEGIN OI10OIO00IOO (O11lIOII );O1Ill101O1 (O11lIOII ,
  267. OIO0O1I11lO )END ;BLJUSTIFY :BEGIN OI10OIO00IOO (O11lIOII );OI1I11I01OO (O11lIOII , OIO0O1I11lO );END ;END ;CASE KEYTYPE
  268.  OF BLSTRING :BEGIN MOVE (O11lIOII [ 0 ] , BUFF ^, SIZE );END ;BZSTRING :BEGIN MOVE (O11lIOII [ 1 ] , BUFF ^, SIZE - 1 );
  269. BUFF ^[ SIZE ] := 0 ;END ;BSTRING :BEGIN MOVE (O11lIOII [ 1 ] , BUFF ^, SIZE );END ;END ;END ;
  270. FUNCTION BTRIEVEFILE.ISOPEN ;BEGIN ISOPEN := FILEOPEN ;END ;FUNCTION BTRIEVEFILE.NUMBEROFRECORDS :LONGINT ;
  271. VAR O1lO01OlI1lO:WORD;O1l1O0010OO0:ARRAY [ 1 .. 1024 ]  OF BYTE;OIOI100IlI0:FILESPEC ABSOLUTE O1l1O0010OO0;
  272. OOIlIOOlOI11:ARRAY [ 1 .. 64 ]  OF BYTE;BEGIN O1lO01OlI1lO := SIZEOF (O1l1O0010OO0 );REPEAT {$IFDEF MSDOS} STATUS := BTRV
  273. (BSTAT , POSBLOCK , O1l1O0010OO0 , O1lO01OlI1lO , OOIlIOOlOI11 , 0 );{$ELSE} STATUS := BTRV (BSTAT , POSBLOCK ,
  274. O1l1O0010OO0 , O1lO01OlI1lO , OOIlIOOlOI11 , 64 , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BSTAT , PATH ));IF (STATUS
  275. =BOKAY )THEN NUMBEROFRECORDS := OIOI100IlI0.RECORDS ELSE NUMBEROFRECORDS := - 1 ;END ;FUNCTION BTRIEVEFILE.BRESULT
  276. :INTEGER ;BEGIN BRESULT := STATUS ;END ;DESTRUCTOR BTRIEVEFILE.DONE ;BEGIN IF ALLOCATEKEY AND (KEY <> NIL )THEN FREEMEM
  277. (KEY , KEYSIZE );IF ALLOCATEDATA AND (DATA <> NIL )THEN FREEMEM (DATA , DATASIZE );END ;
  278. PROCEDURE BTRIEVEFILE.STARTTRANSACTION (LOCK:WORD);VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]
  279.  OF BYTE;BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BBEGINTRANSACTION , OIlO , OIlO , OOII , OIlO
  280. , 0 );{$ELSE} STATUS := BTRV (BBEGINTRANSACTION , O10O0IO0lOllI , OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT
  281. ERROR (STATUS , BBEGINTRANSACTION + LOCK , PATH ));END ;PROCEDURE BTRIEVEFILE.ENDTRANSACTION ;VAR OIlO:INTEGER;
  282. OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS :=
  283. BTRV (BENDTRANSACTION , OIlO , OIlO , OOII , OIlO , 0 );{$ELSE} STATUS := BTRV (BENDTRANSACTION , O10O0IO0lOllI , OIlO ,
  284. OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BENDTRANSACTION , PATH ));END ;
  285. PROCEDURE BTRIEVEFILE.ABORTTRANSACTION ;VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;
  286. BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BABORTTRANSACTION , OIlO , OIlO , OOII , OIlO , 0 );
  287. {$ELSE} STATUS := BTRV (BABORTTRANSACTION , O10O0IO0lOllI , OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR
  288. (STATUS , BABORTTRANSACTION , PATH ));END ;PROCEDURE BTRIEVEFILE.STAT (VAR FDATA:FILESPEC);VAR OI111IlIO100:ARRAY [ 1 ..
  289. 128 ]  OF CHAR;BEGIN BYTESREAD := SIZEOF (FILESPEC );REPEAT {$IFDEF MSDOS} STATUS := BTRV (BSTAT , POSBLOCK , FDATA ,
  290. BYTESREAD , OI111IlIO100 , 0 );{$ELSE} STATUS := BTRV (BSTAT , POSBLOCK , FDATA , BYTESREAD , OI111IlIO100 , 128 , 0 );
  291. {$ENDIF} UNTIL (NOT ERROR (STATUS , BSTAT , PATH ));END ;PROCEDURE BTRIEVEFILE.VERSION (VAR VER:WORD;VAR REV:WORD;
  292. VAR OSFLAG:CHAR);VAR OIlO:INTEGER;O1lO01OlI1lO:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;OOlIll0O0lll:ARRAY
  293. [ 0 .. 19 ]  OF BYTE;BEGIN O1lO01OlI1lO := SIZEOF (OOlIll0O0lll );REPEAT OIlO := 0 ;{$IFDEF MSDOS} STATUS := BTRV
  294. (BVERSION , OIlO , OOlIll0O0lll , O1lO01OlI1lO , OIlO , 0 );{$ELSE} STATUS := BTRV (BVERSION , O10O0IO0lOllI ,
  295. OOlIll0O0lll , O1lO01OlI1lO , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BVERSION , ''));MOVE (OOlIll0O0lll [
  296. 0 ] , VER , 2 );MOVE (OOlIll0O0lll [ 2 ] , REV , 2 );MOVE (OOlIll0O0lll [ 4 ] , OSFLAG , 1 );END ;
  297. PROCEDURE BTRIEVEFILE.UNLOAD ;VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;BEGIN REPEAT
  298. OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BSTOP , OIlO , OIlO , OOII , OIlO , 0 );{$ELSE} STATUS := BTRV
  299. (BSTOP , O10O0IO0lOllI , OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BSTOP , ''));END ;
  300. PROCEDURE BTRIEVEFILE.RESET ;VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;BEGIN REPEAT
  301. OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BRESET , OIlO , OIlO , OOII , OIlO , 0 );{$ELSE} STATUS := BTRV
  302. (BRESET , O10O0IO0lOllI , OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} UNTIL (NOT ERROR (STATUS , BSTOP , ''));END ;
  303. PROCEDURE BTRIEVEFILE.RESETSTATION (CONNECTION:WORD);VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]
  304.  OF BYTE;BEGIN REPEAT OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} STATUS := BTRV (BRESET , OIlO , OIlO , OOII , CONNECTION , - 1
  305. );{$ELSE} STATUS := BTRV (BRESET , O10O0IO0lOllI , OIlO , OOII , CONNECTION , 2 , - 1 );{$ENDIF} UNTIL (NOT ERROR (STATUS
  306. , BSTOP , ''));END ;CONSTRUCTOR ERRORHANDLER.INIT (DISPLAYOBJECT:PERRORDISPLAY);BEGIN RETRYCOUNT := 0 ;MAXRETRY := 5 ;
  307. RETRYDELAY := 5000 ;ERRDISPLAY := DISPLAYOBJECT ;TRAPPEDERRORS := [ BINVALIDOP .. BLASTERROR ] - [ BEOF ] ;ERRORSON :=
  308. TRUE ;END ;DESTRUCTOR ERRORHANDLER.DONE ;BEGIN END ;FUNCTION ERRORHANDLER.ERRORMSG (ERRORCODE:INTEGER):STRING ;
  309. VAR OO1O:STRING [ 10 ] ;BEGIN STR (ERRORCODE , OO1O );ERRORMSG := 'Btrieve Error # '+ OO1O ;END ;
  310. FUNCTION ERRORHANDLER.OPMSG (OPCODE:INTEGER):STRING ;VAR OO1O:STRING [ 10 ] ;BEGIN STR (OPCODE , OO1O );OPMSG :=
  311. 'Btrieve Operation # '+ OO1O ;END ;PROCEDURE ERRORHANDLER.SETMAXRETRY (RETRY:WORD);BEGIN MAXRETRY := RETRY ;END ;
  312. FUNCTION ERRORHANDLER.GETMAXRETRY :WORD ;BEGIN GETMAXRETRY := MAXRETRY ;END ;PROCEDURE ERRORHANDLER.CLEARRETRY ;
  313. BEGIN RETRYCOUNT := 0 ;END ;PROCEDURE ERRORHANDLER.SETDELAY (SECONDS:WORD);BEGIN RETRYDELAY := SECONDS * 1000 ;END ;
  314. FUNCTION ERRORHANDLER.GETDELAY :WORD ;BEGIN GETDELAY := RETRYDELAY DIV 1000 ;END ;PROCEDURE ERRORHANDLER.ADDERRORS
  315. (ERRORCODES:ERRORSET);BEGIN TRAPPEDERRORS := TRAPPEDERRORS + ERRORCODES ;END ;PROCEDURE ERRORHANDLER.REMOVEERRORS
  316. (ERRORCODES:ERRORSET);BEGIN TRAPPEDERRORS := TRAPPEDERRORS - ERRORCODES ;END ;PROCEDURE ERRORHANDLER.SETERRORS
  317. (ERRORCODES:ERRORSET);BEGIN TRAPPEDERRORS := ERRORCODES ;END ;PROCEDURE ERRORHANDLER.GETERRORS (VAR ERRORCODES:ERRORSET);
  318. BEGIN ERRORCODES := TRAPPEDERRORS ;END ;PROCEDURE ERRORHANDLER.ERRORSONOFF (STATE:BOOLEAN);BEGIN ERRORSON := STATE ;
  319. END ;FUNCTION ERRORHANDLER.ERRORDISPACTHER (ERRORCODE:INTEGER;OPCODE:INTEGER;FILENAME:PATHSTR):ERRORACTION ;
  320. VAR OOllO01O1010:ERRORACTION;BEGIN IF (ERRDISPLAY <> NIL )THEN BEGIN OOllO01O1010 := ERRDISPLAY ^. DISPLAY (ERRORCODE ,
  321. ERRORMSG (ERRORCODE ), OPCODE , OPMSG (OPCODE ), FILENAME );IF (OOllO01O1010 =ERABORT )THEN {$IFDEF WINDOWS}
  322. POSTQUITMESSAGE (999 );{$ELSE} HALT (ERRORCODE );{$ENDIF} END ELSE BEGIN OOllO01O1010 := ERDONE ;END ;CLEARRETRY ;
  323. ERRORDISPACTHER := OOllO01O1010 ;END ;FUNCTION ERRORHANDLER.ERROR (STATUS:INTEGER;OPCODE:INTEGER;
  324. FILENAME:PATHSTR):BOOLEAN ;{$IFDEF WINDOWS} VAR OI111O0100ll:LONGINT;OI1ll0l0011:TMSG;{$ENDIF} BEGIN IF ERRORSON AND
  325. ((STATUS > BLASTERROR )OR (STATUS IN TRAPPEDERRORS ))THEN BEGIN IF (STATUS =BRECORDINUSE )OR (STATUS =BFILEINUSE )THEN
  326. BEGIN IF (RETRYCOUNT < MAXRETRY )THEN BEGIN INC (RETRYCOUNT );{$IFDEF WINDOWS} {$IFDEF __RANGE_ON} {$R-} {$ENDIF}
  327. {$IFDEF __OVERFLOW_ON} {$Q-} {$ENDIF} OI111O0100ll := GETCURRENTTIME + LONGINT (RETRYDELAY );REPEAT PEEKMESSAGE
  328. (OI1ll0l0011 , 0 , 0 , 0 , PM_NOREMOVE );UNTIL (OI111O0100ll >= GETCURRENTTIME );{$IFDEF __RANGE_ON} {$R+} {$ENDIF}
  329. {$IFDEF __OVERFLOW_ON} {$Q+} {$ENDIF} {$ELSE} DELAY (RETRYDELAY );{$ENDIF} ERROR := TRUE ;END ELSE ERROR :=
  330. (ERRORDISPACTHER (STATUS , OPCODE , FILENAME )=ERRETRY );END ELSE ERROR := (ERRORDISPACTHER (STATUS , OPCODE , FILENAME
  331. )=ERRETRY );END ELSE BEGIN ERROR := FALSE ;CLEARRETRY ;END ;END ;FUNCTION DEFERRORHANDLER.ERRORMSG
  332. (ERRORCODE:INTEGER):STRING ;BEGIN CASE ERRORCODE  OF BOKAY :ERRORMSG := 'No error';BINVALIDOP :ERRORMSG :=
  333. 'Invalid operation';BIOERROR :ERRORMSG := 'I/O error';BFILENOTOPEN :ERRORMSG := 'File not open';BKEYNOTFOUND :ERRORMSG :=
  334. 'Key value not found';BDUPLICATEKEY :ERRORMSG := 'Duplicate keys not allowed';BINVALIDKEY :ERRORMSG :=
  335. 'Invalid key number';BDIFFERENTKEY :ERRORMSG := 'Different key number from previous read';BINVALIDPOS :ERRORMSG :=
  336. 'Invalid file positioning';BEOF :ERRORMSG := 'End of file';BKEYMODIFYERR :ERRORMSG := 'Key data may not be modified';
  337. BINVALIDNAME :ERRORMSG := 'Invalid file name';BFILENOTFOUND :ERRORMSG := 'File not found';BPREIMAGEOPENERR :ERRORMSG :=
  338. 'Pre-Image file open error';BPREIMAGEIOERR :ERRORMSG := 'Pre-Image file I/O error';BEXPANSIONERR :ERRORMSG :=
  339. 'Expansion file error';BCLOSEERR :ERRORMSG := 'Close error';BDISKFULL :ERRORMSG := 'Disk full';BUNRECOVERABLEERR
  340. :ERRORMSG := 'Unrecoverable error, File may be corrupt';BNOTLOADED :ERRORMSG := 'Btrieve is not loaded';BKEYBUFFERSHORT
  341. :ERRORMSG := 'Key buffer too short';BDATABUFFERSHORT :ERRORMSG := 'Data buffer too short';BPOSBLOCKSHORT :ERRORMSG :=
  342. 'Position block is not 128 bytes in size';BPAGESIZEERR :ERRORMSG := 'Page size error';BCREATEIOERR :ERRORMSG :=
  343. 'File creation error';BNUMBERKEYS :ERRORMSG := 'Number of keys is invalid';BINVALIDKEYPOS :ERRORMSG :=
  344. 'Invalid key position';BRECORDLENERR :ERRORMSG := 'Invalid record length';BKEYLENERR :ERRORMSG := 'Invalid key length';
  345. BNOTBTRIEVEFILE :ERRORMSG := 'File is not a Btrieve file';BTRANSACTIONERR :ERRORMSG := '/T option was not specified';
  346. BTRANSACTIONACTIVE :ERRORMSG := 'A transaction is already active';BTRANSACTIONFILEERR :ERRORMSG :=
  347. 'Transaction control file I/O error';BTRANSACTIONENDERR :ERRORMSG := 'No begin transaction issued';BTRANSACTIONMAXFILES
  348. :ERRORMSG := 'Maximum number of transaction files (12) exceeded';BOPNOTALLOWED :ERRORMSG := 'Operation not allowed';
  349. BACCELERATEDERR :ERRORMSG := 'Incomplete accelerated access, File may be corrupt';BINVALIDADDRESS :ERRORMSG :=
  350. 'Invalid record address';BNULLKEYPATH :ERRORMSG := 'Null key path';BBADKEYFLAGS :ERRORMSG := 'Inconsistent key flags';
  351. BFILEACCESSDENIED :ERRORMSG := 'Access to file denied';BMAXOPENFILES :ERRORMSG := 'Maximum number of files open';
  352. BINVALIDALTSEQUENCE :ERRORMSG := 'Invalid alternate collating sequence definition';BKEYTYPEERR :ERRORMSG :=
  353. 'Key type error';BOWNERISSET :ERRORMSG := 'Owner is already set';BINVALIDOWNER :ERRORMSG := 'Invalid owner';
  354. BCACHEWRITEERR :ERRORMSG := 'Error writing cache buffer';BINVALIDVERSION :ERRORMSG := 'Invalid Btrieve version';
  355. BVARIABLEPAGEERR :ERRORMSG := 'Variable page error';BAUTOINCREMENTERR :ERRORMSG := 'Autoincrement key error';BBADINDEX
  356. :ERRORMSG := 'A supplemental index is damaged';BEXPANDEDMEMORYERR :ERRORMSG := 'Expanded memory error';
  357. BCOMPRESSBUFFSHORT :ERRORMSG := 'Compression buffer too short';BFILEEXISTS :ERRORMSG := 'File already exists';
  358. {$IFDEF BTRIEVE50} BREJECTMAX :ERRORMSG := 'Reject count reached';BWORKSPACESHORT :ERRORMSG := 'Work space too small';
  359. BDESCRIPTORERR :ERRORMSG := 'Incorrect descriptor';BEXTINSERTBUFFERR :ERRORMSG := 'Invalid extended insert buffer';
  360. BFILTERLIMIT :ERRORMSG := 'Filter limit reached';BFIELDOFFSETERR :ERRORMSG := 'Incorrect field offset';{$ENDIF} BTTSABORT
  361. :ERRORMSG := 'Automatic transaction abort';BDEADLOCK :ERRORMSG := 'Deadlock detected';BCONFLICT :ERRORMSG :=
  362. 'Record has been changed';BLOCKERR :ERRORMSG := 'File lock error';BLOSTPOSITION :ERRORMSG := 'File positioning lost';
  363. BOUTOFTRANSACTION :ERRORMSG := 'Read outside of a transaction';BRECORDINUSE :ERRORMSG := 'Record in use';BFILEINUSE
  364. :ERRORMSG := 'File in use';BFILETBLFULL :ERRORMSG := 'File table is full';BHANDLETBLFULL :ERRORMSG :=
  365. 'No file handles available';BBADMODEERR :ERRORMSG := 'Incompatible file open mode';BDEVICETABLEFULL :ERRORMSG :=
  366. 'Redirected device table full';BSERVERERR :ERRORMSG := 'Server error';BTRANTABLEFULL :ERRORMSG :=
  367. 'Transaction table full';BBADLOCKTYPE :ERRORMSG := 'Lock types are incompatible';BPERMISSIONERR :ERRORMSG :=
  368. 'Permission error';BSESSIONINVALID :ERRORMSG := 'Session no longer valid';BCOMMUNICATIONERR :ERRORMSG :=
  369. 'Communications environment error';BDATAMESSAGESHORT :ERRORMSG := 'Data message to small';BINTERNALTTSERR :ERRORMSG :=
  370. 'Internal TTS error';BOUTOFMEMORY :ERRORMSG := 'Application Low on Memory';BDUPLICATEFILENAME :ERRORMSG :=
  371. 'Duplicate filename error';BLOADINPUTERR :ERRORMSG := 'Input error on file load';ELSE ERRORMSG := 'Unknown error';END ;
  372. END ;FUNCTION DEFERRORHANDLER.OPMSG (OPCODE:INTEGER):STRING ;BEGIN CASE OPCODE  OF BOPEN :OPMSG := 'Open file';BCLOSE
  373. :OPMSG := 'Close file';BINSERT :OPMSG := 'Insert new record';BUPDATE :OPMSG := 'Update existing record';BDELETE :OPMSG :=
  374. 'Delete record';BGETEQUAL :OPMSG := 'Read record equal to key';BGETGREAT :OPMSG := 'Read record greater than key';
  375. BGETGREATEQUAL :OPMSG := 'Read record greater than or equal to key';BGETLESS :OPMSG := 'Read record less than key';
  376. BGETLESSEQUAL :OPMSG := 'Read record less than or equal to key';BGETNEXT :OPMSG := 'Read next record';BGETPREV :OPMSG :=
  377. 'Read previous record';BGETFIRST :OPMSG := 'Read first record';BGETLAST :OPMSG := 'Read last record';BCREATE :OPMSG :=
  378. 'Create file';BSTAT :OPMSG := 'Get file statistics';BBEGINTRANSACTION :OPMSG := 'Begin transaction';BENDTRANSACTION
  379. :OPMSG := 'End transaction';BABORTTRANSACTION :OPMSG := 'Abort transaction';BGETPOSITION :OPMSG := 'Get record position';
  380. BGETDIRECT :OPMSG := 'Read record by position';BSTEPNEXT :OPMSG := 'Step to next record';BSTOP :OPMSG :=
  381. 'Unload record manager';BVERSION :OPMSG := 'Get version number';BUNLOCK :OPMSG := 'Unlock';BRESET :OPMSG :=
  382. 'Reset record manager';BSETOWNER :OPMSG := 'Set file owner';BCLEAROWNER :OPMSG := 'Clear file owner';BCREATEINDEX :OPMSG
  383. := 'Creating supplemental index';BDROPINDEX :OPMSG := 'Dropping supplemental index';{$IFDEF BTRIEVE50} BSTEPFIRST :OPMSG
  384. := 'Step to first record';BSTEPLAST :OPMSG := 'Step to last record';BSTEPPREV :OPMSG := 'Step to previous record';
  385. BXGETNEXT :OPMSG := 'Extended read next record';BXGETPREV :OPMSG := 'Extneded read previous record';BXSTEPNEXT :OPMSG :=
  386. 'Extended step to next record';BXSTEPPREV :OPMSG := 'Extended step to previous record';BXINSERT :OPMSG :=
  387. 'Extended insert record';{$ENDIF} ELSE OPMSG := 'Unknown operation';END ;END ;CONSTRUCTOR DISKERRORHANDLER.INIT
  388. (DISPLAYOBJECT:PERRORDISPLAY;ERRORPATH:PATHSTR);VAR OIlO:INTEGER;OOII:WORD;O10OOIlO1OIO1:INTEGER;OIlIl0O0010:ARRAY [ 0 ..
  389. 80 ]  OF CHAR;BEGIN ERRORHANDLER.INIT (DISPLAYOBJECT );MOVE (ERRORPATH [ 1 ] , OIlIl0O0010 [ 0 ] , LENGTH (ERRORPATH ));
  390. OIlIl0O0010 [ LENGTH (ERRORPATH )] := #0;OIlO := 0 ;OOII := 0 ;{$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BOPEN , POSBLOCK ,
  391. OIlO , OOII , OIlIl0O0010 , BREADONLY );{$ELSE} O10OOIlO1OIO1 := BTRV (BOPEN , POSBLOCK , OIlO , OOII , OIlIl0O0010 ,
  392. LENGTH (ERRORPATH )+ 1 , BREADONLY );{$ENDIF} FILEOPEN := (O10OOIlO1OIO1 =BOKAY );END ;DESTRUCTOR DISKERRORHANDLER.DONE ;
  393. VAR OIlO:INTEGER;OOII:WORD;O10OOIlO1OIO1:INTEGER;BEGIN ERRORHANDLER.DONE ;IF FILEOPEN THEN BEGIN OIlO := 0 ;OOII := 0 ;
  394. {$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BCLOSE , POSBLOCK , OIlO , OOII , OIlO , 0 );{$ELSE} O10OOIlO1OIO1 := BTRV (BCLOSE
  395. , POSBLOCK , OIlO , OOII , OIlO , OIlO , 0 );{$ENDIF} FILEOPEN := NOT (O10OOIlO1OIO1 =BOKAY );END ;END ;
  396. FUNCTION DISKERRORHANDLER.ERRORMSG (ERRORCODE:INTEGER):STRING ;VAR OOII:WORD;O10OOIlO1OIO1:INTEGER;OIOI100IlI0:STRING [
  397. 81 ] ;OI1II1O1l0l0:BTRIEVEMSGREC;OIlllI0OIOO:RECORD OIIO1OlIIIl:INTEGER;OI0ll01lOOOl:INTEGER;END ;BEGIN IF (ERRORCODE
  398. =BNOTLOADED )THEN BEGIN ERRORMSG := 'Btrieve is not loaded';EXIT ;END ;IF FILEOPEN THEN BEGIN OIlllI0OIOO.OIIO1OlIIIl :=
  399. 0 ;OIlllI0OIOO.OI0ll01lOOOl := ERRORCODE ;OOII := SIZEOF (OI1II1O1l0l0 );{$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BGETEQUAL
  400. , POSBLOCK , OI1II1O1l0l0 , OOII , OIlllI0OIOO , 0 );{$ELSE} O10OOIlO1OIO1 := BTRV (BGETEQUAL , POSBLOCK , OI1II1O1l0l0 ,
  401. OOII , OIlllI0OIOO , SIZEOF (OIlllI0OIOO ), 0 );{$ENDIF} END ELSE O10OOIlO1OIO1 := BEOF ;IF (O10OOIlO1OIO1 =BOKAY )THEN
  402. BEGIN OOII := 0 ;WHILE (OI1II1O1l0l0.NAME [ OOII ] <> #0)AND (OOII < 81 ) DO BEGIN OIOI100IlI0 [ OOII + 1 ] :=
  403. OI1II1O1l0l0.NAME [ OOII ] ;INC (OOII );END ;OIOI100IlI0 [ 0 ] := CHR (OOII );ERRORMSG := OIOI100IlI0 ;END ELSE ERRORMSG
  404. := ERRORHANDLER.ERRORMSG (ERRORCODE );END ;FUNCTION DISKERRORHANDLER.OPMSG (OPCODE:INTEGER):STRING ;VAR OOII:WORD;
  405. O10OOIlO1OIO1:INTEGER;OIOI100IlI0:STRING [ 81 ] ;OI1II1O1l0l0:BTRIEVEMSGREC;OIlllI0OIOO:RECORD OIIO1OlIIIl:INTEGER;
  406. OI0ll01lOOOl:INTEGER;END ;BEGIN IF FILEOPEN THEN BEGIN OIlllI0OIOO.OIIO1OlIIIl := 1 ;OIlllI0OIOO.OI0ll01lOOOl := OPCODE ;
  407. OOII := SIZEOF (OI1II1O1l0l0 );{$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BGETEQUAL , POSBLOCK , OI1II1O1l0l0 , OOII ,
  408. OIlllI0OIOO , 0 );{$ELSE} O10OOIlO1OIO1 := BTRV (BGETEQUAL , POSBLOCK , OI1II1O1l0l0 , OOII , OIlllI0OIOO , SIZEOF
  409. (OIlllI0OIOO ), 0 );{$ENDIF} END ELSE O10OOIlO1OIO1 := BEOF ;IF (O10OOIlO1OIO1 =BOKAY )THEN BEGIN OOII := 0 ;
  410. WHILE (OI1II1O1l0l0.NAME [ OOII ] <> #0)AND (OOII < 81 ) DO BEGIN OIOI100IlI0 [ OOII + 1 ] := OI1II1O1l0l0.NAME [ OOII ]
  411. ;INC (OOII );END ;OIOI100IlI0 [ 0 ] := CHR (OOII );OPMSG := OIOI100IlI0 END ELSE OPMSG := ERRORHANDLER.OPMSG (OPCODE );
  412. END ;CONSTRUCTOR ERRORDISPLAY.INIT ;BEGIN END ;FUNCTION ERRORDISPLAY.DISPLAY (ERROR:INTEGER;ERRORMSG:STRING ;
  413. OPCODE:INTEGER;OPCODEMSG:STRING ;FILENAME:PATHSTR):ERRORACTION ;BEGIN RUNERROR (211 );END ;DESTRUCTOR ERRORDISPLAY.DONE ;
  414. BEGIN END ;CONSTRUCTOR TPROGRESS.INIT ;BEGIN END ;PROCEDURE TPROGRESS.DISPLAY (COUNT:LONGINT);BEGIN END ;
  415. DESTRUCTOR TPROGRESS.DONE ;BEGIN END ;PROCEDURE CHECKFORBTRIEVE ;VAR OIlO:INTEGER;O1lO01OlI1lO:WORD;
  416. O10OOIlO1OIO1:INTEGER;{$IFDEF VER70} O10O11I0I01O0:TREGISTERS;{$ELSE} O10O11I0I01O0:REGISTERS;{$ENDIF} O11lIOII:STRING [
  417. 80 ] ;OIO0O1I11lO:BYTE ABSOLUTE O11lIOII;OIOI100IlI0:ARRAY [ 0 .. 80 ]  OF CHAR;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]
  418.  OF BYTE;BEGIN OIlO := 0 ;O1lO01OlI1lO := SIZEOF (OIOI100IlI0 );{$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BVERSION , OIlO ,
  419. OIOI100IlI0 , O1lO01OlI1lO , OIlO , 0 );{$ELSE} O10OOIlO1OIO1 := BTRV (BVERSION , O10O0IO0lOllI , OIOI100IlI0 ,
  420. O1lO01OlI1lO , OIlO , OIlO , 0 );{$ENDIF} IF (O10OOIlO1OIO1 <> BOKAY )THEN BEGIN {$IFDEF WINDOWS} POSTQUITMESSAGE
  421. (WM_BRIEVENOTLOADED );{$ELSE} O11lIOII := 'Btrieve Record Manager is not loaded, program aborted!';MOVE (O11lIOII [ 1 ] ,
  422. OIOI100IlI0 [ 0 ] , OIO0O1I11lO );OIOI100IlI0 [ OIO0O1I11lO ] := #13;OIOI100IlI0 [ OIO0O1I11lO + 1 ] := #10;OIOI100IlI0 [
  423. OIO0O1I11lO + 2 ] := '$';O10O11I0I01O0.DS := SEG (OIOI100IlI0 );O10O11I0I01O0.DX := OFS (OIOI100IlI0 );O10O11I0I01O0.AH
  424. := $09 ;MSDOS (O10O11I0I01O0 );HALT (999 );{$ENDIF} END ;END ;PROCEDURE GETBTRIEVEVERSION (VAR VER:WORD;VAR REV:WORD;
  425. VAR OSFLAG:CHAR);VAR OIlO:INTEGER;O10OOIlO1OIO1:INTEGER;O1lO01OlI1lO:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]
  426.  OF BYTE;OOlIll0O0lll:ARRAY [ 0 .. 19 ]  OF BYTE;BEGIN FILLCHAR (OOlIll0O0lll , SIZEOF (OOlIll0O0lll ), 0 );O1lO01OlI1lO
  427. := SIZEOF (OOlIll0O0lll );OIlO := 0 ;{$IFDEF MSDOS} O10OOIlO1OIO1 := BTRV (BVERSION , OIlO , OOlIll0O0lll , O1lO01OlI1lO
  428. , OIlO , 0 );{$ELSE} O10OOIlO1OIO1 := BTRV (BVERSION , O10O0IO0lOllI , OOlIll0O0lll , O1lO01OlI1lO , OIlO , OIlO , 0 );
  429. {$ENDIF} IF (O10OOIlO1OIO1 =BOKAY )THEN BEGIN MOVE (OOlIll0O0lll [ 0 ] , VER , 2 );MOVE (OOlIll0O0lll [ 2 ] , REV , 2 );
  430. MOVE (OOlIll0O0lll [ 4 ] , OSFLAG , 1 );END ELSE BEGIN VER := 0 ;REV := 0 ;OSFLAG := ' ';END ;END ;
  431. PROCEDURE UNLOADBTRIEVE ;VAR OIlO:INTEGER;OOII:WORD;O10O0IO0lOllI:ARRAY [ 1 .. POSBLOCKSIZE]  OF BYTE;BEGIN OIlO := 0 ;
  432. OOII := 0 ;{$IFDEF MSDOS} BTRV (BSTOP , OIlO , OIlO , OOII , OIlO , 0 );{$ELSE} BTRV (BSTOP , O10O0IO0lOllI , OIlO , OOII
  433. , OIlO , OIlO , 0 );{$ENDIF} END ;FUNCTION O1011I1OlOIO1 (OI1OIIIl0lO1:WORD):INTEGER ;FAR ;BEGIN O1011I1OlOIO1 := 1 ;
  434. END ;BEGIN HEAPERROR := @ O1011I1OlOIO1 ;{$IFDEF BCHECK} CHECKFORBTRIEVE ;{$ENDIF} END .
  435.