>>FILE NAME =DBF@TABLENAME@.mod IMPLEMENTATION MODULE DBF@TABLENAME@; FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile, DeleteRecord,DefaultFixUp,NilDBF,PosOfField,DBFieldArray, DBFieldPtr,BuildDBF,DBFieldDescriptor; 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 StrEdit IMPORT CrunchBlanks; FROM HandleIO IMPORT FileExists; FROM Storage IMPORT ALLOCATE,DEALLOCATE; FROM DBStuff IMPORT MakeKey; FROM Drectory IMPORT DeleteFile; FROM StrConv IMPORT StrToReal; FROM NumTypes IMPORT Real8; FROM M2Strings IMPORT Assign; FROM DBStuff IMPORT MakeKey,MakeDescriptor; FROM ScanUtils IMPORT Present,CaseSens; FROM LowLevel IMPORT Fill; FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace, ReplaceD,ReplaceN; CONST Buffer = 0; Safty = TRUE; Exclusive = FALSE; AutoLock = TRUE; KeepDeleted = FALSE; VAR IndexOpen : BOOLEAN; >>MAKE DATABASE<< >>MOVE TO DB<< >>MOVE FROM DB<< PROCEDURE Open@TABLENAME@DBF(WithIdx : BOOLEAN); VAR ER : CARDINAL; BEGIN IndexOpen := WithIdx; (* Open the DBF file *) IF NOT FileExists("@TABLENAME@.DBF") THEN MakeDatabase(); END; InitDBF("@TABLENAME@.DBF", @TABLENAME@DBF,Buffer,Safty,Exclusive, AutoLock,DefaultFixUp ); IF NOT OpenDBF( @TABLENAME@DBF) THEN END; (* open all indexes and append to dbfile *) IF WithIdx THEN >>FOR EACH IDX<< InitIndex( "@IDXNAME@.NDX",@IDX@Idx,@TABLENAME@DBF,Buffer, Safty, KeepDeleted,Exclusive); IF NOT OpenIndex( @IDX@Idx ) THEN ER := BuildIndex(@IDX@Idx,'@IDX@'); (* check key lenght *) END; AddToUpdateList( @TABLENAME@DBF, @IDX@Idx ); Act@TABLENAME@Idx := @IDX@Idx; (* make current index *) >>END IDX<< GoTop(Act@TABLENAME@Idx); END; (* end with indext *) END Open@TABLENAME@DBF; PROCEDURE Close@TABLENAME@DBF (); (* close Data and index files *) BEGIN CloseDBF(@TABLENAME@DBF); (* close dbf file *) IF IndexOpen THEN >>FOR EACH IDX<< CloseIndex(@IDX@Idx ); (* close index file *) >>END IDX<< END; (* end index open*) END Close@TABLENAME@DBF; >>FOR EACH IDX<< >>IF INDEX =C PROCEDURE Find@TABLENAME@By@IDX@( Key : ARRAY OF CHAR) : BOOLEAN; VAR Found : BOOLEAN; CKey : ARRAY[0..80] OF CHAR; BEGIN Act@TABLENAME@Idx := @IDX@Idx ; (* make this index the active idx*) FindPositionCh( @IDX@Idx, Key, Found); CurrentKeyCh(@IDX@Idx,CKey); Found := Present(Key,CKey,CaseSens); IF Found THEN ReadDBRec( @TABLENAME@DBF, CurrentRec( @IDX@Idx)); END; RETURN Found; END Find@TABLENAME@By@IDX@; >>END IF<< >>IF INDEX =N PROCEDURE Find@TABLENAME@By@IDX@( Key : ARRAY OF CHAR) : BOOLEAN; VAR CKey : Real8; R : Real8; B : BOOLEAN: BEGIN Act@TABLENAME@Idx := @IDX@Idx ; (* make this index the active idx*) FindPositionCh( @IDX@Idx, Key, Found); Assign( CurrentKeyCh(@IDX@Idx,CKey)); B := StrToReal(Key,0,R); IF (Key = CKey) THEN ReadDBRec( @TABLENAME@DBF, CurrentRec( @IDX@Idx)); RETURN TRUE; END; RETURN FALSE; END Find@TABLENAME@By@IDX@; >>END IF<< >>END IDX<< PROCEDURE Next@TABLENAME@ () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF NextRecord( Act@TABLENAME@Idx,L) THEN ReadDBRec( @TABLENAME@DBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END Next@TABLENAME@; PROCEDURE Prev@TABLENAME@ () : BOOLEAN; VAR L : LONGINT; (* record number *) BEGIN IF PrevRecord( Act@TABLENAME@Idx,L) THEN ReadDBRec( @TABLENAME@DBF,L ); RETURN TRUE; ELSE RETURN FALSE; END; END Prev@TABLENAME@; PROCEDURE First@TABLENAME@ (); VAR L : LONGINT; (* record number *) BEGIN GoTop(Act@TABLENAME@Idx); ReadDBRec( @TABLENAME@DBF,CurrentRec( Act@TABLENAME@Idx)); END First@TABLENAME@; PROCEDURE Last@TABLENAME@ (); VAR L : LONGINT; (* record number *) BEGIN GoBottom(Act@TABLENAME@Idx); ReadDBRec( @TABLENAME@DBF,CurrentRec( Act@TABLENAME@Idx)); END Last@TABLENAME@; PROCEDURE Pack@TABLENAME@(); VAR EM : CARDINAL; LI : LONGINT; Tmp : @TABLENAME@Rec; BEGIN Close@TABLENAME@DBF(); Open@TABLENAME@DBF(FALSE); (* open with no index *) DBPack(@TABLENAME@DBF); Close@TABLENAME@DBF(); >>FOR EACH IDX<< EM := DeleteFile('@IDXNAME@'); >>END IDX<< Open@TABLENAME@DBF(TRUE); (* open to rebuild the indexes*) Close@TABLENAME@DBF(); END Pack@TABLENAME@; (* initialization code *) BEGIN NilDBF(@TABLENAME@DBF); IndexOpen := FALSE; END DBF@TABLENAME@.