Listing: 1 IMPLEMENTATION MODULE DBFTest; 2 FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile, 3 DeleteRecord,DefaultFixUp,NilDBF,PosOfField,DBFieldArray, 4 DBFieldPtr,BuildDBF,DBFieldDescriptor; 5 FROM DBCopier IMPORT DBPack; 6 FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex, 7 CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom, 8 NextRecord,PrevRecord,CurrentKeyCh,FindPositionN, 9 CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex; 10 FROM StrEdit IMPORT CrunchBlanks; 11 FROM HandleIO IMPORT FileExists; 12 FROM Storage IMPORT ALLOCATE,DEALLOCATE; 13 FROM DBStuff IMPORT MakeKey; 14 FROM Drectory IMPORT DeleteFile; 15 FROM StrConv IMPORT StrToReal; 16 FROM NumTypes IMPORT Real8; 17 FROM M2Strings IMPORT Assign; 18 FROM DBStuff IMPORT MakeKey,MakeDescriptor; ***** ^ duplicate identifier ***** ^ duplicate identifier 19 FROM ScanUtils IMPORT Present,CaseSens; 20 FROM LowLevel IMPORT Fill; 21 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, 22 ReplaceD,ReplaceN; 23 24 CONST 25 Buffer = 0; 26 Safty = TRUE; 27 Exclusive = FALSE; 28 AutoLock = TRUE; 29 KeepDeleted = FALSE; 30 VAR 31 IndexOpen : BOOLEAN; 32 33 PROCEDURE MakeDatabase(); 34 VAR 35 Error : CARDINAL; 36 Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor; ***** ^ not supported yet ***** ^ not supported yet 37 BEGIN 38 ALLOCATE(Desc, 2 * SIZE(DBFieldDescriptor)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 39 Fill(Desc, 2 * SIZE(DBFieldDescriptor),0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 40 MakeDescriptor( Desc^[ 1], 'TEST', 30, 0, 'C'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 41 MakeDescriptor( Desc^[ 2], 'TEMP', 20, 0, 'C'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 42 InitDBF('Test.DBF',TestDBF,0,FALSE,TRUE,FALSE,DefaultFixUp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 43 (* It would be a good to test error.*) 44 Error:=BuildDBF(Desc^, 2,TestDBF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 45 CloseDBF(TestDBF); ***** ^ not supported yet ***** ^ undeclared identifier 46 DEALLOCATE(Desc, 2 * SIZE(DBFieldDescriptor)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 47 END MakeDatabase; ***** ^ not supported yet 48 49 PROCEDURE MoveTestToDBF(Rec : TestRec ); ***** ^ undeclared identifier 50 (* This code will move the data from the record to *) 51 (* the data base *) 52 BEGIN 53 WITH Rec DO ***** ^ not supported yet 54 Replace( TestDBF, 1,TEST); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 55 Replace( TestDBF, 2,TEMP); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 56 END; (* end of with REC *) ***** ^ not supported yet 57 END MoveTestToDBF; ***** ^ not supported yet 58 59 60 61 PROCEDURE MoveTestFromDBF(VAR Rec : TestRec ); ***** ^ undeclared identifier 62 (* This code will move the data from the Database to *) 63 (* the record *) 64 VAR B : BOOLEAN; 65 R : Real8; 66 BEGIN 67 WITH Rec DO ***** ^ not supported yet 68 GetField( TestDBF, 1,TEST); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 69 GetField( TestDBF, 2,TEMP); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 70 END; (* end of with REC^ *) ***** ^ not supported yet 71 END MoveTestFromDBF; ***** ^ not supported yet 72 73 74 75 PROCEDURE OpenTestDBF(WithIdx : BOOLEAN); 76 VAR ER : CARDINAL; 77 BEGIN 78 79 IndexOpen := WithIdx; 80 (* Open the DBF file *) 81 IF NOT FileExists("Test.DBF") ***** ^ not supported yet ***** ^ not supported yet 82 THEN MakeDatabase(); ***** ^ not supported yet ***** ^ not supported yet 83 END; 84 InitDBF("Test.DBF", TestDBF,Buffer,Safty,Exclusive, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 85 AutoLock,DefaultFixUp ); ***** ^ not supported yet ***** ^ not supported yet 86 IF NOT OpenDBF( TestDBF) ***** ^ not supported yet ***** ^ undeclared identifier 87 THEN END; 88 89 90 (* open all indexes and append to dbfile *) 91 IF WithIdx THEN 92 93 InitIndex( "Test.NDX",TestIdx,TestDBF,Buffer, Safty, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 94 KeepDeleted,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 95 IF NOT OpenIndex( TestIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 96 THEN 97 ER := BuildIndex(TestIdx,'Test'); (* check key lenght *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 98 END; 99 AddToUpdateList( TestDBF, TestIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 100 101 102 ActTestIdx := TestIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 103 GoTop(ActTestIdx); ***** ^ not supported yet ***** ^ undeclared identifier 104 END; (* end with indext *) 105 END OpenTestDBF; ***** ^ not supported yet 106 107 108 109 PROCEDURE CloseTestDBF (); (* close Data and index files *) 110 111 BEGIN 112 CloseDBF(TestDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 113 IF IndexOpen 114 THEN 115 116 CloseIndex(TestIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 117 END; (* end index open*) 118 END CloseTestDBF; ***** ^ not supported yet 119 120 121 122 PROCEDURE FindTestByTest( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 123 VAR Found : BOOLEAN; 124 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 125 BEGIN 126 ActTestIdx := TestIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 127 FindPositionCh( TestIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 128 CurrentKeyCh(TestIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 129 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 IF Found 131 THEN ReadDBRec( TestDBF, CurrentRec( TestIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 132 END; 133 RETURN Found; 134 END FindTestByTest; ***** ^ not supported yet 135 136 137 138 139 140 141 142 PROCEDURE NextTest () : BOOLEAN; 143 VAR 144 L : LONGINT; (* record number *) 145 BEGIN 146 IF NextRecord( ActTestIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 147 THEN ReadDBRec( TestDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 148 RETURN TRUE; 149 ELSE RETURN FALSE; 150 END; 151 END NextTest; ***** ^ not supported yet 152 153 PROCEDURE PrevTest () : BOOLEAN; 154 VAR 155 L : LONGINT; (* record number *) 156 BEGIN 157 IF PrevRecord( ActTestIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 158 THEN ReadDBRec( TestDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 159 RETURN TRUE; 160 ELSE RETURN FALSE; 161 END; 162 END PrevTest; ***** ^ not supported yet 163 164 PROCEDURE FirstTest (); 165 VAR 166 L : LONGINT; (* record number *) 167 BEGIN 168 GoTop(ActTestIdx); ***** ^ not supported yet ***** ^ undeclared identifier 169 ReadDBRec( TestDBF,CurrentRec( ActTestIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 170 END FirstTest; ***** ^ not supported yet 171 172 PROCEDURE LastTest (); 173 VAR 174 L : LONGINT; (* record number *) 175 BEGIN 176 GoBottom(ActTestIdx); ***** ^ not supported yet ***** ^ undeclared identifier 177 ReadDBRec( TestDBF,CurrentRec( ActTestIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 178 END LastTest; ***** ^ not supported yet 179 PROCEDURE PackTest(); 180 VAR 181 EM : CARDINAL; 182 LI : LONGINT; 183 Tmp : TestRec; ***** ^ undeclared identifier 184 BEGIN 185 CloseTestDBF(); ***** ^ not supported yet ***** ^ not supported yet 186 OpenTestDBF(FALSE); (* open with no index *) ***** ^ not supported yet ***** ^ not supported yet 187 DBPack(TestDBF); ***** ^ not supported yet ***** ^ undeclared identifier 188 CloseTestDBF(); ***** ^ not supported yet ***** ^ not supported yet 189 190 EM := DeleteFile('Test'); ***** ^ not supported yet ***** ^ not supported yet 191 OpenTestDBF(TRUE); (* open to rebuild the indexes*) ***** ^ not supported yet ***** ^ not supported yet 192 CloseTestDBF(); ***** ^ not supported yet ***** ^ not supported yet 193 END PackTest; ***** ^ not supported yet 194 195 (* initialization code *) 196 BEGIN 197 NilDBF(TestDBF); ***** ^ not supported yet ***** ^ undeclared identifier 198 IndexOpen := FALSE; 199 200 END DBFTest. ***** ^ not supported yet 201 163 errors