Listing: 1 IMPLEMENTATION MODULE DBFSalesrec; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 * P.O. Box 8402 7 * Green Bay Wi 53308 8 * All Rights Reserved 9 * by Ed Ross 10 *) 11 12 FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile, 13 DeleteRecord,DefaultFixUp,NilDBF,PosOfField; 14 FROM DBCopier IMPORT DBPack; 15 FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex, 16 CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom, 17 NextRecord,PrevRecord,CurrentKeyCh,FindPositionN, 18 CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex; 19 FROM StrEdit IMPORT CrunchBlanks; 20 FROM DBStuff IMPORT MakeKey; 21 FROM Drectory IMPORT DeleteFile; 22 FROM StrConv IMPORT StrToReal; 23 FROM NumTypes IMPORT Real8; 24 FROM ScanUtils IMPORT Present,CaseSens; 25 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, 26 ReplaceD,ReplaceN; 27 28 CONST 29 Buffer = 0; 30 Safty = TRUE; 31 Exclusive = FALSE; 32 AutoLock = TRUE; 33 KeepDeleted = FALSE; 34 VAR 35 DBInit,IndexOpen : BOOLEAN; 36 37 38 PROCEDURE MoveSalesrecToDBF(Rec : SalesRec ); ***** ^ undeclared identifier 39 (* This code will move the data from the record to *) 40 (* the data base *) 41 BEGIN 42 WITH Rec DO ***** ^ not supported yet 43 Replace( SalesrecDBF, 1,ITEMNBR); (* Item number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 44 ReplaceN( SalesrecDBF, 2,Sold[1] ); (* number of units sold in January *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 45 ReplaceN( SalesrecDBF, 3,Sold[2] ); (* Feb *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 46 ReplaceN( SalesrecDBF, 4,Sold[3] ); (* Mar *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 47 ReplaceN( SalesrecDBF, 5,Sold[4] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 48 ReplaceN( SalesrecDBF, 6,Sold[5] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 49 ReplaceN( SalesrecDBF, 7,Sold[6] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 50 ReplaceN( SalesrecDBF, 8,Sold[7] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 51 ReplaceN( SalesrecDBF, 9,Sold[8] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 52 ReplaceN( SalesrecDBF, 10,Sold[9] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 53 ReplaceN( SalesrecDBF, 11,Sold[10] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 54 ReplaceN( SalesrecDBF, 12,Sold[11] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 55 ReplaceN( SalesrecDBF, 13,Sold[12] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 56 END; (* end of with REC *) ***** ^ not supported yet 57 END MoveSalesrecToDBF; ***** ^ not supported yet 58 59 60 61 PROCEDURE MoveSalesrecFromDBF(VAR Rec : SalesRec ); ***** ^ 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( SalesrecDBF, 1,ITEMNBR); (* Item number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 69 GetNumField( SalesrecDBF, 2,Sold[1] ); (* number of units Sold in January *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 70 GetNumField( SalesrecDBF, 3,Sold[2] ); (* Feb *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 71 GetNumField( SalesrecDBF, 4,Sold[3] ); (* Mar *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 72 GetNumField( SalesrecDBF, 5,Sold[4] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 73 GetNumField( SalesrecDBF, 6,Sold[5] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 74 GetNumField( SalesrecDBF, 7,Sold[6] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 75 GetNumField( SalesrecDBF, 8,Sold[7] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 76 GetNumField( SalesrecDBF, 9,Sold[8] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 77 GetNumField( SalesrecDBF, 10,Sold[9] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 78 GetNumField( SalesrecDBF, 11,Sold[10] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 79 GetNumField( SalesrecDBF, 12,Sold[11] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 80 GetNumField( SalesrecDBF, 13,Sold[12] ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 81 END; (* end of with REC^ *) ***** ^ not supported yet 82 END MoveSalesrecFromDBF; ***** ^ not supported yet 83 84 85 86 87 88 PROCEDURE MakeItemnbrKey( DBF : DBFile; Idx : DBIndex; 89 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 90 VAR 91 B : BOOLEAN; 92 FldNum : CARDINAL; 93 BEGIN 94 (* this routine doesn't alwasy work - may need to replace with getfiled*) 95 (* FldNum := PosOfField(DBF,'Itemnbr');*) 96 GetField(DBF,1,Key); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 97 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 98 END MakeItemnbrKey; ***** ^ not supported yet 99 100 101 102 103 PROCEDURE OpenSalesrecDBF(WithIdx : BOOLEAN); 104 VAR ER : CARDINAL; 105 BEGIN 106 107 IndexOpen := WithIdx; 108 (* Open the DBF file *) 109 IF NOT DBInit THEN 110 DBInit:=TRUE; 111 InitDBF("Salesrec.DBF", SalesrecDBF,Buffer,Safty,Exclusive, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 112 AutoLock,DefaultFixUp ); ***** ^ not supported yet ***** ^ not supported yet 113 InitCompIndex( "Itemnbr.Idx",SalesRecIdx,SalesrecDBF,MakeItemnbrKey,Buffer, Safty, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 114 KeepDeleted,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 115 AddToUpdateList( SalesrecDBF, SalesRecIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 116 117 END; 118 119 IF NOT OpenDBF( SalesrecDBF) ***** ^ not supported yet ***** ^ undeclared identifier 120 THEN END; 121 122 (* open all indexes and append to dbfile *) 123 IF WithIdx THEN 124 125 IF NOT OpenIndex( SalesRecIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 126 THEN 127 ER := BuildCompIndex(SalesRecIdx,'C','Itemnbr',40); (* check key lenght *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 128 END; 129 130 131 ActSalesrecIdx := SalesRecIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 132 END; (* end with indext *) 133 END OpenSalesrecDBF; ***** ^ not supported yet 134 135 136 137 PROCEDURE CloseSalesrecDBF (); (* close Data and index files *) 138 139 BEGIN 140 CloseDBF(SalesrecDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 141 IF IndexOpen 142 THEN 143 144 CloseIndex(SalesRecIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 145 END; (* end index open*) 146 END CloseSalesrecDBF; ***** ^ not supported yet 147 148 149 150 PROCEDURE FindSalesrecByItemnbr( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 151 VAR Found : BOOLEAN; 152 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 153 BEGIN 154 ActSalesrecIdx := SalesRecIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 155 FindPositionCh( SalesRecIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 156 CurrentKeyCh(SalesRecIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 157 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 IF Found 159 THEN ReadDBRec( SalesrecDBF, CurrentRec( SalesRecIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 160 END; 161 RETURN Found; 162 END FindSalesrecByItemnbr; ***** ^ not supported yet 163 164 165 166 167 168 169 170 PROCEDURE NextSalesrec () : BOOLEAN; 171 VAR 172 L : LONGINT; (* record number *) 173 BEGIN 174 IF NextRecord( ActSalesrecIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 175 THEN ReadDBRec( SalesrecDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 176 RETURN TRUE; 177 ELSE RETURN FALSE; 178 END; 179 END NextSalesrec; ***** ^ not supported yet 180 181 PROCEDURE PrevSalesrec () : BOOLEAN; 182 VAR 183 L : LONGINT; (* record number *) 184 BEGIN 185 IF PrevRecord( ActSalesrecIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 186 THEN ReadDBRec( SalesrecDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 187 RETURN TRUE; 188 ELSE RETURN FALSE; 189 END; 190 END PrevSalesrec; ***** ^ not supported yet 191 192 PROCEDURE FirstSalesrec (); 193 VAR 194 L : LONGINT; (* record number *) 195 BEGIN 196 GoTop(ActSalesrecIdx); ***** ^ not supported yet ***** ^ undeclared identifier 197 ReadDBRec( SalesrecDBF,CurrentRec( ActSalesrecIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 198 END FirstSalesrec; ***** ^ not supported yet 199 200 PROCEDURE LastSalesrec (); 201 VAR 202 L : LONGINT; (* record number *) 203 BEGIN 204 GoBottom(ActSalesrecIdx); ***** ^ not supported yet ***** ^ undeclared identifier 205 ReadDBRec( SalesrecDBF,CurrentRec( ActSalesrecIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 206 END LastSalesrec; ***** ^ not supported yet 207 PROCEDURE PackSalesrec(); 208 VAR 209 EM : CARDINAL; 210 LI : LONGINT; 211 Tmp : SalesRec; ***** ^ undeclared identifier 212 BEGIN 213 CloseSalesrecDBF(); ***** ^ not supported yet ***** ^ not supported yet 214 OpenSalesrecDBF(FALSE); (* open with no index *) ***** ^ not supported yet ***** ^ not supported yet 215 DBPack(SalesrecDBF); ***** ^ not supported yet ***** ^ undeclared identifier 216 CloseSalesrecDBF(); ***** ^ not supported yet ***** ^ not supported yet 217 218 EM := DeleteFile('Itemnbr'); ***** ^ not supported yet ***** ^ not supported yet 219 OpenSalesrecDBF(TRUE); (* open to rebuild the indexes*) ***** ^ not supported yet ***** ^ not supported yet 220 CloseSalesrecDBF(); ***** ^ not supported yet ***** ^ not supported yet 221 END PackSalesrec; ***** ^ not supported yet 222 223 (* initialization code *) 224 BEGIN 225 NilDBF(SalesrecDBF); ***** ^ not supported yet ***** ^ undeclared identifier 226 IndexOpen := FALSE; 227 DBInit:=FALSE; 228 END DBFSalesrec. ***** ^ not supported yet 219 errors