| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453 |
- 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
|