IMPLEMENTATION MODULE DBFGas; (* * ModBase * Release 3.0 * (c) Copyright 1986 - 1991 PMI * P.O. Box 8402 * Green Bay Wi 53308 * All Rights Reserved * by Ed Ross *) FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile, DefaultFixUp,NilDBF; FROM DBCopier IMPORT DBPack; FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex, CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom, NextRecord,PrevRecord,CurrentKeyCh,FindPositionN, CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex; FROM Drectory IMPORT DeleteFile; FROM StrEdit IMPORT CrunchBlanks,Append; FROM StrConv IMPORT StrToReal; FROM NumTypes IMPORT Real8,REALToReal8; FROM DBStuff IMPORT MakeKey; FROM ScanUtils IMPORT Present,CaseSens; FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, ReplaceD,ReplaceN; CONST Buffer = 0; Safty = TRUE; Exclusive = FALSE; AutoLock = TRUE; VAR DBInit,IndexOpen : BOOLEAN; PROCEDURE MoveGasToDBF(Rec : GasRec ); (* This code will move the data from the record to *) (* the data base *) BEGIN WITH Rec DO Replace( GasDBF, 1,CIN); (* customer id number *) Replace( GasDBF, 2,INVNBR ); (* Out - Invoice number *) Replace( GasDBF, 3,ITEMNBR ); (* Helium type *) ReplaceD( GasDBF, 4,DATEOUT ); (* Helium out date *) ReplaceD( GasDBF, 5,DUEDATE ); (* Helium due date *) ReplaceD( GasDBF, 6,DATEIN ); (* Helium date in *) Replace( GasDBF, 7,STATUS ); (* Sequence number *) ReplaceN( GasDBF, 8,OVCHGAMT ); (* over time charge amount *) ReplaceN( GasDBF, 9,REALToReal8(FLOAT(DAYSLATE ))); (* Sequence number *) Replace( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *) END; (* end of with REC *) END MoveGasToDBF; PROCEDURE MoveGasFromDBF(VAR Rec : GasRec ); (* This code will move the data from the Database to *) (* the record *) VAR B : BOOLEAN; R : Real8; BEGIN WITH Rec DO GetField( GasDBF, 1,CIN ); (* customer id number *) GetField( GasDBF, 2,INVNBR ); (* Out - Invoice number *) GetField( GasDBF, 3,ITEMNBR ); (* Helium type *) GetDateField( GasDBF, 4,DATEOUT ); (* Helium out date *) GetDateField( GasDBF, 5,DUEDATE ); (* Helium due date *) GetDateField( GasDBF, 6,DATEIN ); (* Helium date in *) GetField( GasDBF, 7,STATUS ); (* Sequence number *) GetNumField( GasDBF, 8,OVCHGAMT ); (* over time charge amount *) GetNumField( GasDBF, 9,R); DAYSLATE := TRUNC(R); (* Sequence number *) GetField( GasDBF, 10,ININVNBR ); (* Check in invoice nubmer *) END; (* end of with REC^ *) END MoveGasFromDBF; PROCEDURE MakeGasOutKey(DBF : DBFile; Idx : DBIndex; VAR Key : ARRAY OF CHAR); VAR BEGIN GetField(GasDBF,2,Key); MakeKey(Key); END MakeGasOutKey; PROCEDURE MakeGasInKey(DBF : DBFile; Idx : DBIndex; VAR Key : ARRAY OF CHAR); VAR BEGIN GetField(GasDBF,10,Key); MakeKey(Key); END MakeGasInKey; PROCEDURE MakeGasKey( DBF : DBFile; Idx : DBIndex; VAR Key : ARRAY OF CHAR); VAR B : BOOLEAN; Str : ARRAY[0..15] OF CHAR; BEGIN GetField( GasDBF, 1,Key ); (* customer id number *) GetField( GasDBF, 7,Str ); (* Sequence number *) Append(Key,Str); GetField( GasDBF, 3,Str ); (* Helium type *) Append(Key,Str); MakeKey(Key); END MakeGasKey; PROCEDURE OpenGasDBF(WithIdx : BOOLEAN); VAR ER : CARDINAL; BEGIN IndexOpen := WithIdx; (* Open the DBF file *) IF NOT DBInit THEN DBInit:=TRUE; InitDBF("Gas.DBF", GasDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp ); InitCompIndex( "Gas.Idx",GasIdx,GasDBF,MakeGasKey,Buffer, Safty,FALSE,Exclusive); AddToUpdateList( GasDBF, GasIdx ); InitCompIndex( "GasOut.Idx",GasOutIdx,GasDBF,MakeGasOutKey,Buffer, Safty,FALSE,Exclusive); AddToUpdateList( GasDBF, GasOutIdx ); InitCompIndex( "GasIn.Idx",GasInIdx,GasDBF,MakeGasInKey,Buffer, Safty,FALSE,Exclusive); AddToUpdateList( GasDBF, GasInIdx ); END; IF NOT OpenDBF( GasDBF) THEN END; IF WithIdx THEN (* open all indexes and append to dbfile *) IF NOT OpenIndex( GasIdx ) THEN ER := BuildCompIndex(GasIdx,'C','Cin',20); (* check key lenght *) END; IF NOT OpenIndex( GasOutIdx ) THEN ER := BuildCompIndex(GasOutIdx,'C','Cin',20); (* check key lenght *) END; IF NOT OpenIndex( GasInIdx ) THEN ER := BuildCompIndex(GasInIdx,'C','Cin',20); (* check key lenght *) END; END; END OpenGasDBF; PROCEDURE CloseGasDBF (); (* close Data and index files *) BEGIN CloseDBF(GasDBF); (* close dbf file *) IF IndexOpen THEN CloseIndex(GasIdx ); (* close index file *) END; END CloseGasDBF; PROCEDURE FindGasByCin( Key : ARRAY OF CHAR) : BOOLEAN; VAR Found : BOOLEAN; CKey : ARRAY[0..80] OF CHAR; BEGIN FindPositionCh( GasIdx, Key, Found); CurrentKeyCh(GasIdx,CKey); Found := Present(Key,CKey,CaseSens); IF Found THEN ReadDBRec( GasDBF, CurrentRec( GasIdx)); END; RETURN Found; END FindGasByCin; PROCEDURE NextGas () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF NextRecord( GasIdx,L) THEN ReadDBRec( GasDBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END NextGas; PROCEDURE PrevGas () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF PrevRecord( GasIdx,L) THEN ReadDBRec( GasDBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END PrevGas; PROCEDURE FirstGas (); VAR L : LONGINT; (* record number *) BEGIN GoTop(GasIdx); ReadDBRec( GasDBF,CurrentRec( GasIdx)); END FirstGas; PROCEDURE LastGas (); VAR L : LONGINT; (* record number *) BEGIN GoBottom(GasIdx); ReadDBRec( GasDBF,CurrentRec( GasIdx)); END LastGas; PROCEDURE PackGas(); VAR EM : CARDINAL; BEGIN CloseGasDBF(); OpenGasDBF(FALSE); DBPack(GasDBF); CloseDBF(GasDBF); EM := DeleteFile('Gas.IDX'); OpenGasDBF(TRUE); (* open & rebuild the index *) CloseGasDBF(); END PackGas; BEGIN NilDBF(GasDBF); IndexOpen := FALSE; DBInit:=FALSE; END DBFGas.