DBFGAS.MOD 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250
  1. IMPLEMENTATION MODULE DBFGas;
  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. FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile,
  12. DefaultFixUp,NilDBF;
  13. FROM DBCopier IMPORT DBPack;
  14. FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
  15. CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
  16. NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
  17. CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
  18. FROM Drectory IMPORT DeleteFile;
  19. FROM StrEdit IMPORT CrunchBlanks,Append;
  20. FROM StrConv IMPORT StrToReal;
  21. FROM NumTypes IMPORT Real8,REALToReal8;
  22. FROM DBStuff IMPORT MakeKey;
  23. FROM ScanUtils IMPORT Present,CaseSens;
  24. FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
  25. ReplaceD,ReplaceN;
  26. CONST
  27. Buffer = 0;
  28. Safty = TRUE;
  29. Exclusive = FALSE;
  30. AutoLock = TRUE;
  31. VAR DBInit,IndexOpen : BOOLEAN;
  32. PROCEDURE MoveGasToDBF(Rec : GasRec );
  33. (* This code will move the data from the record to *)
  34. (* the data base *)
  35. BEGIN
  36. WITH Rec DO
  37. Replace( GasDBF, 1,CIN); (* customer id number *)
  38. Replace( GasDBF, 2,INVNBR ); (* Out - Invoice number *)
  39. Replace( GasDBF, 3,ITEMNBR ); (* Helium type *)
  40. ReplaceD( GasDBF, 4,DATEOUT ); (* Helium out date *)
  41. ReplaceD( GasDBF, 5,DUEDATE ); (* Helium due date *)
  42. ReplaceD( GasDBF, 6,DATEIN ); (* Helium date in *)
  43. Replace( GasDBF, 7,STATUS ); (* Sequence number *)
  44. ReplaceN( GasDBF, 8,OVCHGAMT ); (* over time charge amount *)
  45. ReplaceN( GasDBF, 9,REALToReal8(FLOAT(DAYSLATE ))); (* Sequence number *)
  46. Replace( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *)
  47. END; (* end of with REC *)
  48. END MoveGasToDBF;
  49. PROCEDURE MoveGasFromDBF(VAR Rec : GasRec );
  50. (* This code will move the data from the Database to *)
  51. (* the record *)
  52. VAR B : BOOLEAN;
  53. R : Real8;
  54. BEGIN
  55. WITH Rec DO
  56. GetField( GasDBF, 1,CIN ); (* customer id number *)
  57. GetField( GasDBF, 2,INVNBR ); (* Out - Invoice number *)
  58. GetField( GasDBF, 3,ITEMNBR ); (* Helium type *)
  59. GetDateField( GasDBF, 4,DATEOUT ); (* Helium out date *)
  60. GetDateField( GasDBF, 5,DUEDATE ); (* Helium due date *)
  61. GetDateField( GasDBF, 6,DATEIN ); (* Helium date in *)
  62. GetField( GasDBF, 7,STATUS ); (* Sequence number *)
  63. GetNumField( GasDBF, 8,OVCHGAMT ); (* over time charge amount *)
  64. GetNumField( GasDBF, 9,R);
  65. DAYSLATE := TRUNC(R); (* Sequence number *)
  66. GetField( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *)
  67. END; (* end of with REC^ *)
  68. END MoveGasFromDBF;
  69. PROCEDURE MakeGasOutKey(DBF : DBFile; Idx : DBIndex;
  70. VAR Key : ARRAY OF CHAR);
  71. VAR
  72. BEGIN
  73. GetField(GasDBF,2,Key);
  74. MakeKey(Key);
  75. END MakeGasOutKey;
  76. PROCEDURE MakeGasInKey(DBF : DBFile; Idx : DBIndex;
  77. VAR Key : ARRAY OF CHAR);
  78. VAR
  79. BEGIN
  80. GetField(GasDBF,10,Key);
  81. MakeKey(Key);
  82. END MakeGasInKey;
  83. PROCEDURE MakeGasKey( DBF : DBFile; Idx : DBIndex;
  84. VAR Key : ARRAY OF CHAR);
  85. VAR
  86. B : BOOLEAN;
  87. Str : ARRAY[0..15] OF CHAR;
  88. BEGIN
  89. GetField( GasDBF, 1,Key ); (* customer id number *)
  90. GetField( GasDBF, 7,Str ); (* Sequence number *)
  91. Append(Key,Str);
  92. GetField( GasDBF, 3,Str ); (* Helium type *)
  93. Append(Key,Str);
  94. MakeKey(Key);
  95. END MakeGasKey;
  96. PROCEDURE OpenGasDBF(WithIdx : BOOLEAN);
  97. VAR
  98. ER : CARDINAL;
  99. BEGIN
  100. IndexOpen := WithIdx;
  101. (* Open the DBF file *)
  102. IF NOT DBInit THEN
  103. DBInit:=TRUE;
  104. InitDBF("Gas.DBF", GasDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp );
  105. InitCompIndex( "Gas.Idx",GasIdx,GasDBF,MakeGasKey,Buffer,
  106. Safty,FALSE,Exclusive);
  107. AddToUpdateList( GasDBF, GasIdx );
  108. InitCompIndex( "GasOut.Idx",GasOutIdx,GasDBF,MakeGasOutKey,Buffer,
  109. Safty,FALSE,Exclusive);
  110. AddToUpdateList( GasDBF, GasOutIdx );
  111. InitCompIndex( "GasIn.Idx",GasInIdx,GasDBF,MakeGasInKey,Buffer,
  112. Safty,FALSE,Exclusive);
  113. AddToUpdateList( GasDBF, GasInIdx );
  114. END;
  115. IF NOT OpenDBF( GasDBF)
  116. THEN END;
  117. IF WithIdx
  118. THEN
  119. (* open all indexes and append to dbfile *)
  120. IF NOT OpenIndex( GasIdx )
  121. THEN
  122. ER := BuildCompIndex(GasIdx,'C','Cin',20); (* check key lenght *)
  123. END;
  124. IF NOT OpenIndex( GasOutIdx )
  125. THEN
  126. ER := BuildCompIndex(GasOutIdx,'C','Cin',20); (* check key lenght *)
  127. END;
  128. IF NOT OpenIndex( GasInIdx )
  129. THEN
  130. ER := BuildCompIndex(GasInIdx,'C','Cin',20); (* check key lenght *)
  131. END;
  132. END;
  133. END OpenGasDBF;
  134. PROCEDURE CloseGasDBF (); (* close Data and index files *)
  135. BEGIN
  136. CloseDBF(GasDBF); (* close dbf file *)
  137. IF IndexOpen
  138. THEN
  139. CloseIndex(GasIdx ); (* close index file *)
  140. END;
  141. END CloseGasDBF;
  142. PROCEDURE FindGasByCin( Key : ARRAY OF CHAR) : BOOLEAN;
  143. VAR Found : BOOLEAN;
  144. CKey : ARRAY[0..80] OF CHAR;
  145. BEGIN
  146. FindPositionCh( GasIdx, Key, Found);
  147. CurrentKeyCh(GasIdx,CKey);
  148. Found := Present(Key,CKey,CaseSens);
  149. IF Found
  150. THEN ReadDBRec( GasDBF, CurrentRec( GasIdx));
  151. END;
  152. RETURN Found;
  153. END FindGasByCin;
  154. PROCEDURE NextGas () : BOOLEAN;
  155. VAR
  156. L : LONGINT; (* record number *)
  157. BEGIN
  158. IF NextRecord( GasIdx,L)
  159. THEN ReadDBRec( GasDBF,L );
  160. RETURN TRUE;
  161. ELSE RETURN FALSE;
  162. END;
  163. END NextGas;
  164. PROCEDURE PrevGas () : BOOLEAN;
  165. VAR
  166. L : LONGINT; (* record number *)
  167. BEGIN
  168. IF PrevRecord( GasIdx,L)
  169. THEN ReadDBRec( GasDBF,L );
  170. RETURN TRUE;
  171. ELSE RETURN FALSE;
  172. END;
  173. END PrevGas;
  174. PROCEDURE FirstGas ();
  175. VAR
  176. L : LONGINT; (* record number *)
  177. BEGIN
  178. GoTop(GasIdx);
  179. ReadDBRec( GasDBF,CurrentRec( GasIdx));
  180. END FirstGas;
  181. PROCEDURE LastGas ();
  182. VAR
  183. L : LONGINT; (* record number *)
  184. BEGIN
  185. GoBottom(GasIdx);
  186. ReadDBRec( GasDBF,CurrentRec( GasIdx));
  187. END LastGas;
  188. PROCEDURE PackGas();
  189. VAR
  190. EM : CARDINAL;
  191. BEGIN
  192. CloseGasDBF();
  193. OpenGasDBF(FALSE);
  194. DBPack(GasDBF);
  195. CloseDBF(GasDBF);
  196. EM := DeleteFile('Gas.IDX');
  197. OpenGasDBF(TRUE); (* open & rebuild the index *)
  198. CloseGasDBF();
  199. END PackGas;
  200. BEGIN
  201. NilDBF(GasDBF);
  202. IndexOpen := FALSE;
  203. DBInit:=FALSE;
  204. END DBFGas.
  205.