DBFGAS.LST 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491
  1. Listing:
  2. 1 IMPLEMENTATION MODULE DBFGas;
  3. 2 (*
  4. 3 * ModBase
  5. 4 * Release 3.0
  6. 5 * (c) Copyright 1986 - 1991 PMI
  7. 6 * P.O. Box 8402
  8. 7 * Green Bay Wi 53308
  9. 8 * All Rights Reserved
  10. 9 * by Ed Ross
  11. 10 *)
  12. 11
  13. 12 FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile,
  14. 13 DefaultFixUp,NilDBF;
  15. 14 FROM DBCopier IMPORT DBPack;
  16. 15 FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
  17. 16 CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
  18. 17 NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
  19. 18 CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
  20. 19 FROM Drectory IMPORT DeleteFile;
  21. 20 FROM StrEdit IMPORT CrunchBlanks,Append;
  22. 21 FROM StrConv IMPORT StrToReal;
  23. 22 FROM NumTypes IMPORT Real8,REALToReal8;
  24. 23 FROM DBStuff IMPORT MakeKey;
  25. 24 FROM ScanUtils IMPORT Present,CaseSens;
  26. 25 FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
  27. 26 ReplaceD,ReplaceN;
  28. 27
  29. 28
  30. 29
  31. 30 CONST
  32. 31 Buffer = 0;
  33. 32 Safty = TRUE;
  34. 33 Exclusive = FALSE;
  35. 34 AutoLock = TRUE;
  36. 35
  37. 36 VAR DBInit,IndexOpen : BOOLEAN;
  38. 37
  39. 38 PROCEDURE MoveGasToDBF(Rec : GasRec );
  40. ***** ^ undeclared identifier
  41. 39 (* This code will move the data from the record to *)
  42. 40 (* the data base *)
  43. 41 BEGIN
  44. 42 WITH Rec DO
  45. ***** ^ not supported yet
  46. 43 Replace( GasDBF, 1,CIN); (* customer id number *)
  47. ***** ^ not supported yet
  48. ***** ^ undeclared identifier
  49. ***** ^ undeclared identifier
  50. 44 Replace( GasDBF, 2,INVNBR ); (* Out - Invoice number *)
  51. ***** ^ not supported yet
  52. ***** ^ undeclared identifier
  53. ***** ^ undeclared identifier
  54. 45 Replace( GasDBF, 3,ITEMNBR ); (* Helium type *)
  55. ***** ^ not supported yet
  56. ***** ^ undeclared identifier
  57. ***** ^ undeclared identifier
  58. 46 ReplaceD( GasDBF, 4,DATEOUT ); (* Helium out date *)
  59. ***** ^ not supported yet
  60. ***** ^ undeclared identifier
  61. ***** ^ undeclared identifier
  62. 47 ReplaceD( GasDBF, 5,DUEDATE ); (* Helium due date *)
  63. ***** ^ not supported yet
  64. ***** ^ undeclared identifier
  65. ***** ^ undeclared identifier
  66. 48 ReplaceD( GasDBF, 6,DATEIN ); (* Helium date in *)
  67. ***** ^ not supported yet
  68. ***** ^ undeclared identifier
  69. ***** ^ undeclared identifier
  70. 49 Replace( GasDBF, 7,STATUS ); (* Sequence number *)
  71. ***** ^ not supported yet
  72. ***** ^ undeclared identifier
  73. ***** ^ undeclared identifier
  74. 50 ReplaceN( GasDBF, 8,OVCHGAMT ); (* over time charge amount *)
  75. ***** ^ not supported yet
  76. ***** ^ undeclared identifier
  77. ***** ^ undeclared identifier
  78. 51 ReplaceN( GasDBF, 9,REALToReal8(FLOAT(DAYSLATE ))); (* Sequence number *)
  79. ***** ^ not supported yet
  80. ***** ^ undeclared identifier
  81. ***** ^ not supported yet
  82. ***** ^ undeclared identifier
  83. ***** ^ undeclared identifier
  84. 52 Replace( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *)
  85. ***** ^ not supported yet
  86. ***** ^ undeclared identifier
  87. ***** ^ undeclared identifier
  88. 53 END; (* end of with REC *)
  89. ***** ^ not supported yet
  90. 54 END MoveGasToDBF;
  91. ***** ^ not supported yet
  92. 55
  93. 56
  94. 57
  95. 58 PROCEDURE MoveGasFromDBF(VAR Rec : GasRec );
  96. ***** ^ undeclared identifier
  97. 59 (* This code will move the data from the Database to *)
  98. 60 (* the record *)
  99. 61 VAR B : BOOLEAN;
  100. 62 R : Real8;
  101. 63 BEGIN
  102. 64 WITH Rec DO
  103. ***** ^ not supported yet
  104. 65 GetField( GasDBF, 1,CIN ); (* customer id number *)
  105. ***** ^ not supported yet
  106. ***** ^ undeclared identifier
  107. ***** ^ undeclared identifier
  108. 66 GetField( GasDBF, 2,INVNBR ); (* Out - Invoice number *)
  109. ***** ^ not supported yet
  110. ***** ^ undeclared identifier
  111. ***** ^ undeclared identifier
  112. 67 GetField( GasDBF, 3,ITEMNBR ); (* Helium type *)
  113. ***** ^ not supported yet
  114. ***** ^ undeclared identifier
  115. ***** ^ undeclared identifier
  116. 68 GetDateField( GasDBF, 4,DATEOUT ); (* Helium out date *)
  117. ***** ^ not supported yet
  118. ***** ^ undeclared identifier
  119. ***** ^ undeclared identifier
  120. 69 GetDateField( GasDBF, 5,DUEDATE ); (* Helium due date *)
  121. ***** ^ not supported yet
  122. ***** ^ undeclared identifier
  123. ***** ^ undeclared identifier
  124. 70 GetDateField( GasDBF, 6,DATEIN ); (* Helium date in *)
  125. ***** ^ not supported yet
  126. ***** ^ undeclared identifier
  127. ***** ^ undeclared identifier
  128. 71 GetField( GasDBF, 7,STATUS ); (* Sequence number *)
  129. ***** ^ not supported yet
  130. ***** ^ undeclared identifier
  131. ***** ^ undeclared identifier
  132. 72 GetNumField( GasDBF, 8,OVCHGAMT ); (* over time charge amount *)
  133. ***** ^ not supported yet
  134. ***** ^ undeclared identifier
  135. ***** ^ undeclared identifier
  136. 73 GetNumField( GasDBF, 9,R);
  137. ***** ^ not supported yet
  138. ***** ^ undeclared identifier
  139. ***** ^ not supported yet
  140. 74 DAYSLATE := TRUNC(R); (* Sequence number *)
  141. ***** ^ undeclared identifier
  142. ***** ^ undeclared identifier
  143. ***** ^ not supported yet
  144. 75 GetField( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *)
  145. ***** ^ not supported yet
  146. ***** ^ undeclared identifier
  147. ***** ^ undeclared identifier
  148. 76 END; (* end of with REC^ *)
  149. ***** ^ not supported yet
  150. 77 END MoveGasFromDBF;
  151. ***** ^ not supported yet
  152. 78
  153. 79 PROCEDURE MakeGasOutKey(DBF : DBFile; Idx : DBIndex;
  154. 80 VAR Key : ARRAY OF CHAR);
  155. ***** ^ not supported yet
  156. 81 VAR
  157. 82 BEGIN
  158. 83 GetField(GasDBF,2,Key);
  159. ***** ^ not supported yet
  160. ***** ^ undeclared identifier
  161. ***** ^ not supported yet
  162. 84 MakeKey(Key);
  163. ***** ^ not supported yet
  164. ***** ^ not supported yet
  165. 85 END MakeGasOutKey;
  166. ***** ^ not supported yet
  167. 86
  168. 87
  169. 88 PROCEDURE MakeGasInKey(DBF : DBFile; Idx : DBIndex;
  170. 89 VAR Key : ARRAY OF CHAR);
  171. ***** ^ not supported yet
  172. 90 VAR
  173. 91 BEGIN
  174. 92 GetField(GasDBF,10,Key);
  175. ***** ^ not supported yet
  176. ***** ^ undeclared identifier
  177. ***** ^ not supported yet
  178. 93 MakeKey(Key);
  179. ***** ^ not supported yet
  180. ***** ^ not supported yet
  181. 94 END MakeGasInKey;
  182. ***** ^ not supported yet
  183. 95
  184. 96
  185. 97 PROCEDURE MakeGasKey( DBF : DBFile; Idx : DBIndex;
  186. 98 VAR Key : ARRAY OF CHAR);
  187. ***** ^ not supported yet
  188. 99 VAR
  189. 100 B : BOOLEAN;
  190. 101 Str : ARRAY[0..15] OF CHAR;
  191. ***** ^ not supported yet
  192. ***** ^ not supported yet
  193. 102 BEGIN
  194. 103 GetField( GasDBF, 1,Key ); (* customer id number *)
  195. ***** ^ not supported yet
  196. ***** ^ undeclared identifier
  197. ***** ^ not supported yet
  198. 104 GetField( GasDBF, 7,Str ); (* Sequence number *)
  199. ***** ^ not supported yet
  200. ***** ^ undeclared identifier
  201. ***** ^ not supported yet
  202. 105 Append(Key,Str);
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. ***** ^ not supported yet
  206. 106 GetField( GasDBF, 3,Str ); (* Helium type *)
  207. ***** ^ not supported yet
  208. ***** ^ undeclared identifier
  209. ***** ^ not supported yet
  210. 107 Append(Key,Str);
  211. ***** ^ not supported yet
  212. ***** ^ not supported yet
  213. ***** ^ not supported yet
  214. 108 MakeKey(Key);
  215. ***** ^ not supported yet
  216. ***** ^ not supported yet
  217. 109 END MakeGasKey;
  218. ***** ^ not supported yet
  219. 110
  220. 111
  221. 112
  222. 113
  223. 114 PROCEDURE OpenGasDBF(WithIdx : BOOLEAN);
  224. 115 VAR
  225. 116 ER : CARDINAL;
  226. 117 BEGIN
  227. 118 IndexOpen := WithIdx;
  228. 119
  229. 120 (* Open the DBF file *)
  230. 121 IF NOT DBInit THEN
  231. 122 DBInit:=TRUE;
  232. 123 InitDBF("Gas.DBF", GasDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
  233. ***** ^ not supported yet
  234. ***** ^ not supported yet
  235. ***** ^ undeclared identifier
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. ***** ^ not supported yet
  239. ***** ^ not supported yet
  240. 124 InitCompIndex( "Gas.Idx",GasIdx,GasDBF,MakeGasKey,Buffer,
  241. ***** ^ not supported yet
  242. ***** ^ not supported yet
  243. ***** ^ undeclared identifier
  244. ***** ^ undeclared identifier
  245. ***** ^ not supported yet
  246. 125 Safty,FALSE,Exclusive);
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. 126 AddToUpdateList( GasDBF, GasIdx );
  250. ***** ^ not supported yet
  251. ***** ^ undeclared identifier
  252. ***** ^ undeclared identifier
  253. 127
  254. 128 InitCompIndex( "GasOut.Idx",GasOutIdx,GasDBF,MakeGasOutKey,Buffer,
  255. ***** ^ not supported yet
  256. ***** ^ not supported yet
  257. ***** ^ undeclared identifier
  258. ***** ^ undeclared identifier
  259. ***** ^ not supported yet
  260. 129 Safty,FALSE,Exclusive);
  261. ***** ^ not supported yet
  262. ***** ^ not supported yet
  263. 130 AddToUpdateList( GasDBF, GasOutIdx );
  264. ***** ^ not supported yet
  265. ***** ^ undeclared identifier
  266. ***** ^ undeclared identifier
  267. 131
  268. 132 InitCompIndex( "GasIn.Idx",GasInIdx,GasDBF,MakeGasInKey,Buffer,
  269. ***** ^ not supported yet
  270. ***** ^ not supported yet
  271. ***** ^ undeclared identifier
  272. ***** ^ undeclared identifier
  273. ***** ^ not supported yet
  274. 133 Safty,FALSE,Exclusive);
  275. ***** ^ not supported yet
  276. ***** ^ not supported yet
  277. 134 AddToUpdateList( GasDBF, GasInIdx );
  278. ***** ^ not supported yet
  279. ***** ^ undeclared identifier
  280. ***** ^ undeclared identifier
  281. 135 END;
  282. 136 IF NOT OpenDBF( GasDBF)
  283. ***** ^ not supported yet
  284. ***** ^ undeclared identifier
  285. 137 THEN END;
  286. 138
  287. 139 IF WithIdx
  288. 140 THEN
  289. 141
  290. 142 (* open all indexes and append to dbfile *)
  291. 143 IF NOT OpenIndex( GasIdx )
  292. ***** ^ not supported yet
  293. ***** ^ undeclared identifier
  294. 144 THEN
  295. 145 ER := BuildCompIndex(GasIdx,'C','Cin',20); (* check key lenght *)
  296. ***** ^ not supported yet
  297. ***** ^ undeclared identifier
  298. ***** ^ not supported yet
  299. ***** ^ not supported yet
  300. 146 END;
  301. 147 IF NOT OpenIndex( GasOutIdx )
  302. ***** ^ not supported yet
  303. ***** ^ undeclared identifier
  304. 148 THEN
  305. 149 ER := BuildCompIndex(GasOutIdx,'C','Cin',20); (* check key lenght *)
  306. ***** ^ not supported yet
  307. ***** ^ undeclared identifier
  308. ***** ^ not supported yet
  309. ***** ^ not supported yet
  310. 150 END;
  311. 151 IF NOT OpenIndex( GasInIdx )
  312. ***** ^ not supported yet
  313. ***** ^ undeclared identifier
  314. 152 THEN
  315. 153 ER := BuildCompIndex(GasInIdx,'C','Cin',20); (* check key lenght *)
  316. ***** ^ not supported yet
  317. ***** ^ undeclared identifier
  318. ***** ^ not supported yet
  319. ***** ^ not supported yet
  320. 154 END;
  321. 155 END;
  322. 156 END OpenGasDBF;
  323. ***** ^ not supported yet
  324. 157
  325. 158
  326. 159
  327. 160 PROCEDURE CloseGasDBF (); (* close Data and index files *)
  328. 161
  329. 162 BEGIN
  330. 163 CloseDBF(GasDBF); (* close dbf file *)
  331. ***** ^ not supported yet
  332. ***** ^ undeclared identifier
  333. 164 IF IndexOpen
  334. 165 THEN
  335. 166 CloseIndex(GasIdx ); (* close index file *)
  336. ***** ^ not supported yet
  337. ***** ^ undeclared identifier
  338. 167 END;
  339. 168 END CloseGasDBF;
  340. ***** ^ not supported yet
  341. 169
  342. 170
  343. 171
  344. 172 PROCEDURE FindGasByCin( Key : ARRAY OF CHAR) : BOOLEAN;
  345. ***** ^ not supported yet
  346. 173 VAR Found : BOOLEAN;
  347. 174 CKey : ARRAY[0..80] OF CHAR;
  348. ***** ^ not supported yet
  349. ***** ^ not supported yet
  350. 175 BEGIN
  351. 176 FindPositionCh( GasIdx, Key, Found);
  352. ***** ^ not supported yet
  353. ***** ^ undeclared identifier
  354. ***** ^ not supported yet
  355. ***** ^ not supported yet
  356. 177 CurrentKeyCh(GasIdx,CKey);
  357. ***** ^ not supported yet
  358. ***** ^ undeclared identifier
  359. ***** ^ not supported yet
  360. 178 Found := Present(Key,CKey,CaseSens);
  361. ***** ^ not supported yet
  362. ***** ^ not supported yet
  363. ***** ^ not supported yet
  364. ***** ^ not supported yet
  365. 179 IF Found
  366. 180 THEN ReadDBRec( GasDBF, CurrentRec( GasIdx));
  367. ***** ^ not supported yet
  368. ***** ^ undeclared identifier
  369. ***** ^ not supported yet
  370. ***** ^ undeclared identifier
  371. 181 END;
  372. 182 RETURN Found;
  373. 183 END FindGasByCin;
  374. ***** ^ not supported yet
  375. 184
  376. 185
  377. 186
  378. 187
  379. 188
  380. 189
  381. 190
  382. 191 PROCEDURE NextGas () : BOOLEAN;
  383. 192 VAR
  384. 193 L : LONGINT; (* record number *)
  385. 194 BEGIN
  386. 195 IF NextRecord( GasIdx,L)
  387. ***** ^ not supported yet
  388. ***** ^ undeclared identifier
  389. ***** ^ not supported yet
  390. 196 THEN ReadDBRec( GasDBF,L );
  391. ***** ^ not supported yet
  392. ***** ^ undeclared identifier
  393. ***** ^ not supported yet
  394. 197 RETURN TRUE;
  395. 198 ELSE RETURN FALSE;
  396. 199 END;
  397. 200 END NextGas;
  398. ***** ^ not supported yet
  399. 201
  400. 202 PROCEDURE PrevGas () : BOOLEAN;
  401. 203 VAR
  402. 204 L : LONGINT; (* record number *)
  403. 205 BEGIN
  404. 206 IF PrevRecord( GasIdx,L)
  405. ***** ^ not supported yet
  406. ***** ^ undeclared identifier
  407. ***** ^ not supported yet
  408. 207 THEN ReadDBRec( GasDBF,L );
  409. ***** ^ not supported yet
  410. ***** ^ undeclared identifier
  411. ***** ^ not supported yet
  412. 208 RETURN TRUE;
  413. 209 ELSE RETURN FALSE;
  414. 210 END;
  415. 211 END PrevGas;
  416. ***** ^ not supported yet
  417. 212
  418. 213 PROCEDURE FirstGas ();
  419. 214 VAR
  420. 215 L : LONGINT; (* record number *)
  421. 216 BEGIN
  422. 217 GoTop(GasIdx);
  423. ***** ^ not supported yet
  424. ***** ^ undeclared identifier
  425. 218 ReadDBRec( GasDBF,CurrentRec( GasIdx));
  426. ***** ^ not supported yet
  427. ***** ^ undeclared identifier
  428. ***** ^ not supported yet
  429. ***** ^ undeclared identifier
  430. 219 END FirstGas;
  431. ***** ^ not supported yet
  432. 220
  433. 221 PROCEDURE LastGas ();
  434. 222 VAR
  435. 223 L : LONGINT; (* record number *)
  436. 224 BEGIN
  437. 225 GoBottom(GasIdx);
  438. ***** ^ not supported yet
  439. ***** ^ undeclared identifier
  440. 226 ReadDBRec( GasDBF,CurrentRec( GasIdx));
  441. ***** ^ not supported yet
  442. ***** ^ undeclared identifier
  443. ***** ^ not supported yet
  444. ***** ^ undeclared identifier
  445. 227 END LastGas;
  446. ***** ^ not supported yet
  447. 228
  448. 229 PROCEDURE PackGas();
  449. 230 VAR
  450. 231 EM : CARDINAL;
  451. 232 BEGIN
  452. 233 CloseGasDBF();
  453. ***** ^ not supported yet
  454. ***** ^ not supported yet
  455. 234 OpenGasDBF(FALSE);
  456. ***** ^ not supported yet
  457. ***** ^ not supported yet
  458. 235 DBPack(GasDBF);
  459. ***** ^ not supported yet
  460. ***** ^ undeclared identifier
  461. 236
  462. 237 CloseDBF(GasDBF);
  463. ***** ^ not supported yet
  464. ***** ^ undeclared identifier
  465. 238 EM := DeleteFile('Gas.IDX');
  466. ***** ^ not supported yet
  467. ***** ^ not supported yet
  468. 239 OpenGasDBF(TRUE); (* open & rebuild the index *)
  469. ***** ^ not supported yet
  470. ***** ^ not supported yet
  471. 240 CloseGasDBF();
  472. ***** ^ not supported yet
  473. ***** ^ not supported yet
  474. 241
  475. 242 END PackGas;
  476. ***** ^ not supported yet
  477. 243
  478. 244 BEGIN
  479. 245 NilDBF(GasDBF);
  480. ***** ^ not supported yet
  481. ***** ^ undeclared identifier
  482. 246 IndexOpen := FALSE;
  483. 247 DBInit:=FALSE;
  484. 248
  485. 249 END DBFGas.
  486. ***** ^ not supported yet
  487. 236 errors