Topspeed_JPI/TS-V3/MODBASE/DBFCUSTO.MOD

IMPLEMENTATION MODULE DBFCustomer;
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, 31 * SIZE(DBFieldDescriptor));
  Fill(Desc,  31 * SIZE(DBFieldDescriptor),0);
   MakeDescriptor(  Desc^[  1], 'CIN', 10,  0, 'C');
   MakeDescriptor(  Desc^[  2], 'NAMEIDX', 40,  0, 'C');
   MakeDescriptor(  Desc^[  3], 'NAME', 40,  0, 'C');
   MakeDescriptor(  Desc^[  4], 'NOTES1', 40,  0, 'C');
   MakeDescriptor(  Desc^[  5], 'NOTES2', 40,  0, 'C');
   MakeDescriptor(  Desc^[  6], 'NOTES3', 40,  0, 'C');
   MakeDescriptor(  Desc^[  7], 'AMTOUT', 10,  2, 'N');
   MakeDescriptor(  Desc^[  8], 'LASTINV',  8,  0, 'D');
   MakeDescriptor(  Desc^[  9], 'YTDPURCH', 10,  2, 'N');
   MakeDescriptor(  Desc^[ 10], 'SALESREP', 10,  0, 'C');
   MakeDescriptor(  Desc^[ 11], 'CONTACT', 20,  0, 'C');
   MakeDescriptor(  Desc^[ 12], 'PHONENBR', 18,  0, 'C');
   MakeDescriptor(  Desc^[ 13], 'FAXNBR', 15,  0, 'C');
   MakeDescriptor(  Desc^[ 14], 'DATENTER',  8,  0, 'D');
   MakeDescriptor(  Desc^[ 15], 'SHIPTOA1', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 16], 'SHIPTOA2', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 17], 'SHIPTOA3', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 18], 'SHIPTOZP',  9,  0, 'C');
   MakeDescriptor(  Desc^[ 19], 'BILLTOA1', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 20], 'BILLTOA2', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 21], 'BILLTOA3', 30,  0, 'C');
   MakeDescriptor(  Desc^[ 22], 'BILLTOZP',  9,  0, 'C');
   MakeDescriptor(  Desc^[ 23], 'DISCLEVEL',  1,  0, 'N');
   MakeDescriptor(  Desc^[ 24], 'DISCAMOUNT',  4,  2, 'N');
   MakeDescriptor(  Desc^[ 25], 'SHIPVIA', 20,  0, 'C');
   MakeDescriptor(  Desc^[ 26], 'TERMS', 20,  0, 'C');
   MakeDescriptor(  Desc^[ 27], 'LIMIT', 10,  2, 'N');
   MakeDescriptor(  Desc^[ 28], 'RESALENBR', 15,  0, 'C');
   MakeDescriptor(  Desc^[ 29], 'TAXABLE',  1,  0, 'C');
   MakeDescriptor(  Desc^[ 30], 'FREEFRGHT',  1,  0, 'C');
   MakeDescriptor(  Desc^[ 31], 'SALEREPCOM',  4,  2, 'N');
   InitDBF('Customer.DBF',CustomerDBF,0,FALSE,TRUE,FALSE,DefaultFixUp);
   (* It would be a good to test error.*)
   Error:=BuildDBF(Desc^, 31,CustomerDBF);
   CloseDBF(CustomerDBF);
 DEALLOCATE(Desc, 31 * SIZE(DBFieldDescriptor));
END MakeDatabase;
 
PROCEDURE MoveCustomerToDBF(Rec : CustomerRec ); 
(* This code will move the data from the record to *)
(* the data base                                   *)
BEGIN
  WITH Rec DO
    Replace( CustomerDBF,  1,CIN);    (*  *)
    Replace( CustomerDBF,  2,NAMEIDX);    (*  *)
    Replace( CustomerDBF,  3,NAME);    (*  *)
    Replace( CustomerDBF,  4,NOTES1);    (*  *)
    Replace( CustomerDBF,  5,NOTES2);    (*  *)
    Replace( CustomerDBF,  6,NOTES3);    (*  *)
    ReplaceN( CustomerDBF,  7,AMTOUT);    (*  *)
    ReplaceD( CustomerDBF,  8,LASTINV);    (*  *)
    ReplaceN( CustomerDBF,  9,YTDPURCH);    (*  *)
    Replace( CustomerDBF, 10,SALESREP);    (*  *)
    Replace( CustomerDBF, 11,CONTACT);    (*  *)
    Replace( CustomerDBF, 12,PHONENBR);    (*  *)
    Replace( CustomerDBF, 13,FAXNBR);    (*  *)
    ReplaceD( CustomerDBF, 14,DATENTER);    (*  *)
    Replace( CustomerDBF, 15,SHIPTOA1);    (*  *)
    Replace( CustomerDBF, 16,SHIPTOA2);    (*  *)
    Replace( CustomerDBF, 17,SHIPTOA3);    (*  *)
    Replace( CustomerDBF, 18,SHIPTOZP);    (*  *)
    Replace( CustomerDBF, 19,BILLTOA1);    (*  *)
    Replace( CustomerDBF, 20,BILLTOA2);    (*  *)
    Replace( CustomerDBF, 21,BILLTOA3);    (*  *)
    Replace( CustomerDBF, 22,BILLTOZP);    (*  *)
    ReplaceN( CustomerDBF, 23,FLOAT(DISCLEVEL));    (*  *)
    ReplaceN( CustomerDBF, 24,DISCAMOUNT);    (*  *)
    Replace( CustomerDBF, 25,SHIPVIA);    (*  *)
    Replace( CustomerDBF, 26,TERMS);    (*  *)
    ReplaceN( CustomerDBF, 27,LIMIT);    (*  *)
    Replace( CustomerDBF, 28,RESALENBR);    (*  *)
    Replace( CustomerDBF, 29,TAXABLE);    (*  *)
    Replace( CustomerDBF, 30,FREEFRGHT);    (*  *)
    ReplaceN( CustomerDBF, 31,SALEREPCOM);    (*  *)
