Topspeed_JPI/TS/MODBASE/DBFTEST.MOD

IMPLEMENTATION MODULE DBFTest;
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;
 
PROCEDURE MakeDatabase();
VAR 
 Error : CARDINAL;
 Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor;
BEGIN
  ALLOCATE(Desc,  2 * SIZE(DBFieldDescriptor));
  Fill(Desc,   2 * SIZE(DBFieldDescriptor),0);
   MakeDescriptor(  Desc^[  1], 'TEST', 30,  0, 'C');
   MakeDescriptor(  Desc^[  2], 'TEMP', 20,  0, 'C');
   InitDBF('Test.DBF',TestDBF,0,FALSE,TRUE,FALSE,DefaultFixUp);
   (* It would be a good to test error.*)
   Error:=BuildDBF(Desc^,  2,TestDBF);
   CloseDBF(TestDBF);
 DEALLOCATE(Desc,  2 * SIZE(DBFieldDescriptor));
END MakeDatabase;
 
PROCEDURE MoveTestToDBF(Rec : TestRec ); 
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    Replace( TestDBF,  1,TEST);    (*  *)
    Replace( TestDBF,  2,TEMP);    (*  *)
END;  (* end of with REC *)
END MoveTestToDBF;



PROCEDURE MoveTestFromDBF(VAR Rec : TestRec ); 
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( TestDBF,  1,TEST);   (*  *)
    GetField( TestDBF,  2,TEMP);   (*  *)
END;  (* end of with REC^ *)
END MoveTestFromDBF;



PROCEDURE OpenTestDBF(WithIdx : BOOLEAN);
VAR ER : CARDINAL;
BEGIN

IndexOpen := WithIdx;
(* Open the DBF file *)
IF NOT FileExists("Test.DBF")
  THEN MakeDatabase();
  END;
InitDBF("Test.DBF", TestDBF,Buffer,Safty,Exclusive,
         AutoLock,DefaultFixUp );
 IF NOT OpenDBF( TestDBF)
     THEN END;


(* open all indexes and append to dbfile *)
IF WithIdx THEN

  InitIndex( "Test.NDX",TestIdx,TestDBF,Buffer, Safty,
                KeepDeleted,Exclusive);
 IF NOT OpenIndex( TestIdx )
   THEN
    ER := BuildIndex(TestIdx,'Test'); (* check key lenght *)
   END;
 AddToUpdateList( TestDBF, TestIdx );


 ActTestIdx := TestIdx; (* make current index *)
 GoTop(ActTestIdx);
  END; (* end with indext *)
END OpenTestDBF;



PROCEDURE CloseTestDBF ();   (* close Data and index files *)

BEGIN
  CloseDBF(TestDBF);  (* close dbf file *)
  IF IndexOpen
    THEN

     CloseIndex(TestIdx ); (* close index file *)
    END; (* end index open*)
END CloseTestDBF;



PROCEDURE FindTestByTest( Key : ARRAY OF CHAR) : BOOLEAN;
VAR Found : BOOLEAN;
    CKey : ARRAY[0..80] OF CHAR;
BEGIN
   ActTestIdx := TestIdx ;   (* make this index the active idx*)
   FindPositionCh( TestIdx, Key, Found);
   CurrentKeyCh(TestIdx,CKey);
   Found := Present(Key,CKey,CaseSens);
    IF Found
       THEN ReadDBRec( TestDBF, CurrentRec( TestIdx));
   END;
   RETURN Found;
END FindTestByTest;







PROCEDURE NextTest () : BOOLEAN; 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  NextRecord( ActTestIdx,L)    
    THEN ReadDBRec( TestDBF,L  );  
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END NextTest;

PROCEDURE PrevTest () : BOOLEAN; 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  PrevRecord( ActTestIdx,L) 
    THEN ReadDBRec( TestDBF,L  );  
         RETURN TRUE;
    ELSE RETURN FALSE;
    END; 
END PrevTest;

PROCEDURE FirstTest (); 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoTop(ActTestIdx); 
  ReadDBRec( TestDBF,CurrentRec(  ActTestIdx));
END FirstTest;

PROCEDURE LastTest (); 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoBottom(ActTestIdx); 
  ReadDBRec( TestDBF,CurrentRec(  ActTestIdx));
END LastTest;
PROCEDURE PackTest();
VAR
  EM : CARDINAL;
  LI : LONGINT;
  Tmp : TestRec;
BEGIN
  CloseTestDBF();
  OpenTestDBF(FALSE);  (* open with no index *)
  DBPack(TestDBF);
  CloseTestDBF();

  EM := DeleteFile('Test');
  OpenTestDBF(TRUE);  (* open to rebuild the indexes*)
  CloseTestDBF();    
END PackTest;

(* initialization code *)
BEGIN
 NilDBF(TestDBF);
 IndexOpen := FALSE;

END DBFTest.