Listing: 1 IMPLEMENTATION MODULE DBFInvtry; 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, 13 DBFile,DefaultFixUp,NilDBF; 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 Drectory IMPORT DeleteFile; 20 FROM M2Strings IMPORT Assign; 21 FROM StrEdit IMPORT CrunchBlanks,CAPstr,AssignStr; 22 FROM DBStuff IMPORT MakeKey; 23 FROM StrConv IMPORT StrToReal; 24 FROM NumTypes IMPORT Real8,REALToReal8; 25 FROM LowLevel IMPORT Fill; 26 FROM SYSTEM IMPORT ADR; 27 FROM ScanUtils IMPORT Present,CaseSens; 28 FROM PosUtils IMPORT Equal; 29 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, 30 ReplaceD,ReplaceN,ReplaceL; 31 32 CONST 33 Buffer = 0; 34 Safty = TRUE; 35 Exclusive = FALSE; 36 AutoLock = TRUE; 37 38 VAR 39 DBInit,IndexOpen : BOOLEAN; 40 41 42 PROCEDURE MoveInvtryToDBF(Rec : InvtryRec ); ***** ^ undeclared identifier 43 (* This code will move the data from the record to *) 44 (* the data base *) 45 BEGIN 46 WITH Rec DO ***** ^ not supported yet 47 CAPstr(INVCODE); (* only caps for item code*) ***** ^ not supported yet ***** ^ undeclared identifier 48 Replace( InvtryDBF, 1,INVCODE); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 49 ReplaceN( InvtryDBF, 2,REALToReal8(FLOAT(PRICETBL))); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 50 Replace( InvtryDBF, 3,GROUP); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 51 CAPstr(GROUP); ***** ^ not supported yet ***** ^ undeclared identifier 52 CrunchBlanks(GROUP); ***** ^ not supported yet ***** ^ undeclared identifier 53 Replace( InvtryDBF, 4,DESC); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 54 ReplaceN( InvtryDBF, 5,REALToReal8(FLOAT(REORDER))); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 55 ReplaceN( InvtryDBF, 6,ONHAND); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 56 ReplaceN( InvtryDBF, 7,REALToReal8(FLOAT(MINORDER))); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 57 ReplaceN( InvtryDBF, 8,PURPRICE); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 58 ReplaceL( InvtryDBF, 9,STOCKED); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 59 Replace( InvtryDBF, 10,UNITS); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 60 ReplaceD( InvtryDBF, 11,LASTPUR); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 61 ReplaceN( InvtryDBF, 12,LSTPUAMT); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 62 CAPstr(ORDERFRM); ***** ^ not supported yet ***** ^ undeclared identifier 63 Replace( InvtryDBF, 13,ORDERFRM); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 64 ReplaceN( InvtryDBF, 14,UNITPRICE ); (* Unit price if not price table *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 65 Replace(InvtryDBF,15,ONORDER); (* 'Y' - item is onorder *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 66 ReplaceN(InvtryDBF,16,REORDAMT); (* normal reorder quant *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 67 68 END; (* end of with REC *) ***** ^ not supported yet 69 END MoveInvtryToDBF; ***** ^ not supported yet 70 71 72 73 PROCEDURE MoveInvtryFromDBF(VAR Rec : InvtryRec ); ***** ^ undeclared identifier 74 (* This code will move the data from the Database to *) 75 (* the record *) 76 VAR B : BOOLEAN; 77 R : Real8; 78 BEGIN 79 WITH Rec DO ***** ^ not supported yet 80 GetField( InvtryDBF, 1,INVCODE ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 81 GetNumField( InvtryDBF, 2,R); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 82 PRICETBL:= TRUNC(R); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 83 GetField( InvtryDBF, 3,GROUP ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 84 GetField( InvtryDBF, 4,DESC ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 85 GetNumField( InvtryDBF, 5,R); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 86 REORDER:= TRUNC(R); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 87 GetNumField( InvtryDBF, 6,ONHAND); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 88 GetNumField( InvtryDBF, 7,R); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 89 MINORDER:= TRUNC(R); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 90 GetNumField( InvtryDBF, 8,PURPRICE); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 91 GetLogicalField( InvtryDBF, 9,STOCKED); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 92 GetField( InvtryDBF, 10,UNITS ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 93 GetDateField( InvtryDBF, 11,LASTPUR); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 94 GetNumField( InvtryDBF, 12,LSTPUAMT); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 95 GetField( InvtryDBF, 13,ORDERFRM ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 96 GetNumField( InvtryDBF, 14,UNITPRICE ); (* Unit price if not price table *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 97 GetField(InvtryDBF,15,ONORDER ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 98 GetNumField(InvtryDBF,16,REORDAMT); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 99 END; (* end of with REC^ *) ***** ^ not supported yet 100 END MoveInvtryFromDBF; ***** ^ not supported yet 101 102 PROCEDURE FixInvRec(); 103 VAR Rec : InvtryRec; ***** ^ undeclared identifier 104 BEGIN 105 MoveInvtryFromDBF(Rec); ***** ^ not supported yet ***** ^ not supported yet 106 MoveInvtryToDBF(Rec); ***** ^ not supported yet ***** ^ not supported yet 107 END FixInvRec; ***** ^ not supported yet 108 109 PROCEDURE MakeItemKey( DBF : DBFile; Idx : DBIndex; 110 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 111 112 VAR B : BOOLEAN; 113 BEGIN 114 GetField( DBF, 1,Key ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 116 117 END MakeItemKey; ***** ^ not supported yet 118 119 120 121 PROCEDURE OpenInvtryDBF(WithIdx : BOOLEAN); 122 VAR 123 ER : CARDINAL; 124 BEGIN 125 IndexOpen := WithIdx; 126 127 (* Open the DBF file *) 128 IF NOT DBInit THEN 129 DBInit:=TRUE; 130 InitDBF("Invtry.DBF", InvtryDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 131 InitCompIndex( "Invcode.Idx",InvcodeIdx,InvtryDBF,MakeItemKey,Buffer, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 132 Safty,FALSE,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 133 AddToUpdateList( InvtryDBF, InvcodeIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 134 135 END; 136 IF NOT OpenDBF( InvtryDBF) ***** ^ not supported yet ***** ^ undeclared identifier 137 THEN END; 138 IF WithIdx THEN 139 140 (* open all indexes and append to dbfile *) 141 IF NOT OpenIndex( InvcodeIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 142 THEN 143 ER := BuildCompIndex(InvcodeIdx, 'C','Invcode',6); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 144 END; 145 ActInvtryIdx := InvcodeIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 146 147 END; (* with index *) 148 END OpenInvtryDBF; ***** ^ not supported yet 149 150 151 152 PROCEDURE CloseInvtryDBF (); (* close Data and index files *) 153 154 BEGIN 155 CloseDBF(InvtryDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 156 IF IndexOpen 157 THEN 158 CloseIndex(InvcodeIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 159 END; 160 END CloseInvtryDBF; ***** ^ not supported yet 161 162 163 164 PROCEDURE FindInvtryByInvcode( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 165 VAR Found : BOOLEAN; 166 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 167 L : LONGINT; 168 BEGIN 169 Fill(ADR(CKey),80,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 170 Assign(Key,CKey); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 171 CrunchBlanks(CKey); ***** ^ not supported yet ***** ^ not supported yet 172 ActInvtryIdx := InvcodeIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 173 FindPositionCh( InvcodeIdx, CKey, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 174 ReadDBRec( InvtryDBF, CurrentRec( InvcodeIdx)); (* if found - then exact*) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 175 (* else the closest one*) 176 RETURN Found; 177 END FindInvtryByInvcode; ***** ^ not supported yet 178 179 180 181 182 183 184 185 PROCEDURE FindInvtryByOrderfrm( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 186 VAR Found : BOOLEAN; 187 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 188 BEGIN 189 ActInvtryIdx := OrderfrmIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 190 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 191 FindPositionCh( OrderfrmIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 192 CurrentKeyCh(OrderfrmIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 193 Found := Equal(Key,CKey); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 IF Found 195 THEN ReadDBRec( InvtryDBF, CurrentRec( OrderfrmIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 196 END; 197 RETURN Found; 198 END FindInvtryByOrderfrm; ***** ^ not supported yet 199 200 201 202 203 204 205 206 PROCEDURE NextInvtry () : BOOLEAN; 207 VAR 208 L : LONGINT; (* record number *) 209 BEGIN 210 IF NextRecord( ActInvtryIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 211 THEN ReadDBRec( InvtryDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 212 RETURN TRUE; 213 ELSE RETURN FALSE; 214 END; 215 END NextInvtry; ***** ^ not supported yet 216 217 PROCEDURE PrevInvtry () : BOOLEAN; 218 VAR 219 L : LONGINT; (* record number *) 220 BEGIN 221 IF PrevRecord( ActInvtryIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 222 THEN ReadDBRec( InvtryDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 223 RETURN TRUE; 224 ELSE RETURN FALSE; 225 END; 226 END PrevInvtry; ***** ^ not supported yet 227 228 PROCEDURE FirstInvtry (); 229 VAR 230 L : LONGINT; (* record number *) 231 BEGIN 232 GoTop(ActInvtryIdx); ***** ^ not supported yet ***** ^ undeclared identifier 233 ReadDBRec( InvtryDBF,CurrentRec( ActInvtryIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 234 END FirstInvtry; ***** ^ not supported yet 235 236 PROCEDURE LastInvtry (); 237 VAR 238 L : LONGINT; (* record number *) 239 BEGIN 240 GoBottom(ActInvtryIdx); ***** ^ not supported yet ***** ^ undeclared identifier 241 ReadDBRec( InvtryDBF,CurrentRec( ActInvtryIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 242 END LastInvtry; ***** ^ not supported yet 243 244 PROCEDURE PackInvtry(); 245 VAR 246 EM : CARDINAL; 247 BEGIN 248 CloseInvtryDBF(); ***** ^ not supported yet ***** ^ not supported yet 249 OpenInvtryDBF(FALSE); ***** ^ not supported yet ***** ^ not supported yet 250 DBPack(InvtryDBF); ***** ^ not supported yet ***** ^ undeclared identifier 251 252 CloseDBF(InvtryDBF); ***** ^ not supported yet ***** ^ undeclared identifier 253 EM := DeleteFile("Invcode.Idx"); ***** ^ not supported yet ***** ^ not supported yet 254 EM := DeleteFile("Orderfrm.Idx"); ***** ^ not supported yet ***** ^ not supported yet 255 OpenInvtryDBF(TRUE); (* open & rebuild the index *) ***** ^ not supported yet ***** ^ not supported yet 256 CloseInvtryDBF(); ***** ^ not supported yet ***** ^ not supported yet 257 258 END PackInvtry; ***** ^ not supported yet 259 260 261 BEGIN 262 NilDBF(InvtryDBF); ***** ^ not supported yet ***** ^ undeclared identifier 263 IndexOpen := FALSE; 264 DBInit:=FALSE; 265 END DBFInvtry. ***** ^ not supported yet 266 errors