Listing: 1 IMPLEMENTATION MODULE DBFInvoice; 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,DBIndex,InitCompIndex,BuildCompIndex; 19 FROM DBStuff IMPORT MakeKey; 20 FROM Drectory IMPORT DeleteFile; 21 FROM StrEdit IMPORT CrunchBlanks,CAPstr,Append; 22 FROM StrConv IMPORT StrToReal; 23 FROM NumTypes IMPORT Real8,REALToReal8; 24 FROM ScanUtils IMPORT Present,CaseSens; 25 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, 26 ReplaceD,ReplaceN; 27 28 29 CONST 30 Buffer = 0; 31 Safty = TRUE; 32 Exclusive = FALSE; 33 AutoLock = TRUE; 34 VAR 35 DBInit,IndexOpen : BOOLEAN; 36 37 PROCEDURE MoveInvoiceToDBF(Rec : InvoiceRec ); ***** ^ undeclared identifier 38 (* This code will move the data from the record to *) 39 (* the data base *) 40 BEGIN 41 WITH Rec DO ***** ^ not supported yet 42 Replace( InvoiceDBF, 1,INVOICE); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 43 ReplaceD( InvoiceDBF, 2,INVDATE ); (* Invoce date *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 44 Replace( InvoiceDBF, 3,CUSTID); (* FK - customer id number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 45 ReplaceN( InvoiceDBF, 4,INVNET ); (* Invoice net *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 46 ReplaceN( InvoiceDBF, 5,INVTAX ); (* Invoice Tax *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 47 ReplaceN( InvoiceDBF, 6,AMTOUT ); (* Amount outstanding *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 48 ReplaceN( InvoiceDBF, 7,TOTALAMT ); (* Invoice discount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 49 Replace( InvoiceDBF, 8,SPORDER ); (* special order boolean *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 50 Replace( InvoiceDBF, 9,HELIUM ); (* Helium associated with order *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 51 ReplaceN( InvoiceDBF, 10,INVDSCNT ); (* special discount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 52 Replace( InvoiceDBF, 11,CUSTPO ); (* customer's purchase order *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 53 Replace( InvoiceDBF, 12,INVPRNT ); (* Invoice printed Y/N *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 54 Replace( InvoiceDBF, 13,INVCLSD ); (* Invoice closed - no special out *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 55 ReplaceD( InvoiceDBF, 14,SHIPDATE ); (* Date Shipped *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 56 Replace( InvoiceDBF, 15,SALESMAN ); (* Whodoneit *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 57 Replace( InvoiceDBF, 16,TERMS ); (* terms of invoice *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 58 Replace( InvoiceDBF, 17,SHIPVIA ); (* method of shippment *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 59 ReplaceN( InvoiceDBF, 18,SHIPPING ); (* shipping charge *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 60 ReplaceN( InvoiceDBF, 19,REALToReal8(FLOAT(DFLTLVL))); (* default price level *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 61 CAPstr(TAXABLE); ***** ^ not supported yet ***** ^ undeclared identifier 62 Replace(InvoiceDBF,20,TAXABLE); (* if taxable *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 63 CAPstr(FREEFRGHT); ***** ^ not supported yet ***** ^ undeclared identifier 64 Replace(InvoiceDBF,21,FREEFRGHT); (* free freight *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 65 Replace( InvoiceDBF, 22,NOTESFOR ); (* Notes for Inv, Pkg or both *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 66 Replace( InvoiceDBF, 23,NOTE1 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 67 Replace( InvoiceDBF, 24,NOTE2 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 68 Replace( InvoiceDBF, 25,NOTE3 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 69 END; (* end of with REC *) ***** ^ not supported yet 70 END MoveInvoiceToDBF; ***** ^ not supported yet 71 72 73 74 PROCEDURE MoveInvoiceFromDBF(VAR Rec : InvoiceRec ); ***** ^ undeclared identifier 75 (* This code will move the data from the Database to *) 76 (* the record *) 77 VAR B : BOOLEAN; 78 R : Real8; 79 BEGIN 80 WITH Rec DO ***** ^ not supported yet 81 GetField( InvoiceDBF, 1,INVOICE); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 82 GetDateField( InvoiceDBF, 2,INVDATE ); (* Invoce date *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 83 GetField( InvoiceDBF, 3,CUSTID); (* FK - customer id number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 84 GetNumField( InvoiceDBF, 4,INVNET ); (* Invoice net *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 85 GetNumField( InvoiceDBF, 5,INVTAX ); (* Invoice Tax *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 86 GetNumField( InvoiceDBF, 6,AMTOUT ); (* Amount outstanding *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 87 GetNumField( InvoiceDBF, 7,TOTALAMT ); (* Invoice discount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 88 GetField( InvoiceDBF, 8,SPORDER); (* special order boolean *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 89 GetField( InvoiceDBF, 9,HELIUM ); (* Helium associated with order *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 90 GetNumField( InvoiceDBF, 10,INVDSCNT); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 91 GetField( InvoiceDBF, 11,CUSTPO ); (* customer's purchase order *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 92 GetField( InvoiceDBF, 12,INVPRNT); (* Invoice printed Y/N *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 93 GetField( InvoiceDBF, 13,INVCLSD); (* Invoice closed - no special out *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 94 GetDateField( InvoiceDBF, 14,SHIPDATE ); (* Date Shipped *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 95 GetField( InvoiceDBF, 15,SALESMAN ); (* Whodoneit *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 96 GetField( InvoiceDBF, 16,TERMS ); (* terms of invoice *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 97 GetField( InvoiceDBF, 17,SHIPVIA ); (* method of shippment *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 98 GetNumField(InvoiceDBF,18,SHIPPING); (* shipping amount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 99 GetNumField(InvoiceDBF,19,R); (* default discount table level*) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 100 DFLTLVL := TRUNC(R); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 101 GetField( InvoiceDBF, 20,TAXABLE); (* if taxable invoice *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 102 GetField( InvoiceDBF,21,FREEFRGHT); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 103 GetField( InvoiceDBF, 22,NOTESFOR ); (* Notes for Inv, Pkg or both *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 104 GetField( InvoiceDBF, 23,NOTE1 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 105 GetField( InvoiceDBF, 24,NOTE2 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 106 GetField( InvoiceDBF, 25,NOTE3 ); (* *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 107 END; (* end of with REC^ *) ***** ^ not supported yet 108 END MoveInvoiceFromDBF; ***** ^ not supported yet 109 110 PROCEDURE MakeCustKey(DBF : DBFile; Idx: DBIndex; 111 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 112 113 114 (* when indexed by customer id - append the status of on the key *) 115 116 VAR B : BOOLEAN; 117 Str : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 118 BEGIN 119 GetField(DBF,3,Key); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 120 GetField(DBF,12,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 Append(Key,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 123 END MakeCustKey; ***** ^ not supported yet 124 125 PROCEDURE MakeInvoiceKey(DBF : DBFile; Idx: DBIndex; 126 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 127 128 129 (* when indexed by customer id - append the status of on the key *) 130 131 VAR B : BOOLEAN; 132 Str : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 133 BEGIN 134 GetField(DBF,1,Key); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 135 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 136 END MakeInvoiceKey; ***** ^ not supported yet 137 138 139 140 141 PROCEDURE OpenInvoiceDBF(WithIdx : BOOLEAN); 142 VAR 143 B : CARDINAL; 144 BEGIN 145 IndexOpen := WithIdx; 146 147 (* Open the DBF file *) 148 IF NOT DBInit THEN 149 DBInit:=TRUE; 150 InitDBF("Invoice.DBF", InvoiceDBF,Buffer,Safty,Exclusive,AutoLock, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 DefaultFixUp ); ***** ^ not supported yet 152 InitCompIndex( "Invoice.Idx",InvoiceIdx,InvoiceDBF,MakeInvoiceKey, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 153 Buffer, Safty,FALSE,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 154 AddToUpdateList( InvoiceDBF, InvoiceIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 155 InitCompIndex( "Custid.Idx",CustidIdx,InvoiceDBF,MakeCustKey, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 156 Buffer, Safty,FALSE,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 157 AddToUpdateList( InvoiceDBF, CustidIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 158 159 END; 160 IF NOT OpenDBF( InvoiceDBF) ***** ^ not supported yet ***** ^ undeclared identifier 161 THEN END; 162 163 IF WithIdx 164 THEN 165 (* open all indexes and append to dbfile *) 166 IF NOT OpenIndex( InvoiceIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 167 THEN 168 B := BuildCompIndex(InvoiceIdx,'C', 'INVOICE',10); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 169 END; 170 ActInvoiceIdx := InvoiceIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 171 IF NOT OpenIndex( CustidIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 172 THEN 173 B := BuildCompIndex(CustidIdx, 'C','CUSTID',10); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 174 END; 175 ActInvoiceIdx := CustidIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 176 END; (* with index *) 177 END OpenInvoiceDBF; ***** ^ not supported yet 178 179 180 181 PROCEDURE CloseInvoiceDBF (); (* close Data and index files *) 182 183 BEGIN 184 CloseDBF(InvoiceDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 185 IF IndexOpen 186 THEN 187 CloseIndex(InvoiceIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 188 CloseIndex(CustidIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 189 END; 190 END CloseInvoiceDBF; ***** ^ not supported yet 191 192 193 194 PROCEDURE FindInvoiceByInvoice( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 195 VAR Found : BOOLEAN; 196 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 197 BEGIN 198 ActInvoiceIdx := InvoiceIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 199 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 200 FindPositionCh( InvoiceIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 201 CurrentKeyCh(InvoiceIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 202 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 IF Found 204 THEN ReadDBRec( InvoiceDBF, CurrentRec( InvoiceIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 205 END; 206 RETURN Found; 207 END FindInvoiceByInvoice; ***** ^ not supported yet 208 209 210 211 212 213 214 215 PROCEDURE FindInvoiceByCustid( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 216 VAR Found : BOOLEAN; 217 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 218 BEGIN 219 ActInvoiceIdx := CustidIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 220 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 221 FindPositionCh( CustidIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 222 CurrentKeyCh(CustidIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 223 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 IF Found 225 THEN ReadDBRec( InvoiceDBF, CurrentRec( CustidIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 226 END; 227 RETURN Found; 228 END FindInvoiceByCustid; ***** ^ not supported yet 229 230 231 232 233 234 235 236 PROCEDURE NextInvoice () : BOOLEAN; 237 VAR 238 L : LONGINT; (* record number *) 239 BEGIN 240 IF NextRecord( ActInvoiceIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 241 THEN ReadDBRec( InvoiceDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 242 RETURN TRUE; 243 ELSE RETURN FALSE; 244 END; 245 END NextInvoice; ***** ^ not supported yet 246 247 PROCEDURE PrevInvoice () : BOOLEAN; 248 VAR 249 L : LONGINT; (* record number *) 250 BEGIN 251 IF PrevRecord( ActInvoiceIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 252 THEN ReadDBRec( InvoiceDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 253 RETURN TRUE; 254 ELSE RETURN FALSE; 255 END; 256 END PrevInvoice; ***** ^ not supported yet 257 258 PROCEDURE FirstInvoice (); 259 VAR 260 L : LONGINT; (* record number *) 261 BEGIN 262 GoTop(ActInvoiceIdx); ***** ^ not supported yet ***** ^ undeclared identifier 263 ReadDBRec( InvoiceDBF,CurrentRec( ActInvoiceIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 264 END FirstInvoice; ***** ^ not supported yet 265 266 PROCEDURE LastInvoice (); 267 VAR 268 L : LONGINT; (* record number *) 269 BEGIN 270 GoBottom(ActInvoiceIdx); ***** ^ not supported yet ***** ^ undeclared identifier 271 ReadDBRec( InvoiceDBF,CurrentRec( ActInvoiceIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 272 END LastInvoice; ***** ^ not supported yet 273 274 275 PROCEDURE PackInvoice(); 276 VAR 277 EM : CARDINAL; 278 BEGIN 279 CloseInvoiceDBF(); ***** ^ not supported yet ***** ^ not supported yet 280 281 282 InitDBF("Invoice.DBF", InvoiceDBF,Buffer,Safty,TRUE,AutoLock,DefaultFixUp ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 283 IF NOT OpenDBF( InvoiceDBF) ***** ^ not supported yet ***** ^ undeclared identifier 284 THEN END; 285 DBPack(InvoiceDBF); ***** ^ not supported yet ***** ^ undeclared identifier 286 CloseDBF(InvoiceDBF); ***** ^ not supported yet ***** ^ undeclared identifier 287 EM := DeleteFile('Invoice.IDX'); ***** ^ not supported yet ***** ^ not supported yet 288 EM := DeleteFile('CustId.Idx'); ***** ^ not supported yet ***** ^ not supported yet 289 OpenInvoiceDBF(TRUE); (* open & rebuild the index *) ***** ^ not supported yet ***** ^ not supported yet 290 CloseInvoiceDBF(); ***** ^ not supported yet ***** ^ not supported yet 291 292 END PackInvoice; ***** ^ not supported yet 293 294 BEGIN 295 NilDBF(InvoiceDBF); ***** ^ not supported yet ***** ^ undeclared identifier 296 IndexOpen := FALSE; 297 DBInit:=FALSE; 298 END DBFInvoice. ***** ^ not supported yet 344 errors