Listing: 1 (* 2 * ModBase 3 * Release 3.0 4 * (c) Copyright 1986 - 1991 PMI 5 * P.O. Box 8402 6 * Green Bay Wi 53308 7 * All Rights Reserved 8 * by Ed Ross 9 *) 10 11 IMPLEMENTATION MODULE DBFPayments; 12 FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField, 13 DeleteRecord,DBFile,DefaultFixUp,NilDBF,Record; 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 PMIGlobals IMPORT Today,Config; 21 FROM Drectory IMPORT DeleteFile; 22 FROM StrConv IMPORT StrToReal; 23 FROM NumTypes IMPORT Real8; 24 FROM DBStuff IMPORT MakeKey; 25 FROM DateFunctions IMPORT DaysSince1900; 26 FROM ScanUtils IMPORT Present,CaseSens; 27 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, 28 ReplaceD,ReplaceN; 29 30 31 32 CONST 33 Buffer = 0; 34 Safty = TRUE; 35 Exclusive = FALSE; 36 AutoLock = TRUE; 37 38 VAR IndexOpen,DBInit : BOOLEAN; 39 40 PROCEDURE MovePaymentsToDBF(Rec : PaymentsRec ); ***** ^ undeclared identifier 41 (* This code will move the data from the record to *) 42 (* the data base *) 43 BEGIN 44 WITH Rec DO ***** ^ not supported yet 45 Replace( PaymentsDBF, 1,INVOICE); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 46 ReplaceD( PaymentsDBF, 2,PMTDATE ); (* Payment Date *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 47 ReplaceN( PaymentsDBF, 3,PMTAMT ); (* Payment amount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 48 Replace( PaymentsDBF, 4,CHECKNB ); (* Check number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 49 Replace( PaymentsDBF, 5,CUSTID); (* Customer who payed *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 50 END; (* end of with REC *) ***** ^ not supported yet 51 END MovePaymentsToDBF; ***** ^ not supported yet 52 53 54 55 PROCEDURE MovePaymentsFromDBF(VAR Rec : PaymentsRec ); ***** ^ undeclared identifier 56 (* This code will move the data from the Database to *) 57 (* the record *) 58 VAR B : BOOLEAN; 59 R : Real8; 60 BEGIN 61 WITH Rec DO ***** ^ not supported yet 62 GetField( PaymentsDBF, 1,INVOICE ); (* Invoice number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 63 GetDateField( PaymentsDBF, 2,PMTDATE ); (* Payment Date *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 64 GetNumField( PaymentsDBF, 3,PMTAMT ); (* Payment amount *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 65 GetField( PaymentsDBF, 4,CHECKNB ); (* Check number *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 66 GetField( PaymentsDBF, 5,CUSTID ); (* Customer who payed *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 67 END; (* end of with REC^ *) ***** ^ not supported yet 68 END MovePaymentsFromDBF; ***** ^ not supported yet 69 70 71 72 73 74 PROCEDURE MakeCustidKey( DBF : DBFile; Idx : DBIndex; 75 VAR Key : ARRAY OF CHAR); ***** ^ not supported yet 76 VAR 77 B : BOOLEAN; 78 BEGIN 79 GetField( PaymentsDBF, 5,Key ); (* Customer who payed *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 80 MakeKey(Key); ***** ^ not supported yet ***** ^ not supported yet 81 END MakeCustidKey; ***** ^ not supported yet 82 83 84 85 86 PROCEDURE OpenPaymentsDBF(WithIdx : BOOLEAN); 87 VAR ER : CARDINAL; 88 BEGIN 89 IndexOpen := WithIdx; 90 91 (* Open the DBF file *) 92 93 IF NOT DBInit THEN 94 DBInit:=TRUE; 95 InitDBF("Payments.DBF", PaymentsDBF,Buffer,Safty,Exclusive,AutoLock, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 DefaultFixUp ); ***** ^ not supported yet 97 InitCompIndex( "Pymts.Idx",CustidIdx,PaymentsDBF,MakeCustidKey,Buffer, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 98 Safty,FALSE,Exclusive); ***** ^ not supported yet ***** ^ not supported yet 99 AddToUpdateList( PaymentsDBF, CustidIdx ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 100 101 END; 102 IF NOT OpenDBF( PaymentsDBF) ***** ^ not supported yet ***** ^ undeclared identifier 103 THEN 104 HALT; ***** ^ undeclared identifier 105 END; 106 107 IF WithIdx THEN 108 109 (* open all indexes and append to dbfile *) 110 IF NOT OpenIndex( CustidIdx ) ***** ^ not supported yet ***** ^ undeclared identifier 111 THEN 112 ER := BuildCompIndex(CustidIdx,'C','Custid',12); (* check key lenght *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 113 END; 114 END; (* end with idx *) 115 116 END OpenPaymentsDBF; ***** ^ not supported yet 117 118 119 120 PROCEDURE ClosePaymentsDBF (); (* close Data and index files *) 121 122 BEGIN 123 CloseDBF(PaymentsDBF); (* close dbf file *) ***** ^ not supported yet ***** ^ undeclared identifier 124 IF IndexOpen 125 THEN 126 CloseIndex(CustidIdx ); (* close index file *) ***** ^ not supported yet ***** ^ undeclared identifier 127 END; 128 END ClosePaymentsDBF; ***** ^ not supported yet 129 130 131 132 133 134 135 PROCEDURE FindPaymentsByCustid( Key : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 136 VAR Found : BOOLEAN; 137 CKey : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 138 BEGIN 139 FindPositionCh( CustidIdx, Key, Found); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 140 CurrentKeyCh(CustidIdx,CKey); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 141 Found := Present(Key,CKey,CaseSens); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 142 IF Found 143 THEN ReadDBRec( PaymentsDBF, CurrentRec( CustidIdx)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 144 END; 145 RETURN Found; 146 END FindPaymentsByCustid; ***** ^ not supported yet 147 148 149 PROCEDURE DeletePayments(); 150 (* go through the payments file and delete all payments greater than 151 the number of weeks to keep payments *) 152 VAR 153 LI : LONGINT; 154 DeleteDate, PaymentDate : CARDINAL; 155 Payment : PaymentsRec; ***** ^ undeclared identifier 156 BEGIN 157 DeleteDate := DaysSince1900(Today) + (Config.KeepPaymentHist * 7); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 (* payment hist is in weeks *) 159 FOR LI := 1 TO Record(PaymentsDBF) DO ***** ^ not supported yet ***** ^ undeclared identifier 160 ReadDBRec(PaymentsDBF,LI); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 161 MovePaymentsFromDBF(Payment); ***** ^ not supported yet ***** ^ not supported yet 162 IF ( DaysSince1900(Payment.PMTDATE) > DeleteDate) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 THEN DeleteRecord(PaymentsDBF); ***** ^ not supported yet ***** ^ undeclared identifier 164 END; 165 END; 166 END DeletePayments; ***** ^ not supported yet 167 168 PROCEDURE PackPayments(); 169 VAR 170 EM : CARDINAL; 171 BEGIN 172 ClosePaymentsDBF(); ***** ^ not supported yet ***** ^ not supported yet 173 OpenPaymentsDBF(FALSE); ***** ^ not supported yet ***** ^ not supported yet 174 DeletePayments(); ***** ^ not supported yet ***** ^ not supported yet 175 DBPack(PaymentsDBF); ***** ^ not supported yet ***** ^ undeclared identifier 176 177 CloseDBF(PaymentsDBF); ***** ^ not supported yet ***** ^ undeclared identifier 178 EM := DeleteFile("Pymts.Idx"); ***** ^ not supported yet ***** ^ not supported yet 179 OpenPaymentsDBF(TRUE); (* open & rebuild the index *) ***** ^ not supported yet ***** ^ not supported yet 180 ClosePaymentsDBF(); ***** ^ not supported yet ***** ^ not supported yet 181 182 END PackPayments; ***** ^ not supported yet 183 184 BEGIN 185 NilDBF(PaymentsDBF); ***** ^ not supported yet ***** ^ undeclared identifier 186 IndexOpen := FALSE; 187 DBInit:=FALSE; 188 END DBFPayments. ***** ^ not supported yet 134 errors