| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189 |
- >>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@.
|