END;  (* end of with REC *)
END MoveCustomerToDBF;



PROCEDURE MoveCustomerFromDBF(VAR Rec : CustomerRec ); 
(* This code will move the data from the Database to *)
(* the record                                        *)
VAR B : BOOLEAN;
    R : Real8;
BEGIN
  WITH Rec DO
    GetField( CustomerDBF,  1,CIN);   (*  *)
    GetField( CustomerDBF,  2,NAMEIDX);   (*  *)
    GetField( CustomerDBF,  3,NAME);   (*  *)
    GetField( CustomerDBF,  4,NOTES1);   (*  *)
    GetField( CustomerDBF,  5,NOTES2);   (*  *)
    GetField( CustomerDBF,  6,NOTES3);   (*  *)
    GetNumField( CustomerDBF,  7,AMTOUT);   (*  *)
    GetDateField( CustomerDBF,  8,LASTINV);   (*  *)
    GetNumField( CustomerDBF,  9,YTDPURCH);   (*  *)
    GetField( CustomerDBF, 10,SALESREP);   (*  *)
    GetField( CustomerDBF, 11,CONTACT);   (*  *)
    GetField( CustomerDBF, 12,PHONENBR);   (*  *)
    GetField( CustomerDBF, 13,FAXNBR);   (*  *)
    GetDateField( CustomerDBF, 14,DATENTER);   (*  *)
    GetField( CustomerDBF, 15,SHIPTOA1);   (*  *)
    GetField( CustomerDBF, 16,SHIPTOA2);   (*  *)
    GetField( CustomerDBF, 17,SHIPTOA3);   (*  *)
    GetField( CustomerDBF, 18,SHIPTOZP);   (*  *)
    GetField( CustomerDBF, 19,BILLTOA1);   (*  *)
    GetField( CustomerDBF, 20,BILLTOA2);   (*  *)
    GetField( CustomerDBF, 21,BILLTOA3);   (*  *)
    GetField( CustomerDBF, 22,BILLTOZP);   (*  *)
    GetNumField( CustomerDBF, 23,R);
    DISCLEVEL:= TRUNC(R);   (*  *)
    GetNumField( CustomerDBF, 24,DISCAMOUNT);   (*  *)
    GetField( CustomerDBF, 25,SHIPVIA);   (*  *)
    GetField( CustomerDBF, 26,TERMS);   (*  *)
    GetNumField( CustomerDBF, 27,LIMIT);   (*  *)
    GetField( CustomerDBF, 28,RESALENBR);   (*  *)
    GetField( CustomerDBF, 29,TAXABLE);   (*  *)
    GetField( CustomerDBF, 30,FREEFRGHT);   (*  *)
    GetNumField( CustomerDBF, 31,SALEREPCOM);   (*  *)
END;  (* end of with REC^ *)
END MoveCustomerFromDBF;



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

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


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

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


 ActCustomerIdx := NameIdx; (* make current index *)
 GoTop(ActCustomerIdx);
  END; (* end with indext *)
END OpenCustomerDBF;



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

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

     CloseIndex(NameIdx ); (* close index file *)
    END; (* end index open*)
END CloseCustomerDBF;



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







PROCEDURE NextCustomer () : BOOLEAN; 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  NextRecord( ActCustomerIdx,L)    
    THEN ReadDBRec( CustomerDBF,L  );  
         RETURN TRUE;
    ELSE RETURN FALSE;
    END;
END NextCustomer;

PROCEDURE PrevCustomer () : BOOLEAN; 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  IF  PrevRecord( ActCustomerIdx,L) 
    THEN ReadDBRec( CustomerDBF,L  );  
         RETURN TRUE;
    ELSE RETURN FALSE;
    END; 
END PrevCustomer;

PROCEDURE FirstCustomer (); 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoTop(ActCustomerIdx); 
  ReadDBRec( CustomerDBF,CurrentRec(  ActCustomerIdx));
END FirstCustomer;

PROCEDURE LastCustomer (); 
VAR
  L : LONGINT;    (* record number *)
BEGIN
  GoBottom(ActCustomerIdx); 
  ReadDBRec( CustomerDBF,CurrentRec(  ActCustomerIdx));
END LastCustomer;
PROCEDURE PackCustomer();
VAR
  EM : CARDINAL;
  LI : LONGINT;
  Tmp : CustomerRec;
BEGIN
  CloseCustomerDBF();
  OpenCustomerDBF(FALSE);  (* open with no index *)
  DBPack(CustomerDBF);
  CloseCustomerDBF();

  EM := DeleteFile('Name');
  OpenCustomerDBF(TRUE);  (* open to rebuild the indexes*)
  CloseCustomerDBF();    
END PackCustomer;

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

END DBFCustomer.