DBFSALES.MOD 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228
  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. FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile,
  12. DeleteRecord,DefaultFixUp,NilDBF,PosOfField;
  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 StrEdit IMPORT CrunchBlanks;
  19. FROM DBStuff IMPORT MakeKey;
  20. FROM Drectory IMPORT DeleteFile;
  21. FROM StrConv IMPORT StrToReal;
  22. FROM NumTypes IMPORT Real8;
  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. KeepDeleted = FALSE;
  32. VAR
  33. DBInit,IndexOpen : BOOLEAN;
  34. PROCEDURE MoveSalesrecToDBF(Rec : SalesRec );
  35. (* This code will move the data from the record to *)
  36. (* the data base *)
  37. BEGIN
  38. WITH Rec DO
  39. Replace( SalesrecDBF, 1,ITEMNBR); (* Item number *)
  40. ReplaceN( SalesrecDBF, 2,Sold[1] ); (* number of units sold in January *)
  41. ReplaceN( SalesrecDBF, 3,Sold[2] ); (* Feb *)
  42. ReplaceN( SalesrecDBF, 4,Sold[3] ); (* Mar *)
  43. ReplaceN( SalesrecDBF, 5,Sold[4] ); (* *)
  44. ReplaceN( SalesrecDBF, 6,Sold[5] ); (* *)
  45. ReplaceN( SalesrecDBF, 7,Sold[6] ); (* *)
  46. ReplaceN( SalesrecDBF, 8,Sold[7] ); (* *)
  47. ReplaceN( SalesrecDBF, 9,Sold[8] ); (* *)
  48. ReplaceN( SalesrecDBF, 10,Sold[9] ); (* *)
  49. ReplaceN( SalesrecDBF, 11,Sold[10] ); (* *)
  50. ReplaceN( SalesrecDBF, 12,Sold[11] ); (* *)
  51. ReplaceN( SalesrecDBF, 13,Sold[12] ); (* *)
  52. END; (* end of with REC *)
  53. END MoveSalesrecToDBF;
  54. PROCEDURE MoveSalesrecFromDBF(VAR Rec : SalesRec );
  55. (* This code will move the data from the Database to *)
  56. (* the record *)
  57. VAR B : BOOLEAN;
  58. R : Real8;
  59. BEGIN
  60. WITH Rec DO
  61. GetField( SalesrecDBF, 1,ITEMNBR); (* Item number *)
  62. GetNumField( SalesrecDBF, 2,Sold[1] ); (* number of units Sold in January *)
  63. GetNumField( SalesrecDBF, 3,Sold[2] ); (* Feb *)
  64. GetNumField( SalesrecDBF, 4,Sold[3] ); (* Mar *)
  65. GetNumField( SalesrecDBF, 5,Sold[4] ); (* *)
  66. GetNumField( SalesrecDBF, 6,Sold[5] ); (* *)
  67. GetNumField( SalesrecDBF, 7,Sold[6] ); (* *)
  68. GetNumField( SalesrecDBF, 8,Sold[7] ); (* *)
  69. GetNumField( SalesrecDBF, 9,Sold[8] ); (* *)
  70. GetNumField( SalesrecDBF, 10,Sold[9] ); (* *)
  71. GetNumField( SalesrecDBF, 11,Sold[10] ); (* *)
  72. GetNumField( SalesrecDBF, 12,Sold[11] ); (* *)
  73. GetNumField( SalesrecDBF, 13,Sold[12] ); (* *)
  74. END; (* end of with REC^ *)
  75. END MoveSalesrecFromDBF;
  76. PROCEDURE MakeItemnbrKey( DBF : DBFile; Idx : DBIndex;
  77. VAR Key : ARRAY OF CHAR);
  78. VAR
  79. B : BOOLEAN;
  80. FldNum : CARDINAL;
  81. BEGIN
  82. (* this routine doesn't alwasy work - may need to replace with getfiled*)
  83. (* FldNum := PosOfField(DBF,'Itemnbr');*)
  84. GetField(DBF,1,Key);
  85. MakeKey(Key);
  86. END MakeItemnbrKey;
  87. PROCEDURE OpenSalesrecDBF(WithIdx : BOOLEAN);
  88. VAR ER : CARDINAL;
  89. BEGIN
  90. IndexOpen := WithIdx;
  91. (* Open the DBF file *)
  92. IF NOT DBInit THEN
  93. DBInit:=TRUE;
  94. InitDBF("Salesrec.DBF", SalesrecDBF,Buffer,Safty,Exclusive,
  95. AutoLock,DefaultFixUp );
  96. InitCompIndex( "Itemnbr.Idx",SalesRecIdx,SalesrecDBF,MakeItemnbrKey,Buffer, Safty,
  97. KeepDeleted,Exclusive);
  98. AddToUpdateList( SalesrecDBF, SalesRecIdx );
  99. END;
  100. IF NOT OpenDBF( SalesrecDBF)
  101. THEN END;
  102. (* open all indexes and append to dbfile *)
  103. IF WithIdx THEN
  104. IF NOT OpenIndex( SalesRecIdx )
  105. THEN
  106. ER := BuildCompIndex(SalesRecIdx,'C','Itemnbr',40); (* check key lenght *)
  107. END;
  108. ActSalesrecIdx := SalesRecIdx; (* make current index *)
  109. END; (* end with indext *)
  110. END OpenSalesrecDBF;
  111. PROCEDURE CloseSalesrecDBF (); (* close Data and index files *)
  112. BEGIN
  113. CloseDBF(SalesrecDBF); (* close dbf file *)
  114. IF IndexOpen
  115. THEN
  116. CloseIndex(SalesRecIdx ); (* close index file *)
  117. END; (* end index open*)
  118. END CloseSalesrecDBF;
  119. PROCEDURE FindSalesrecByItemnbr( Key : ARRAY OF CHAR) : BOOLEAN;
  120. VAR Found : BOOLEAN;
  121. CKey : ARRAY[0..80] OF CHAR;
  122. BEGIN
  123. ActSalesrecIdx := SalesRecIdx ; (* make this index the active idx*)
  124. FindPositionCh( SalesRecIdx, Key, Found);
  125. CurrentKeyCh(SalesRecIdx,CKey);
  126. Found := Present(Key,CKey,CaseSens);
  127. IF Found
  128. THEN ReadDBRec( SalesrecDBF, CurrentRec( SalesRecIdx));
  129. END;
  130. RETURN Found;
  131. END FindSalesrecByItemnbr;
  132. PROCEDURE NextSalesrec () : BOOLEAN;
  133. VAR
  134. L : LONGINT; (* record number *)
  135. BEGIN
  136. IF NextRecord( ActSalesrecIdx,L)
  137. THEN ReadDBRec( SalesrecDBF,L );
  138. RETURN TRUE;
  139. ELSE RETURN FALSE;
  140. END;
  141. END NextSalesrec;
  142. PROCEDURE PrevSalesrec () : BOOLEAN;
  143. VAR
  144. L : LONGINT; (* record number *)
  145. BEGIN
  146. IF PrevRecord( ActSalesrecIdx,L)
  147. THEN ReadDBRec( SalesrecDBF,L );
  148. RETURN TRUE;
  149. ELSE RETURN FALSE;
  150. END;
  151. END PrevSalesrec;
  152. PROCEDURE FirstSalesrec ();
  153. VAR
  154. L : LONGINT; (* record number *)
  155. BEGIN
  156. GoTop(ActSalesrecIdx);
  157. ReadDBRec( SalesrecDBF,CurrentRec( ActSalesrecIdx));
  158. END FirstSalesrec;
  159. PROCEDURE LastSalesrec ();
  160. VAR
  161. L : LONGINT; (* record number *)
  162. BEGIN
  163. GoBottom(ActSalesrecIdx);
  164. ReadDBRec( SalesrecDBF,CurrentRec( ActSalesrecIdx));
  165. END LastSalesrec;
  166. PROCEDURE PackSalesrec();
  167. VAR
  168. EM : CARDINAL;
  169. LI : LONGINT;
  170. Tmp : SalesRec;
  171. BEGIN
  172. CloseSalesrecDBF();
  173. OpenSalesrecDBF(FALSE); (* open with no index *)
  174. DBPack(SalesrecDBF);
  175. CloseSalesrecDBF();
  176. EM := DeleteFile('Itemnbr');
  177. OpenSalesrecDBF(TRUE); (* open to rebuild the indexes*)
  178. CloseSalesrecDBF();
  179. END PackSalesrec;
  180. (* initialization code *)
  181. BEGIN
  182. NilDBF(SalesrecDBF);
  183. IndexOpen := FALSE;
  184. DBInit:=FALSE;
  185. END DBFSalesrec.