IMPLEMENTATION MODULE DBFOrder; (* * 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,DBIndex,InitCompIndex,BuildCompIndex; FROM Drectory IMPORT DeleteFile; FROM StrEdit IMPORT CrunchBlanks,CAPstr; 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 IndexOpen,DBInit : BOOLEAN; PROCEDURE MoveOrderToDBF(Rec : OrderRec ); (* This code will move the data from the record to *) (* the data base *) BEGIN WITH Rec DO Replace( OrderDBF, 1,INVNBR); (* Invoice number *) Replace( OrderDBF, 2,ITEMNBR ); (* Item number *) Replace( OrderDBF, 3,DESC ); (* Description of item *) Replace( OrderDBF, 4,NOTES1 ); (* Notes of items line 1 *) Replace( OrderDBF, 5,NOTES2 ); (* Notes for item line 2 *) Replace( OrderDBF, 6,NOTES3 ); (* Notes for item line 3 *) Replace( OrderDBF, 7,UNITS ); (* Units *) ReplaceN( OrderDBF, 8,QNTSOLD ); (* Quantity sold *) ReplaceN( OrderDBF, 9,QNTORDER ); (* Quant ordered (for pricing ) *) ReplaceN( OrderDBF, 10,REALToReal8(FLOAT(DSCLEVEL ))); (* Discount level applied *) ReplaceN( OrderDBF, 11,UNITPRC ); (* Item price *) ReplaceN( OrderDBF, 12,TOTAL ); (* Total price for line item *) Replace( OrderDBF, 13,MANPRICE ); (* over rider computed price *) END; (* end of with REC *) END MoveOrderToDBF; PROCEDURE MoveOrderFromDBF(VAR Rec : OrderRec ); (* This code will move the data from the Database to *) (* the record *) VAR B : BOOLEAN; R : Real8; BEGIN WITH Rec DO GetField( OrderDBF, 1,INVNBR ); (* Invoice number *) GetField( OrderDBF, 2,ITEMNBR ); (* Item number *) GetField( OrderDBF, 3,DESC ); (* Description of item *) GetField( OrderDBF, 4,NOTES1 ); (* Notes of items line 1 *) GetField( OrderDBF, 5,NOTES2 ); (* Notes for item line 2 *) GetField( OrderDBF, 6,NOTES3 ); (* Notes for item line 3 *) GetField( OrderDBF, 7,UNITS ); (* Units *) GetNumField( OrderDBF, 8,QNTSOLD ); (* Quantity sold *) GetNumField( OrderDBF, 9,QNTORDER ); (* Quant ordered (for pricing ) *) GetNumField( OrderDBF, 10,R); DSCLEVEL := TRUNC(R); (* Discount level applied *) GetNumField( OrderDBF, 11,UNITPRC ); (* Item price *) GetNumField( OrderDBF, 12,TOTAL ); (* Total price for line item *) GetField( OrderDBF, 13,MANPRICE ); (* over rider computed price *) END; (* end of with REC^ *) END MoveOrderFromDBF; PROCEDURE MakeOrderKey(DBF : DBFile; Idx : DBIndex; VAR Key : ARRAY OF CHAR); VAR B : BOOLEAN; BEGIN GetField( DBF, 1,Key ); MakeKey(Key); END MakeOrderKey; PROCEDURE OpenOrderDBF(WithIdx : BOOLEAN); VAR ER : CARDINAL; BEGIN IndexOpen := WithIdx; (* Open the DBF file *) IF NOT DBInit THEN DBInit:=TRUE; InitDBF("Order.DBF", OrderDBF,Buffer,Safty,Exclusive,AutoLock,DefaultFixUp ); InitCompIndex( "Invnbr.Idx",InvnbrIdx,OrderDBF,MakeOrderKey,Buffer, Safty,FALSE,Exclusive); AddToUpdateList( OrderDBF, InvnbrIdx ); END; IF NOT OpenDBF( OrderDBF) THEN END; IF WithIdx THEN (* open all indexes and append to dbfile *) IF NOT OpenIndex( InvnbrIdx ) THEN ER := BuildCompIndex(InvnbrIdx,'C','Invnbr',12); END; ActOrderIdx := InvnbrIdx; (* make current index *) END; (* end with inx *) END OpenOrderDBF; PROCEDURE CloseOrderDBF (); (* close Data and index files *) BEGIN CloseDBF(OrderDBF); (* close dbf file *) IF IndexOpen THEN CloseIndex(InvnbrIdx ); (* close index file *) END; END CloseOrderDBF; PROCEDURE FindOrderByInvnbr( Key : ARRAY OF CHAR) : BOOLEAN; VAR Found : BOOLEAN; CKey : ARRAY[0..80] OF CHAR; BEGIN ActOrderIdx := InvnbrIdx ; (* make this index the active idx*) FindPositionCh( InvnbrIdx, Key, Found); CurrentKeyCh(InvnbrIdx,CKey); Found := Present(Key,CKey,CaseSens); IF Found THEN ReadDBRec( OrderDBF, CurrentRec( InvnbrIdx)); END; RETURN Found; END FindOrderByInvnbr; PROCEDURE NextOrder () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF NextRecord( ActOrderIdx,L) THEN ReadDBRec( OrderDBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END NextOrder; PROCEDURE PrevOrder () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF PrevRecord( ActOrderIdx,L) THEN ReadDBRec( OrderDBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END PrevOrder; PROCEDURE FirstOrder (); VAR L : LONGINT; (* record number *) BEGIN GoTop(ActOrderIdx); ReadDBRec( OrderDBF,CurrentRec( ActOrderIdx)); END FirstOrder; PROCEDURE LastOrder (); VAR L : LONGINT; (* record number *) BEGIN GoBottom(ActOrderIdx); ReadDBRec( OrderDBF,CurrentRec( ActOrderIdx)); END LastOrder; PROCEDURE PackOrder(); VAR EM : CARDINAL; BEGIN CloseOrderDBF(); OpenOrderDBF(FALSE); (* no index *) DBPack(OrderDBF); CloseDBF(OrderDBF); EM := DeleteFile("Invnbr.Idx"); OpenOrderDBF(TRUE); (* open & rebuild the index *) CloseOrderDBF(); END PackOrder; BEGIN NilDBF(OrderDBF); IndexOpen := FALSE; DBInit:=FALSE; END DBFOrder.