Listing: 1 IMPLEMENTATION MODULE DBFOrder; 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 Drectory IMPORT DeleteFile; 20 FROM StrEdit IMPORT CrunchBlanks,CAPstr; 21 FROM StrConv IMPORT StrToReal; 22 FROM NumTypes IMPORT Real8,REALToReal8; 23 FROM DBStuff IMPORT MakeKey; 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 35 VAR IndexOpen,DBInit : BOOLEAN; 36 37 PROCEDURE MoveOrderToDBF(Rec : OrderRec ); ***** ^ 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( OrderDBF, 1,INVNBR); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 43 Replace( OrderDBF, 2,ITEMNBR ); (* Item number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 44 Replace( OrderDBF, 3,DESC ); (* Description of item *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 45 Replace( OrderDBF, 4,NOTES1 ); (* Notes of items line 1 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 46 Replace( OrderDBF, 5,NOTES2 ); (* Notes for item line 2 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 47 Replace( OrderDBF, 6,NOTES3 ); (* Notes for item line 3 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 48 Replace( OrderDBF, 7,UNITS ); (* Units *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 49 ReplaceN( OrderDBF, 8,QNTSOLD ); (* Quantity sold *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 50 ReplaceN( OrderDBF, 9,QNTORDER ); (* Quant ordered (for pricing ) *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 51 ReplaceN( OrderDBF, 10,REALToReal8(FLOAT(DSCLEVEL ))); (* Discount level applied *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 52 ReplaceN( OrderDBF, 11,UNITPRC ); (* Item price *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 53 ReplaceN( OrderDBF, 12,TOTAL ); (* Total price for line item *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 54 Replace( OrderDBF, 13,MANPRICE ); (* over rider computed price *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 55 END; (* end of with REC *) ***** ^ not supported yet 56 END MoveOrderToDBF; ***** ^ not supported yet 57 58 59 60 PROCEDURE MoveOrderFromDBF(VAR Rec : OrderRec ); ***** ^ undeclared identifier 61 (* This code will move the data from the Database to *) 62 (* the record *) 63 VAR B : BOOLEAN; 64 R : Real8; 65 BEGIN 66 WITH Rec DO ***** ^ not supported yet 67 GetField( OrderDBF, 1,INVNBR ); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 68 GetField( OrderDBF, 2,ITEMNBR ); (* Item number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 69 GetField( OrderDBF, 3,DESC ); (* Description of item *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 70 GetField( OrderDBF, 4,NOTES1 ); (* Notes of items line 1 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 71 GetField( OrderDBF, 5,NOTES2 ); (* Notes for item line 2 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 72 GetField( OrderDBF, 6,NOTES3 ); (* Notes for item line 3 *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 73 GetField( OrderDBF, 7,UNITS ); (* Units *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 74 GetNumField( OrderDBF, 8,QNTSOLD ); (* Quantity sold *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 75 GetNumField( OrderDBF, 9,QNTORDER ); (* Quant ordered (for pricing ) *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 76 GetNumField( OrderDBF, 10,R); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 77 DSCLEVEL := TRUNC(R); (* Discount level applied *) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 78 GetNumField( OrderDBF, 11,UNITPRC ); (* Item price *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 79 GetNumField( OrderDBF, 12,TOTAL ); (* Total price for line item *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 80 GetField( OrderDBF, 13,MANPRICE ); (* over rider computed price *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 81 END; (* end of with REC^ *) ***** ^ not supported yet 82 END MoveOrderFromDBF; ***** ^ not supported yet 83 84 85 PROCEDURE MakeOrderKey(DBF : DBFile; Idx : DBIndex; 86 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 87 88 VAR B : BOOLEAN; 89 BEGIN 90 GetField( DBF, 1,Key ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 92 END MakeOrderKey; ***** ^ not supported yet 93 94 95 96 97 PROCEDURE OpenOrderDBF(WithIdx : BOOLEAN); 98 VAR ER : CARDINAL; 99 BEGIN 100 IndexOpen := WithIdx; 101 102 (* Open the DBF file *) 103 104 IF NOT DBInit THEN 105 DBInit:=TRUE; 106 InitDBF("Order.DBF", OrderDBF,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 107 InitCompIndex( "Invnbr.Idx",InvnbrIdx,OrderDBF,MakeOrderKey,Buffer, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 108 Safty,FALSE,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 109 AddToUpdateList( OrderDBF, InvnbrIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 110 111 END; 112 IF NOT OpenDBF( OrderDBF) ***** ^ not supported yet ***** ^ undeclared identifier 113 THEN END; 114 115 IF WithIdx 116 THEN 117 (* open all indexes and append to dbfile *) 118 IF NOT OpenIndex( InvnbrIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 119 THEN 120 ER := BuildCompIndex(InvnbrIdx,'C','Invnbr',12); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 121 END; 122 ActOrderIdx := InvnbrIdx; (* make current index *) ***** ^ undeclared identifier ***** ^ undeclared identifier 123 END; (* end with inx *) 124 END OpenOrderDBF; ***** ^ not supported yet 125 126 127 128 PROCEDURE CloseOrderDBF (); (* close Data and index files *) 129 130 BEGIN 131 CloseDBF(OrderDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 132 IF IndexOpen 133 THEN 134 CloseIndex(InvnbrIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 135 END; 136 END CloseOrderDBF; ***** ^ not supported yet 137 138 139 140 PROCEDURE FindOrderByInvnbr( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 141 VAR Found : BOOLEAN; 142 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 143 BEGIN 144 ActOrderIdx := InvnbrIdx ; (* make this index the active idx*) ***** ^ undeclared identifier ***** ^ undeclared identifier 145 FindPositionCh( InvnbrIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 146 CurrentKeyCh(InvnbrIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 147 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 IF Found 149 THEN ReadDBRec( OrderDBF, CurrentRec( InvnbrIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 150 END; 151 RETURN Found; 152 END FindOrderByInvnbr; ***** ^ not supported yet 153 154 155 156 157 158 159 160 PROCEDURE NextOrder () : BOOLEAN; 161 VAR 162 L : LONGINT; (* record number *) 163 BEGIN 164 IF NextRecord( ActOrderIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 165 THEN ReadDBRec( OrderDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 166 RETURN TRUE; 167 ELSE RETURN FALSE; 168 END; 169 END NextOrder; ***** ^ not supported yet 170 171 PROCEDURE PrevOrder () : BOOLEAN; 172 VAR 173 L : LONGINT; (* record number *) 174 BEGIN 175 IF PrevRecord( ActOrderIdx,L) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 176 THEN ReadDBRec( OrderDBF,L ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 177 RETURN TRUE; 178 ELSE RETURN FALSE; 179 END; 180 END PrevOrder; ***** ^ not supported yet 181 182 PROCEDURE FirstOrder (); 183 VAR 184 L : LONGINT; (* record number *) 185 BEGIN 186 GoTop(ActOrderIdx); ***** ^ not supported yet ***** ^ undeclared identifier 187 ReadDBRec( OrderDBF,CurrentRec( ActOrderIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 188 END FirstOrder; ***** ^ not supported yet 189 190 PROCEDURE LastOrder (); 191 VAR 192 L : LONGINT; (* record number *) 193 BEGIN 194 GoBottom(ActOrderIdx); ***** ^ not supported yet ***** ^ undeclared identifier 195 ReadDBRec( OrderDBF,CurrentRec( ActOrderIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 196 END LastOrder; ***** ^ not supported yet 197 198 199 200 PROCEDURE PackOrder(); 201 VAR 202 EM : CARDINAL; 203 BEGIN 204 CloseOrderDBF(); ***** ^ not supported yet ***** ^ not supported yet 205 OpenOrderDBF(FALSE); (* no index *) ***** ^ not supported yet ***** ^ not supported yet 206 DBPack(OrderDBF); ***** ^ not supported yet ***** ^ undeclared identifier 207 208 CloseDBF(OrderDBF); ***** ^ not supported yet ***** ^ undeclared identifier 209 EM := DeleteFile("Invnbr.Idx"); ***** ^ not supported yet ***** ^ not supported yet 210 OpenOrderDBF(TRUE); (* open & rebuild the index *) ***** ^ not supported yet ***** ^ not supported yet 211 CloseOrderDBF(); ***** ^ not supported yet ***** ^ not supported yet 212 213 END PackOrder; ***** ^ not supported yet 214 BEGIN 215 NilDBF(OrderDBF); ***** ^ not supported yet ***** ^ undeclared identifier 216 IndexOpen := FALSE; 217 DBInit:=FALSE; 218 END DBFOrder. ***** ^ not supported yet 198 errors