home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progpas
/
gsdb25.arj
/
GS_DBASE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-01
|
51KB
|
1,083 lines
{-----------------------------------------------------------------------------
dBase III File Handler
GS_DBASE Copyright (c) Richard F. Griffin
15 November 1990
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit handles the objects for all dBase III file (.DBF)
operations.
SHAREWARE -- COMMERCIAL USE RESTRICTED
Changes:
16 Nov 90 - Moved Pack method to GS_dBFld.
02 May 91 - Added an IndexSignature constant to the index units so the
GS_dBase unit can confirm the index unit in use. The flag
IsDB3NDX is true if the dBase III index unit is used. This
is needed to properly convert date fields for an index. The
dBase III index requires a julian date instead of the
character field stored in the record. Most other indexes
use the field as stored (YYYYMMDD).
03 May 91 - Added routine to convert a date field to julian date when
used as an index field in PutRec.
06 Jun 91 - Fixed error in Open that caused the status not to be set
to 'NotUpdated'. Comment close bracket was missing, and
caused the next instruction to be ignorred.
Added a UnInit method to release buffer memory from the
Heap when the file is no longer needed. If the file is
to be used again, it must be reinitialized by calling
the Init method. This allows several files to use the
same object, one after the other. For example:
obj.Init('FILE1');
obj.Open;
obj.GetRec(.....);
obj.Close;
obj.UnInit;
obj.Init('FILE2');
obj.Open;
obj.GetRec(.....);
obj.Close;
obj.UnInit;
------------------------------------------------------------------------------}
{
┌──────────────────────┐
│ INTERFACE SECTION: │
└──────────────────────┘
}
unit GS_DBASE;
interface
uses
CRT,
DOS,
GS_KeyI,
GS_Date,
GS_FileH, {File handler}
GS_Strng, {String handling Routines}
GS_Error, {Error Handling routines}
GS_DBNdx; {Unit for index operations (.NDX files)}
const
GS_dBase_MaxRecBytes = 4000; {dBASE III record limit }
GS_dBase_MaxRecField = 128; {dBASE III field limit}
GS_dBase_MaxMemoRec = 512; {Size of each block of memo file data}
Next_Record = -1; {Token value passed to read next record}
Prev_Record = -2; {Token value passed to read previous record}
Top_Record = -3; {Token value passed to read first record}
Bttm_Record = -4; {Token value passed to read final record}
GS_dBase_UnDltChr = 32; {Character for Undeleted Record}
GS_dBase_DltChr = 42; {Character for Deleted Record}
type
GS_dBase_Status = (NotOpen, NotUpdated, Updated);
{Flags to indicate status of dBase III file }
GS_dBase_dRec = ^GS_dBase_DataRecord;
{Pointer type used in object descriptions to locate the memory}
{array in bytes for the dBase record. Uses GS_dBase_DataRecord}
{defined below.}
GS_dBase_DataRecord = ARRAY[0..GS_dBase_MaxRecBytes] OF Byte;
{Defines an array of bytes in memory that is as large as the }
{maximum size of a dBase record (GS_dBase_MaxRecBytes).}
{
┌──────────────────────────────────────────────────────────────────┐
│ ******** Data Structure Description ********** │
│ │
│ The following record defines the dBase III file header. Refer │
│ to Appendix A for an explanation of each data element. │
└──────────────────────────────────────────────────────────────────┘
}
GS_dBase_Head = Record
DBType : Byte;
Year : Byte;
Month : Byte;
Day : Byte;
RecCount : LongInt;
Location : Integer;
RecordLen : Integer;
Reserved : Array[1..20] of Byte;
end;
{
┌──────────────────────────────────────────────────────────────────┐
│ ********* Field Descriptor ********* │
│ │
│ This record defines the field descriptor. There is one of │
│ these for each field defined in the database structure. They │
│ are stacked as 32 bytes following the file header record, as │
│ described in Appendix A. │
└──────────────────────────────────────────────────────────────────┘
}
GS_dBase_Field = Record
FieldName : String[10];
{Array[1..11] of Char actually}
{This is to simplify conversion}
FieldType : Char;
FieldAddress : LongInt;
FieldLen : Byte;
FieldDec : Byte;
Reserved : Array[1..14] of Char;
end;
GS_dBase_dFld = ^GS_dBase_DataField;
{Pointer type used in object descriptions to assign memory}
{for storing the field descriptors. }
GS_dBase_DataField = ARRAY[1..GS_dBase_MaxRecField] OF GS_dBase_Field;
{Defines an array of field descriptors (GS_dBase_Field) that}
{is as large as the maximum number of dBase fields allowed}
{(GS_dBase_MaxRecFields).}
GS_dBase_nFld = ^GS_dBase_NameField;
{Pointer type used in object descriptions to assign memory}
{for storing the field name strings. }
GS_dBase_NameField = Array[1..GS_dBase_MaxRecField] OF string[11];
{Defines an array of field name strings (GS_dBase_Field) that}
{is as large as the maximum number of dBase fields allowed}
{(GS_dBase_MaxRecFields).}
{
┌──────────────────────────────────────────────────────────────┐
│ *********** dBase Object Definition ************ │
└──────────────────────────────────────────────────────────────┘
}
GS_dBase_DB = object(GS_KeyI_Objt) {Make it a child for keyboard control}
FileName : string[64]; {Stores FileName of dBase File}
dFile : file; {File Type to reference data file}
mFile : file; {File Type to reference memo file}
HeadProlog : GS_dBase_Head; {Image of file header}
dStatus : GS_dBase_Status; {Holds Status Code of file}
WithMemo : Boolean; {True if memo file present}
DateOfUpdate : string[8]; {MM/DD/YY of last update}
NumRecs : LongInt; {Number of records in file}
HeadLen : Integer; {Header + Field Descriptor length}
RecLen : Integer; {Length of record}
NumFields : Integer; {Number of fields in the record}
Fields : GS_dBase_dFld; {Pointer to memory array holding}
{field descriptors}
FieldsN : GS_dBase_nFld; {Pointer to memory array holding}
{Field name strings}
RecNumber : LongInt; {Physical record number last read}
CurRecord : GS_dBase_dRec; {Pointer to memory array holding}
{the current record data. Refer}
{to Appendix B for record structure}
DelFlag : boolean; {True if record deleted}
File_EOF : boolean; {True if at end of file }
Found : boolean; {Set True on valid record Find}
dbfNdxTbl : array [1..16] of GS_Indx_LPtr;
{Holds addresses of up to 16 Index}
{Objects. The first array is the}
{Master Index. For File changes,}
{this array will be used to ensure}
{all indexes are updated. }
dbfNdxActv : boolean; {True if an index file is used}
{
┌───────────────────────────────────────────────────────────────────────┐
│ *** These methods are described individually in the following *** │
│ pages. As seen here, their name describes their function │
└───────────────────────────────────────────────────────────────────────┘
}
PROCEDURE Append;
PROCEDURE Blank;
PROCEDURE Close;
FUNCTION Create(FName : string) : boolean;
PROCEDURE Delete;
FUNCTION Find(st : string) : boolean;
FUNCTION Formula(st : string; var ftyp : char) : string; virtual;
PROCEDURE GetRec(RecNum: LongInt);
PROCEDURE Index(IName : String);
PROCEDURE Index_List(RecAct: LongInt; var I_List; var RNum : longint);
CONSTRUCTOR Init(FName : string);
PROCEDURE Open;
PROCEDURE PutRec(RecNum : LongInt);
PROCEDURE UnDelete;
PROCEDURE UnInit;
end;
var
IsDB3NDX : boolean;
{
┌──────────────────────────┐
│ IMPLEMENTATION SECTION │
└──────────────────────────┘
}
implementation
uses
GS_dB3Wk; {Use shown here to avoid circular def.}
CONST
DB3File = 3; {First byte of dBase III(+) file}
DB3WithMemo = $83; {First byte of dBase III(+) file}
{if memo file (.DBT) is present }
PROCEDURE GS_dBase_DB.Append;
BEGIN
PutRec(0);
{Calls objectname.PutRec method with a record number of}
{zero. This causes the record number to default to }
{objectname.NumRecs + 1. }
END;
PROCEDURE GS_dBase_DB.Blank;
begin
FillChar(CurRecord^[0], RecLen, ' ');
{Fill spaces for RecLen bytes}
end;
PROCEDURE GS_dBase_DB.Close;
CONST
EofMark : Byte = $1A; {ASCII code for EOF byte}
var
rsl,
yy, mm, dd, wd : word; {Local variables to get today's}
{date through TP's GetDate procedure}
i : integer; {work variable}
{
┌──────────────────────────────────────────────────────────────┐
│ The Update_File procedure is called if any records are │
│ added/updated while the file is open. This is indicated │
│ by objectname.dStatus set to 'UpDated'. The procedure │
│ inserts the current date in the file header, updates the │
│ record count, rewrites the file header, and writes an EOF │
│ byte at the end of the file. │
└──────────────────────────────────────────────────────────────┘
}
procedure UpDate_File;
BEGIN
GetDate (yy,mm,dd,wd); {Call TP's GetDate procedure}
HeadProlog.year := yy-1900; {Extract the Year}
HeadProlog.month := mm; {Extract the Month}
HeadProlog.day := dd; {Extract the Day}
HeadProlog.RecCount := NumRecs; {Update number records in file}
GS_FileWrite(dFile, 0, HeadProlog, 8, rsl);
GS_FileWrite(dFile, HeadLen+NumRecs*RecLen, EofMark, 1, rsl); {EOF marker}
END; { IF Updated }
{
┌───────────────────────────────────────────────────────────┐
│ Beginning of CLOSE Procedure. │
│ 1. Exit if file not open │
│ 2. Update the file header if records added/updated │
│ 3. Close the file │
│ 4. Close the .DBT memo file if applicable │
│ 5. Set objectname.dStatus to 'NotOpen' │
└───────────────────────────────────────────────────────────┘
}
begin
IF dStatus = NotOpen THEN exit; {Exit if file not open}
IF dStatus = Updated THEN UpDate_File;
{Write new header information if the}
{file was updated in any way}
GS_FileClose(dFile);
if WithMemo then GS_FileClose(mFile);
{
┌──────────────────────────────────────────────────────────┐
│ The following routine releases index files associated │
│ with the .DBF file and releases memory. │
└──────────────────────────────────────────────────────────┘
}
i := 1; {initialize counter}
while dbfNdxTbl[i] <> nil do
begin
dbfNdxTbl[i]^.Ndx_Close; {Close this index file}
dispose(dbfNdxTbl[i]); {Release Heap Memory}
dbfNdxTbl[i] := nil; {set pointer to 'empty'}
inc(i); {increment counter}
end;
dbfNdxActv := false;
dStatus := NotOpen; {Set objectname.dStatus to 'NotOpen'}
END; { GS_dBase_Close }
Function GS_dBase_DB.Create(FName : string) : boolean;
begin
if GS_dB3_Create(FName) then Create := true else Create := false;
END; { GS_dBase_Create }
PROCEDURE GS_dBase_DB.Delete;
begin
DelFlag := true; {Set Delete Flag to true}
CurRecord^[0] := GS_dBase_DltChr; {Put '*' in first byte of current record}
PutRec(RecNumber); {Write the current record to disk }
end; {GS_dBase_Delete}
{
FIND
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The FIND method will search the master index file for the ║
║ key string contained in the calling argument. ║
║ ║
║ Note: At this time, numeric fields must have a string value ║
║ argument, and date fields are not handled. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Find(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is key value to match) ║
║ ║
║ Result: ║
║ ║
║ Matching record is read if found. No error check, ║
║ but index object Found flag is set true on match. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Function GS_dBase_DB.Find(st : string) : boolean;
var
RNum : longint;
begin
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyFind method if true. The key string is passed to │
│ the method as the only argument. The matching record │
│ is returned from the method. If there is no match, │
│ the method returns a zero value. Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). The ability to use an │
│ object pointer in place of an actual object is a highly │
│ useful tool. │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) then
begin
RNum := dbfNdxTbl[1]^.KeyFind(st);
if RNum > 0 then {RNum = 0 if no match, otherwise}
{it holds the valid record number}
begin
GetRec(RNum); {If match found, read the record}
Found := True; {Set Match Found flag true}
end else
begin {If no matching index key, then}
Found := False; {Set Match Found Flag False}
end;
end else {If there is no index file, then}
Found := False; {Set Match Found Flag False}
Find := Found;
end; {GS_dBase_Find}
function GS_dBase_DB.Formula(st : string; var ftyp : char) : string;
begin
ShowError(399,'Object for field handling missing');
Formula := '';
end;
{
GETREC
╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ The GETREC method will access the dBase III file to retrieve the ║
║ record number passed in the call. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.GetRec (RecNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecNum is the record number to retrieve. ║
║ ** If a number greater than 0, record ║
║ will be physical number from .DBF; ║
║ if Next_Record, Prev_Record, ║
║ Top_Record, or Bttm_Record, then ║
║ the appropriate record will be found. ║
║ For these codes, if an index is in ║
║ use, the record will be retrieved ║
║ based on it's location in the index.) ║
║ ║
║ Result: ║
║ ║
║ 1. Record is retrieved based on record number argument ║
║ 2. Objectname.RecNumber set to record number read ║
║ 3. Objectname.DelFlag set true if deleted record ║
║ 4. If last record of file (.DBF or .NDX), then ║
║ objectname.File_EOF set true. ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.GetRec(RecNum : LongInt);
VAR
dFilea : FileRec absolute dFile;
i,
Result : Integer; {Local working variable}
RNum : LongInt; {Local working variable }
StrFil : String[80];
rsl : word;
BEGIN
if NumRecs = 0 then
begin
File_EOF := true;
exit;
end;
RNum := RecNum; {Store RecNum locally for modification}
File_EOF := false; {Initialize End of File Flag to false}
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyRead method if true and the record requested is │
│ a relative record (less than 0). Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). The ability to use an │
│ object pointer in place of an actual object is a highly │
│ useful tool. Upon return, the index file's EOF flag is │
│ stored as the .DBF's End-of-File Flag. │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) and (RecNum < 0) then
begin
RNum := dbfNdxTbl[1]^.KeyRead(RecNum);
{Get record number of physical}
{record to read from .DBF.}
File_EOF :=dbfNdxTbl[1]^.KeyEOF;
{Get index EOF flag. The EOF will be}
{set when a KeyRead of Next_Record}
{will go past the last index record}
end
else
if (dbfNdxActv) and (RNum > 0) and (RNum <= NumRecs) then
if not dbfNdxTbl[1]^.KeyLocRec(RecNum) then exit;
{If physical record search, set index}
{to the same record.}
if File_EOF then exit; {Return if EOF reached}
{
┌──────────────────────────────────────────────────────────┐
│ The value in RNum is tested to see if it is a relative │
│ record seek or a physical record number. The number │
│ is also tested to ensure it is in the file record │
│ range of valid numbers. Note, if an index was read, │
│ RNum will now be a physical record. │
└──────────────────────────────────────────────────────────┘
}
case RNum of
Next_Record : begin
RNum := RecNumber + 1;
{Get next sequential record}
if RNum > NumRecs then
begin {If beyond number of records in file,}
{you must recover}
RNum := NumRecs;
{Reset to final record}
File_EOF := true;
{Set EOF Flag to True}
exit; {Return from GetRec}
end;
end;
Prev_Record : begin
RNum := RecNumber - 1;
{Get Previous Record}
if RNum < 1 then RNum := 1;
{If at beginning of file, stay}
end;
Top_Record : RNum := 1; {Set to the first record}
Bttm_Record : RNum := NumRecs; {Set to the last record}
end;
if (RNum < 1) or (RNum > NumRecs) then
begin {if a physical record number is out}
{of range, exit with error}
i := 0;
Str(RNum, StrFil);
StrFil := 'Record ' + StrFil;
StrFil := StrFil + ' Out of Range for File ';
while dFilea.Name[i] <> #0 do
begin
StrFil := StrFil + dFilea.Name[i];
inc(i);
end;
ShowError(100,StrFil);
exit; {Terminate read attempt if record number}
{is out of range}
end;
GS_FileRead(dFile, HeadLen+(RNum-1) * RecLen, CurRecord^, RecLen, rsl);
{Read RecLen bytes into memory buffer}
{for the correct physical record}
RecNumber := RNum; {Set objectname.RecNumber = this record }
if CurRecord^[0] = GS_dBase_DltChr then DelFlag := true
else DelFlag := false; {Set objectname.DelFlag to show status}
{of the record's Delete byte}
END; {GetRec}
{
INDEX
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INDEX method initializes the index array in objectname ║
║ and assigns the first index as the master index. The other ║
║ index files will be updated upon .DBF updates (when the ║
║ index write entries are added). ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Index(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is list of index files, separated ║
║ by spaces. ║
║ ║
║ Result: ║
║ ║
║ Index files are assigned and the master index is ║
║ opened. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Procedure GS_dBase_DB.Index (IName : String);
var
i,j : integer; {Local working variable }
st : String[64]; {Local working variable}
begin
{
┌───────────────────────────────────────────────────┐
│ Reset index file array. │
│ 1. Close open index files │
│ 2. Release index objects stored on the heap │
│ 3. Set array pointers to nil. │
└───────────────────────────────────────────────────┘
}
i := 1;
while dbfNdxTbl[i] <> nil do
begin
dbfNdxTbl[i]^.Ndx_Close;
Dispose(dbfNdxTbl[i]);
dbfNdxTbl[i] := nil;
inc(i);
end;
dbfNdxActv := false; {Set index active flag to false}
{
┌──────────────────────────────────────────────────────┐
│ This routine scans the input string for the names │
│ of index files. Names must be separated by commas │
│ or spaces. The .NDX extension must not be part │
│ of the file name │
└──────────────────────────────────────────────────────┘
}
i := 0; {i will hold count of index files}
j := 1;
st := '';
while j <= length(IName) do
begin
{
┌───────────────────────────────────────────────┐
│ Build an index file name in st until end of │
│ input string, a comma, or a space is found │
└───────────────────────────────────────────────┘
}
if (IName[j] <> ' ') and (IName[j] <> ',') then
st := st + IName[j]
else
begin {When file string is complete:}
inc(i); {Increment index file count}
if st <> '' then { If not an empty string: }
begin
New(dbfNdxTbl[i]); {Get heap memory for index object}
if dbfNdxTbl[i]^.Init(st) then
begin {Initialize index object}
end;
end;
st := ''; {Reset file name to empty for next}
end;
inc(j); {Inc counter for next input string char }
end;
{
┌─────────────────────────────────────────────────┐
│ This routine is needed to finish out when the │
│ input string is finished. Note the routine │
│ above does not create an index entry at the │
│ end of the input string. That is done here. │
└─────────────────────────────────────────────────┘
}
if st <> '' then
begin
inc(i);
New(dbfNdxTbl[i]);
if dbfNdxTbl[i]^.Init(st) then
begin
end;
end;
if i > 0 then dbfNdxActv := true; {Set index active flag true if index }
{files are found }
end;
{
INDEX_LIST
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INDEX_LIST method returns the index key field from the ║
║ index used as the master index. This is done instead of the ║
║ normal action of reading the .DBF file. Only the index file ║
║ is read during this method. A common use of this method is ║
║ to build a memory table of keys and associated record numbers. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Index_LIST(RecNum, String, RNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecAct is the index key to retrieve. ║
║ (Top_Record, Next_Record, ║
║ Prev_Record, or Bttm_Record) ║
║ ║
║ String is field to place key value. ║
║ RNum is field to place record number. ║
║ ║
║ Result: ║
║ ║
║ The master Index file is accessed based on RecAct. ║
║ The value in the key field entry is returned in ║
║ String. The record's location id the .DBF file is ║
║ returned in RecNum. File_EOF is set upon an attempt ║
║ to access beyond the last index entry. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Procedure GS_dBase_DB.Index_List(RecAct: LongInt; var I_List;
var RNum : longint);
var
I_L : string[255] absolute I_List;
{Redefines I_List for internal use}
BEGIN
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyRead method if true and the record requested is │
│ a relative record (less than 0). Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) and (RecAct < 0) then
begin
RNum := dbfNdxTbl[1]^.KeyRead(RecAct);
if RNum > 0 then {if good read, RNum will be > 0}
begin
I_L := dbfNdxTbl[1]^.Ndx_Key_St;
{get key value, and store in the}
{I_List variable, using I_L which}
{points to the same memory location}
end else
begin
RNum := 0; {set null value if no valid read}
I_L := ''; {set null value if no valid read}
end;
File_EOF := dbfNdxTbl[1]^.KeyEOF;
{move index EOF flag to File_EOF};
end;
end;
{
INIT
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INIT method initializes objectname by reading the .DBF ║
║ file and loading file structure information into the object. ║
║ It also checks for a memo file (.DBT) and assigns that to ║
║ a file type if it exists. This routine must be called ║
║ before using the other methods in objectname. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Init(String) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ String is the file name of the dBase ║
║ file (without the .DBF extension). ║
║ ║
║ Result: ║
║ ║
║ DBase file object is initialized and memo file is ║
║ initialized. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
CONSTRUCTOR GS_dBase_DB.Init(FName : string);
var
i : integer; {Local working variable}
{
┌───────────────────────────────────────────────────────┐
│ The ProcessHeader Procedure stores information from │
│ the dBase III .DBF file into objectname. │
└───────────────────────────────────────────────────────┘
}
PROCEDURE ProcessHeader;
VAR
dFilea : FileRec absolute dFile;
StrFil : string[80];
WSt : string[12];
Result : word;
ofs : longint;
o, i : Integer; {Local working variables}
m,dy,y : string[2]; {Local working variables}
BEGIN {ProcessHeader}
{
┌─────────────────────────────────────────────────┐
│ Test to ensure file is a dBase III .DBF file. │
│ Exit with error if it is not. Set the │
│ objectname.WithMemo flag if memo file present. │
└─────────────────────────────────────────────────┘
}
CASE HeadProlog.DBType OF
DB3File : WithMemo := False;
DB3WithMemo : WithMemo := True;
ELSE
BEGIN
GS_FileClose(dFile); {If not a valid dBase file, close}
StrFil := '';
i := 0;
while dFilea.Name[i] <> #0 do
begin
StrFil := StrFil + dFilea.Name[i];
inc(i);
end;
StrFil := StrFil + ' not a dBase III file';
ShowError(157,StrFil);
Exit;
END;
END; {CASE}
{
┌─────────────────────────────────────────────┐
│ Convert numeric date fields to ASCII text │
└─────────────────────────────────────────────┘
}
Str(HeadProlog.month,m);
if length(m) = 1 then m := '0'+m;
Str(HeadProlog.day,dy);
if length(dy) = 1 then dy := '0'+dy;
Str(HeadProlog.year,y);
if length(y) = 1 then y := '0'+y;
DateOfUpdate := m + '/' + dy + '/' + y;
NumRecs := HeadProlog.RecCount; {Number of records in file}
HeadLen := HeadProlog.Location; {Starting byte location of first record}
RecLen := HeadProlog.RecordLen; {Length of each record}
RecNumber := 0; {Set current record to zero}
File_EOF := false; {Set End of File flag to false}
GetMem(Fields, HeadLen-33); {Allocate memory for fields buffer.}
{Compute total header size as length of}
{header file information (32 bytes),}
{End of Header mark (1 byte), and the}
{field descriptors (32 bytes each).}
{Size - 33 = memory required by fields}
NumFields := (HeadLen - 33) div 32;
{Each field descriptor is 32 bytes}
{Field descriptor area of header can}
{be divided by 32 to get field count}
GS_FileRead(dFile, -1, Fields^, HeadLen-33, Result);
{Read field descriptor portion of header}
GetMem(FieldsN, NumFields*12); {Allocate memory for fields buffer.}
ofs := 1; {Find offset for each field}
for i := 1 to NumFields do
begin
Fields^[i].FieldAddress := ofs;
ofs := ofs + Fields^[i].FieldLen;
move(Fields^[i].FieldName,WSt[1],11);
WSt[0] := #11;
WSt[0] := char(pred(pos(#0,WSt)));
WSt := TrimR(WSt); {Remove trailing spaces}
FieldsN^[i] := WSt;
end;
END; {ProcessHeader}
{
┌──────────────────────────────────────────────────────────┐
│ The GetHeader Procedure does the initial file read. │
│ Reads the first 32 bytes of .DBF file. This contains │
│ information on record size, field descriptor size, │
│ last date updated. Starting point for all other │
│ file structure information. │
└──────────────────────────────────────────────────────────┘
}
PROCEDURE GetHeader;
VAR
Result : Word;
BEGIN { GetHeader }
GS_FileRead(dFile, 0, HeadProlog, 32, Result);
ProcessHeader;
END; { GetHeader }
{
┌─────────────────────────────────────────────────┐
│ Beginning of INIT Procedure. It does the │
│ following: │
│ 1. Assigns .DBF extension to the file. │
│ 2. Opens the file. │
│ 3. Gets header information for the │
│ objectname object. │
│ 4. Closes file. │
│ 5. Allocates memory for a record buffer │
│ 6. Sets file status to 'Not Open'. │
│ 7. Sets Index Active to false. │
│ 8. If memo file, assigns a file type. │
└─────────────────────────────────────────────────┘
}
begin
Filename := FName+'.DBF'; {Assign .DBF file extension}
GS_FileAssign(dFile, FileName,8192);
GS_FileReset(dFile, 1);
GetHeader; {Load file structure information into}
{objectname}
GS_FileClose(dFile); {Finished with file for now}
GetMem(CurRecord, RecLen); {Allocate memory for record buffer}
dStatus := NotOpen; {Set file status to 'Not Open' }
dbfNdxActv := false; {Set index active flag to false}
for i := 1 to 16 do dbfNdxTbl[i] := nil;
{Set index object pointer array to nil}
if WithMemo then
begin
GS_FileAssign(mFile, FName+'.DBT',2048);
{If a memo file is attached, then assign}
{it to a file type. This must be done}
{here so all future objects can get to}
{the file if necessary.}
end;
GS_KeyI_Objt.Init; {Initialize parent object}
end;
{
OPEN
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The OPEN method checks to see if the file referenced by ║
║ objectname is already open. If it is open, no other action ║
║ is taken. If the file is not open, then it and its memo ║
║ file, if one exists, is opened and flags are set. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Open ║
║ ║
║ ( where objectname is of type GS_dBase_DB ) ║
║ ║
║ Result: ║
║ ║
║ 1. If file already opened, no action is taken. ║
║ ║
║ otherwise: ║
║ ║
║ 1. .DBF file is opened. ║
║ 2. File status set to 'Not Updated'. ║
║ 3. If memo file exists, .DBT file is opened. ║
║ 4. Current record number is set to zero. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.Open;
BEGIN { GS_dBase_Open }
if dStatus = NotOpen then {Do only if file not already open}
begin
GS_FileAssign(dFile, FileName,4096);
GS_FileReset(dFile, 1); {Open .DBF file}
dStatus := NotUpdated; {Set status to 'Not Updated' }
if WithMemo then GS_FileReset(mFile,GS_dBase_MaxMemoRec);
{If memo file, then open .DBT file}
RecNumber := 0; {Set current record to zero }
Blank; {Clear the record buffer}
end;
END; { GS_dBase_Open }
{
PUTREC
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The PUTREC method will write an updated record to the dBase ║
║ III(+) .DBF file. The data to be written must be stored ║
║ in objectname.CurRecord^ prior to calling the method. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.PutRec(RecNum) ║
║ ║
║ ( where objectname is of type GS_dBase_DB, ║
║ RecNum is physical record number to ║
║ write to. If not within the range of ║
║ existing records, it record will be ║
║ appended to the end of the file. ║
║ ║
║ Result: ║
║ ║
║ 1. If RecNum not in range of existing records ║
║ it will be appended and objectname.NumRecs ║
║ incremented by one. ║
║ 2. Record will be written. ║
║ 3. RecNum will become current record number. ║
║ 4. File status will be changed to 'Updated'. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.PutRec(RecNum : LongInt);
VAR
Result : Word; {Local Variable}
RNum : LongInt; {Local Variable}
IKey : String; {Local Variable for Key Formula string}
ftyp : Char;
fval : LongInt;
BEGIN
RNum := RecNum; {Move RecNum to local variable for }
{possible modification}
{
┌─────────────────────────────────────────────┐
│ If Record Number not in range of existing │
│ records, append it to the end of file. │
└─────────────────────────────────────────────┘
}
IF (RNum > NumRecs) or (RNum < 1) then
begin
inc(NumRecs); {Increment record count}
RNum := NumRecs; {Put last record number in RNum}
end;
GS_FileWrite(dFile, HeadLen+(RNum-1)*RecLen, CurRecord^, RecLen, Result);
RecNumber := RNum; {Store record number as current record }
dStatus := Updated; {Set file status to 'Updated'}
{
┌───────────────────────────────────────────────────────────┐
│ The next statement checks to see if an index is active │
│ (dbfNdxActv = true), and calls the index object's │
│ KeyUpdate method if true. Note that the method │
│ is called using the first index object pointer in array │
│ dbfNdxTabl (the master index). │
└───────────────────────────────────────────────────────────┘
}
if (dbfNdxActv) then
begin
IKey := Formula(dbfNdxTbl[1]^.Ndx_Key_Form,ftyp);
if (IsDB3NDX) and (ftyp = 'D') then
begin
fval := GS_Date_Juln(IKey);
str(fval,IKey);
end;
dbfNdxTbl[1]^.KeyUpdate(IKey,RNum,RecNum);
end;
END; {PutRec}
{.pa}
{
UNDELETE
╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ The UNDELETE method will reset the Delete flag in the dBase III(+) ║
║ file. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.UnDelete ║
║ ║
║ ( where objectname is of type GS_dBase_DB) ║
║ ║
║ Result: ║
║ ║
║ 1. objectname.DelFlag is set false. ║
║ 2. A ' ' (UnDelete flag) is set in byte 0 of current ║
║ file. ║
║ 3. PutRec is called to write current record to disk. ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝
}
PROCEDURE GS_dBase_DB.UnDelete;
begin
DelFlag := false; {Set Delete flag to false}
CurRecord^[0] := GS_dBase_UnDltChr;
{Put ' ' in first byte of current record}
PutRec(RecNumber); {Write the current record to disk }
end;
{ Free buffer memory}
PROCEDURE GS_dBase_DB.UnInit;
begin
Close;
FreeMem(FieldsN, NumFields*12); {DeAllocate memory for fields list.}
FreeMem(CurRecord, RecLen); {DeAllocate memory for record buffer}
FreeMem(Fields, HeadLen-33); {DAllocate memory for fields buffer.}
end;
begin
if IndexSignature = 'NDX3' then IsDB3NDX := true else IsDB3NDX := false;
end.
