unit GSOBShel;
{-----------------------------------------------------------------------------
dBase III/IV File Handler
GSOBSHEL Copyright (c) Richaard F. Griffin
29 January 1993
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit provides access to Griffin Solutions dBase Objects
using high-level procedures and functions that make Object
Oriented Programming transparent to the user. It provides a
selection of commands similar to the dBase format.
Changes:
19 Apr 93 - Procedure Go() modified to position the master index
file (if one is open) at the correct index entry for
the physical record that is read. This ensures that
indexed sequential reads are in sync after a physical
record access.
02 May 93 - Routines used for conversion to/from numbers have been
modified to be of type FloatNum. This allows numbers to
have up to 20 significant digits. Note that the $N+ and
$E+ switches must be set (Alt O,C,8,E in IDE) to compile
using this feature. Otherwise, 11-12 digits will be used.
The use of the $N+,E+ switch adds 10K to program size.
When you compile a program in the $N+,E+ state, the
compiler links with the full 80x87 emulator. The resulting
.EXE file can be run on any machine, regardless of whether
that machine has an 80x87. If an 80x87 is present, the
program will use it; otherwise, the run-time library
emulates it. This gives you access to four additional
real types: Single, Double, Extended, and Comp. The $E+
directive will emulate the 80x87. This gives you access
to the IEEE floating-point types without requiring that you
install an 80x87 chip.
03 Jun 93 - Fixed CloseDataBases to release the objects by using Dispose
and the Done destructor instead of only Close.
21 Jun 93 - Increased speed of index access in the Go procedure by
getting the formula and Finding the index record rather
than using the sequential search for a matching record
through KeyLocRec.
24 Jul 93 - Modified Find to call object^.FindNear. Now, the file
will be positioned at the record with the next greater
key if no match and the search did not go to end of file.
The programmer can call Found to see if there was a match,
and dEOF to see if the file is positioned at the end of
file (true), or at the next greater key (false).
25 Jul 93 - Improved the speed of setting indexes in the Select
method. Replaced routine to do a sequential search for the
index key with record number matching the current number.
New routine Finds matching record key and then confirms the
record number matches. Provides significant reduction in
time required.
28 Jul 93 - Added the following call to allow user formula expression
processing for indexes:
Procedure SetFormulaProcess(UserRoutine1 : FormulaProc;
UserRoutine2: XtractFunc);
Assigns two user-supplied routines to process formulas to
be built and used by index files. This call replaces the
default DefFormulaBuild and DefFormulaXtract with the
programmer's own routine via a call to SetFormulaProcess.
The Formula routine in HALCYON only handles straight field
names. However, the SetFormulaProcess allows a user-
supplied routine to be called anytime a formula is needed
for an index action from anywhere within the ancestor
object(s).
Two routines must be provided. UserRoutine1 is a routine
that parses the expression and translates into paramaters
are understood by UserRoutine2. UserRoutine2 is called
everytime a index key is to be extracted from a record.
In this example, substrings of the first five positions
of the LASTNAME and FIRSTNAME fields are combined in a
string that is then returned as the formula's result.
The IndexOn command must contain the correct formula;
for example:
IndexOn('DEMOFRM2',
'SUBSTR(LASTNAME,1,5)+SUBSTR(FIRSTNAME,1,5)');
so it will be stored properly in the index header for use
by other programs such as dBase, FoxPro, Clipper, etc.
($F+)
Function UFormula(st:string;var fmrec:GSR_FormRec): boolean;
var FldCnt : integer;
begin
if (fmrec.FAlias = 'TESTFRM2') then (Correct Index?)
begin (set extract table)
UFormula := true;
for FldCnt := 0 to 32 do fmrec.FPosn[FldCnt] := 0;
fmrec.FType := 'C'; (Character key)
fmrec.FDcml := 0;
fmrec.FSize := 10; (5 chars from LASTNAME & FIRSTNAME)
end
else UFormula := true;
end;
Function UFormXtract(var st:string;fmrec:GSR_FormRec):boolean;
begin
if (fmrec.FAlias = 'TESTFRM2') then (Correct index?)
begin
UFormXtract := true;
st := SubStr(FieldGet('LASTNAME'),1,5) +
SubStr(FieldGet('FIRSTNAME'),1,5);
end
else UFormXtract := false;
end;
($F-)
.
.
.
Select(1);
Use('GSDMO_01');
SetFormulaProcess(UFormula, UFormXtract);
.
.
To return to the default, simply use:
SetFormulaProcess(DefFormulaBuild, DefFormulaXtract);
Note that the assigned procedure must use far calls ($F+).
Also note that SetFormulaProcess should not be called until
a file has been assigned to the selected file area through
Use. If no file has been assigned, Error 1008, Object is
not initialized in file area, will halt the program.
See TESTFRM1.PAS and TESTFRM2.PAS for demonstrations of
this function.
02 Aug 93 - Fixed problem in the Use command that did not clear the
Object pointer when the used file changed. This was no
problem except when the area was cleared (Use('')), and
then Use'd again. Since the object pointer in the table
was invalid, an error occured.
------------------------------------------------------------------------------}
interface
uses
GSOB_Var,
GSOB_Str,
GSOB_DBF,
GSOB_DBS,
GSOB_Dsk,
GSOB_Dte,
{$IFDEF WINDOWS}
WinDos,
Strings;
{$ELSE}
Dos;
{$ENDIF}
type
CaptureError = Procedure(Code, Info: Integer);
CaptureStatus = Procedure(stat1,stat2,stat3 : longint);
FilterCheck = Function: boolean;
FormulaProc = Function(st: string; var fmrec : GSR_FormRec): boolean;
XtractFunc = Function(var st: string; fmrec: GSR_FormRec): boolean;
pDBFObject = ^DBFObject;
DBFObject = object(GSO_dBHandler)
DBFAlias : string[10];
DBFFilter : FilterCheck;
DBFFormula : FormulaProc;
DBFXtract : XtractFunc;
constructor Init(FName : string);
Procedure Error(Code, Info: Integer); virtual;
Procedure Formula(st : string; var fmrec : GSR_FormRec); virtual;
Function FormXtract(fmrec : GSR_FormRec) : string; virtual;
Procedure StatusUpdate(stat1,stat2,stat3 : longint); virtual;
Function TestFilter : boolean; virtual;
end;
var
CapError : CaptureError;
CapStatus : CaptureStatus;
DBFActive : pDBFObject;
DBFUsed : integer;
DBFAreas : array[0..40] of pDBFObject;
LastError : integer;
Function Alias : string;
Function ALock : boolean;
Procedure Append;
Procedure ClearRecord;
Procedure CloseDataBases;
Procedure CopyStructure(filname : string);
Procedure CopyTo(filname : string);
Function CurrentArea : byte;
Function Date: longint;
Function DBF : string;
Function DBFError : integer;
Function dBOF : boolean;
Function Deleted : boolean;
Procedure DeleteRec;
Function dEOF : boolean;
Function Field(n : byte) : string;
Function FieldCount : byte;
Function FieldDec(n : byte) : byte;
Function FieldLen(n : byte) : byte;
Function FieldNo(fn : string) : byte;
Function FieldType(n : byte) : char;
Function FileExist(FName : string) : boolean;
Procedure Find(ss : string);
Function FLock : boolean;
Procedure FlushDBF;
Function Found : boolean;
Procedure Go(n : longint);
Procedure GoBottom;
Procedure GoTop;
Procedure Index(INames : string);
Procedure IndexOn(filname, formla : string);
Function LUpdate: string;
Procedure Pack;
Procedure RecallRec;
Function RecCount : longint;
Function RecNo : longint;
Function RecSize : word;
Procedure Reindex;
Procedure Replace;
Function RLock : boolean;
Procedure Select(Obj : byte);
Procedure SetCenturyOff;
Procedure SetCenturyOn;
Procedure SetDateStyle(dt : DateTypes);
Procedure SetDBFCacheOff;
Procedure SetDBFCacheOn;
Procedure SetDeletedOff;
Procedure SetDeletedOn;
Procedure SetErrorCapture(UserRoutine : CaptureError);
Procedure SetExactOff;
Procedure SetExactOn;
Procedure SetExclusiveOff;
Procedure SetExclusiveOn;
Procedure SetFileHandles(hndls : byte);
Procedure SetFilterThru(UserRoutine : FilterCheck);
Procedure SetFlushOff;
Procedure SetFlushOnAppend;
Procedure SetFlushOnWrite;
Procedure SetFormulaProcess(UserRoutine1 : FormulaProc;
UserRoutine2: XtractFunc);
Procedure SetLockOff;
Procedure SetLockOn;
Procedure SetOrderTo(order : integer);
Procedure SetStatusCapture(UserRoutine : CaptureStatus);
Procedure Skip(n : longint);
Procedure SortTo(filname, formla: string; sortseq: SortStatus);
Procedure Unlock;
Procedure UnlockAll;
Procedure Use(FName : string);
Procedure Zap;
{dBase field handling routines}
Procedure AssignMemo(st, nm : string);
Procedure SaveMemo(st, nm : string);
Procedure MemoClear;
function MemoGetLine(linenum : integer) : string;
Procedure MemoInsLine(linenum : integer; st : string);
procedure MemoGet(st : string);
procedure MemoGetN(n : integer);
Procedure MemoWidth(l : integer);
function MemoLines : integer;
procedure MemoPut(st : string);
procedure MemoPutN(n : integer);
Function DateGet(st : string) : longint;
Function DateGetN(n : integer) : longint;
Procedure DatePut(st : string; jdte : longint);
Procedure DatePutN(n : integer; jdte : longint);
Function FieldGet(fnam : string) : string;
Function FieldGetN(fnum : integer) : string;
Procedure FieldPut(fnam, st : string);
Procedure FieldPutN(fnum : integer; st : string);
Function LogicGet(st : string) : boolean;
Function LogicGetN(n : integer) : boolean;
Procedure LogicPut(st : string; b : boolean);
Procedure LogicPutN(n : integer; b : boolean);
Function NumberGet(st : string) : FloatNum;
Function NumberGetN(n : integer) : FloatNum;
Procedure NumberPut(st : string; r : FloatNum);
Procedure NumberPutN(n : integer; r : FloatNum);
Function StringGet(fnam : string) : string;
Function StringGetN(fnum : integer) : string;
Procedure StringPut(fnam, st : string);
Procedure StringPutN(fnum : integer; st : string);
{dBase type functions}
function CTOD(strn : string) : longint;
function DTOC(jul : longint) : string;
function DTOS(jul : longint) : string;
{Default capture procedures}
Procedure DefCapError(Code, Info : integer);
Procedure DefCapStatus(stat1,stat2,stat3 : longint);
Function DefFilterCk: boolean;
Function DefFormulaBuild(st: string; var fmrec: GSR_FormRec): boolean;
Function DefFormulaXtract(var st: string; fmrec: GSR_FormRec): boolean;
implementation
{-----------------------------------------------------------------------------
Data Capture Procedures
------------------------------------------------------------------------------}
Constructor DBFObject.Init(FName : string);
begin
GSO_dBHandler.Init(FName);
DBFFilter := DefFilterCk;
DBFFormula := DefFormulaBuild;
DBFXtract := DefFormulaXtract;
end;
Procedure DBFObject.Error(Code, Info : integer);
begin
CapError(Code, Info);
end;
Procedure DBFObject.Formula(st : string; var fmrec : GSR_FormRec);
begin
if not DBFFormula(st, fmrec) then GSO_dBHandler.Formula(st, fmrec);
end;
Function DBFObject.FormXtract(fmrec : GSR_FormRec) : string;
var
st : string;
begin
if DBFXtract(st, fmrec) then FormXtract := st
else FormXtract := GSO_dBHandler.FormXtract(fmrec);
end;
Procedure DBFObject.StatusUpdate(stat1,stat2,stat3 : longint);
begin
CapStatus(stat1,stat2,stat3);
end;
Function DBFObject.TestFilter : boolean;
begin
if DBFFilter then
TestFilter := GSO_dBHandler.TestFilter
else
TestFilter := false;
end;
{Default capture routines}
{$F+}
Procedure DefCapError(Code, Info : integer);
begin
RunError(Code);
end;
Procedure DefCapStatus(stat1,stat2,stat3 : longint);
begin
end;
Function DefFilterCk: boolean;
begin
DefFilterCk := true;
end;
Function DefFormulaBuild(st: string; var fmrec : GSR_FormRec): boolean;
begin
DefFormulaBuild := false;
end;
Function DefFormulaXtract(var st: string; fmrec: GSR_FormRec): boolean;
begin
DefFormulaXtract := false;
end;
{$F-}
{-----------------------------------------------------------------------------
High-Level Procedures/Functions
------------------------------------------------------------------------------}
Procedure ConfirmUsedArea;
begin
if DBFActive = nil then RunError(gsAreaIsNotInUse);
end;
Function Alias : string;
begin
if DBFActive <> nil then
Alias := DBFActive^.DBFAlias
else Alias := '';
end;
Function ALock : boolean;
begin
ConfirmUsedArea;
ALock := DBFActive^.LokApnd;
end;
Procedure Append;
begin
ConfirmUsedArea;
DBFActive^.Append;
end;
Procedure ClearRecord;
begin
ConfirmUsedArea;
DBFActive^.Blank;
end;
Procedure CloseDatabases;
var i : integer;
begin
for i := 1 to 40 do
if DBFAreas[i] <> nil then
begin
Dispose(DBFAreas[i], Done);
DBFAreas[i] := nil;
end;
end;
Procedure CopyStructure(filname : string);
begin
ConfirmUsedArea;
DBFActive^.CopyStructure(filname);
end;
Procedure CopyTo(filname : string);
begin
ConfirmUsedArea;
DBFActive^.CopyFile(filname);
end;
function CTOD(strn : string) : longint;
var
v : longint;
begin
v := GS_Date_Juln(strn);
if v > 0 then CTOD := v else CTOD := 0;
end;
Function CurrentArea : byte;
begin
CurrentArea := DBFUsed;
end;
Function Date: longint;
begin
Date := GS_Date_Curr;
end;
{$IFDEF WINDOWS}
Function DBF : string;
var
ExpFile : PChar;
begin
if DBFActive = nil then DBF := ''
else
begin
GetMem(ExpFile, 80);
StrPCopy(ExpFile, DBFActive^.dfFileName);
FileExpand(ExpFile, ExpFile);
DBF := ExpFile^;
FreeMem(ExpFile, 80);
end;
end;
{$ELSE}
Function DBF : string;
begin
if DBFActive = nil then DBF := ''
else DBF := FExpand(DBFActive^.dfFileName);
end;
{$ENDIF}
Function DBFError : integer;
begin
ConfirmUsedArea;
DBFError := LastError;
LastError := 0;
end;
Function dBOF : boolean;
begin
ConfirmUsedArea;
dBOF := DBFActive^.File_TOF;
end;
Function Deleted : boolean;
begin
ConfirmUsedArea;
Deleted := DBFActive^.DelFlag;
end;
Procedure DeleteRec;
begin
ConfirmUsedArea;
DBFActive^.Delete;
end;
Function dEOF : boolean;
begin
ConfirmUsedArea;
dEOF := DBFActive^.File_EOF;
end;
function DTOC(jul : longint) : string;
begin
DTOC := GS_Date_View(jul);
end;
function DTOS(jul : longint) : string;
begin
DTOS := GS_Date_DBStor(jul);
end;
Function Field(n : byte) : string;
var
st : string;
begin
ConfirmUsedArea;
st := DBFActive^.FieldName(n);
if st = '' then LastError := 220 else LastError := 0;
Field := st;
end;
Function FieldCount : byte;
begin
ConfirmUsedArea;
FieldCount := DBFActive^.NumFields;
end;
Function FieldDec(n : byte) : byte;
begin
ConfirmUsedArea;
FieldDec := DBFActive^.FieldDecimals(n);
end;
Function FieldLen(n : byte) : byte;
begin
ConfirmUsedArea;
FieldLen := DBFActive^.FieldLength(n);
end;
Function FieldNo(fn : string) : byte;
var
mtch : boolean;
i,
ix : integer;
za : string[16];
begin
ConfirmUsedArea;
fn := TrimR(AllCaps(fn));
ix := DBFActive^.NumFields;
i := 1;
mtch := false;
while (i <= ix) and not mtch do
begin
CnvAscToStr(DBFActive^.Fields^[i].FieldName,za,11);
if za = fn then mtch := true else inc(i);
end;
if mtch then FieldNo := i else FieldNo := 0;
end;
Function FieldType(n : byte) : char;
begin
ConfirmUsedArea;
FieldType := DBFActive^.FieldType(n);
end;
Function FileExist(FName : string): boolean;
begin
FileExist := GS_FileExists(FName);
end;
Procedure Find(ss : string);
var b : boolean;
begin
ConfirmUsedArea;
b := DBFActive^.FindNear(ss);
end;
Function FLock : boolean;
begin
ConfirmUsedArea;
FLock := DBFActive^.LokFile;
end;
Procedure FlushDBF;
begin
ConfirmUsedArea;
DBFActive^.Flush;
end;
Function Found : boolean;
begin
ConfirmUsedArea;
Found := DBFActive^.Found;
end;
Procedure Go(n : longint);
var
b : longint;
s : string;
begin
ConfirmUsedArea;
if (n < 1) or (n > DBFActive^.NumRecs) then exit;
DBFActive^.GetRec(n);
if DBFActive^.IndexMaster <> nil then
begin
s := DBFActive^.FormXtract(DBFActive^.IndexMaster^.FormRec);
b := DBFActive^.IndexMaster^.KeyFind(s);
while (b <> n) and (b <> 0) do
b := DBFActive^.IndexMaster^.KeyRead(Next_Record);
end;
end;
Procedure GoBottom;
begin
ConfirmUsedArea;
DBFActive^.GetRec(Bttm_Record);
end;
Procedure GoTop;
begin
ConfirmUsedArea;
DBFActive^.GetRec(Top_Record);
end;
Procedure Index(INames : string);
begin
ConfirmUsedArea;
if INames <> '' then SetDBFCacheOff;
DBFActive^.Index(INames);
end;
Procedure IndexOn(filname, formla: string);
var order : integer;
begin
ConfirmUsedArea;
SetDBFCacheOff;
order := DBFActive^.IndexTo(filname, formla);
end;
Function LUpdate: string;
var
yy, mm, dd : word;
hh, mn, ss : word;
fd : longint;
begin
if DBFActive = nil then LUpdate := ''
else
begin
GS_FileDateTime(DBFActive^.dfFiletype,yy,mm,dd,hh,mn,ss);
fd := GS_Date_MDY2Jul(mm,dd,yy);
LUpdate := GS_Date_View(fd);
end;
end;
Procedure Pack;
begin
ConfirmUsedArea;
DBFActive^.Pack;
end;
Procedure RecallRec;
begin
ConfirmUsedArea;
DBFActive^.Undelete;
end;
Function RecCount : longint;
begin
ConfirmUsedArea;
RecCount := DBFActive^.RecsInFile;
end;
Function RecNo : longint;
begin
ConfirmUsedArea;
RecNo := DBFActive^.RecNumber;
end;
Function RecSize : word;
begin
ConfirmUsedArea;
RecSize := DBFActive^.RecLen;
end;
Procedure Reindex;
begin
ConfirmUsedArea;
DBFActive^.Reindex;
end;
Procedure Replace;
begin
ConfirmUsedArea;
DBFActive^.Replace;
end;
Function RLock : boolean;
begin
ConfirmUsedArea;
RLock := DBFActive^.LokRcrd;
end;
Procedure Select(Obj : byte);
var
b : longint;
s : string;
begin
if (Obj < 1) or (Obj > 40) then exit;
DBFUsed := Obj;
DBFActive := DBFAreas[Obj];
if DBFActive <> nil then
if DBFActive^.IndexMaster <> nil then
if DBFActive^.RecNumber = 0 then GoTop
else
begin
s := DBFActive^.FormXtract(DBFActive^.IndexMaster^.FormRec);
b := DBFActive^.IndexMaster^.KeyFind(s);
while (b <> DBFActive^.RecNumber) and (b <> 0) do
b := DBFActive^.IndexMaster^.KeyRead(Next_Record);
end;
end;
Procedure SetCenturyOff;
begin
SetCentury(Off);
end;
Procedure SetCenturyOn;
begin
SetCentury(On);
end;
Procedure SetDateStyle(dt : DateTypes);
begin
GS_Date_Type := DateCountry(dt);
end;
Procedure SetDBFCacheOff;
begin
ConfirmUsedArea;
DBFActive^.SetDBFCache(Off);
end;
Procedure SetDBFCacheOn;
begin
ConfirmUsedArea;
if DBFActive^.IndexMaster <> nil then exit;
DBFActive^.SetDBFCache(On);
end;
Procedure SetDeletedOff;
begin
SetDeleted(Off);
end;
Procedure SetDeletedOn;
begin
SetDeleted(On);
end;
Procedure SetErrorCapture(UserRoutine : CaptureError);
begin
CapError := UserRoutine;
end;
Procedure SetExactOff;
begin
SetExact(Off);
end;
Procedure SetExactOn;
begin
SetExact(On);
end;
Procedure SetExclusiveOff;
begin
GS_SetExclusive(Off);
end;
Procedure SetExclusiveOn;
begin
GS_SetExclusive(On);
end;
Procedure SetFileHandles(hndls : byte);
var
b : boolean;
begin
b := GS_ExtendHandles(hndls);
end;
Procedure SetFilterThru(UserRoutine : FilterCheck);
begin
ConfirmUsedArea;
DBFActive^.DBFFilter := UserRoutine;
end;
Procedure SetFlushOff;
begin
ConfirmUsedArea;
DBFActive^.dfFileFlsh := NeverFlush;
end;
Procedure SetFlushOnAppend;
begin
ConfirmUsedArea;
DBFActive^.dfFileFlsh := AppendFlush;
end;
Procedure SetFlushOnWrite;
begin
ConfirmUsedArea;
DBFActive^.dfFileFlsh := WriteFlush;
end;
Procedure SetFormulaProcess(UserRoutine1 : FormulaProc;
UserRoutine2: XtractFunc);
begin
DBFActive^.DBFFormula := UserRoutine1;
DBFActive^.DBFXtract := UserRoutine2;
end;
Procedure SetLockOff;
var i : integer;
begin
GS_ShareAuto(Off);
end;
Procedure SetLockOn;
begin
GS_ShareAuto(On);
end;
Procedure SetOrderTo(order : integer);
var b : boolean;
begin
ConfirmUsedArea;
b := DBFActive^.IndexOrder(order);
end;
Procedure SetStatusCapture(UserRoutine : CaptureStatus);
begin
CapStatus := UserRoutine;
end;
Procedure Skip(n : longint);
begin
ConfirmUsedArea;
DBFActive^.Skip(n);
end;
Procedure SortTo(filname, formla: string; sortseq : SortStatus);
begin
ConfirmUsedArea;
DBFActive^.SortFile(filname, formla, sortseq);
end;
Procedure Unlock;
var
i : integer;
rsl : word;
begin
ConfirmUsedArea;
DBFActive^.LokOff;
if DBFActive^.WithMemo then rsl := DBFActive^.MemoFile^.Unlock;
for i := 1 to IndexesAvail do
if DBFActive^.IndexStack[i] <> nil then
rsl := DBFActive^.IndexStack[i]^.Unlock;
end;
Procedure UnlockAll;
var i : integer;
begin
for i := 1 to 40 do
if DBFAreas[i] <> nil then
while DBFAreas[i]^.dfLockRec do DBFAreas[i]^.LokOff;
GS_ClearLocks;
end;
Procedure Use(FName : string);
var i,j : integer;
begin
if DBFActive <> nil then dispose(DBFActive, Done);
DBFActive := nil;
DBFAreas[DBFUsed] := DBFActive;
if FName = '' then exit;
DBFActive := New(pDBFObject, Init(FName));
DBFActive^.Open;
DBFAreas[DBFUsed] := DBFActive;
FName := AllCaps(TrimR(FName));
i := length(FName);
j := i;
while (i > 0) and not (FName[i] in ['\',':']) do dec(i);
DBFActive^.DBFAlias := copy(FName,i+1,(j-i));
end;
Procedure Zap;
begin
ConfirmUsedArea;
DBFActive^.Zap;
end;
{------------------------------------------------------------------------------
Field Access Routines
------------------------------------------------------------------------------}
Procedure AssignMemo(st, nm : string);
var
i,
ml : integer;
Txfile : Text;
begin
Assign(TxFile,nm);
Rewrite(TxFile);
DBFActive^.MemoGet(st);
ml := DBFActive^.MemoLines;
if ml <> 0 then
for i := 1 to ml do
Writeln(TxFile,DBFActive^.MemoGetLine(i));
Close(TxFile);
end;
procedure SaveMemo(st, nm : string);
var
i : integer;
s : string;
m1,
m2 : string[10];
Txfile : Text;
begin
m1 := DBFActive^.FieldGet(st);
DBFActive^.MemoClear;
Assign(TxFile,nm);
Reset(TxFile);
while not EOF(TxFile) do
begin
Readln(TxFile,s);
DBFActive^.MemoInsLine(-1,s);
end;
Close(TxFile);
DBFActive^.MemoPut(st);
m2 := DBFActive^.FieldGet(st);
{If the memo field number has changed, save the DBF record}
if m1 <> m2 then DBFActive^.PutRec(DBFActive^.RecNumber);
end;
Procedure MemoClear;
begin
DBFActive^.MemoClear;
end;
function MemoGetLine(linenum : integer) : string;
begin
MemoGetLine := DBFActive^.MemoGetLine(linenum);
end;
Procedure MemoInsLine(linenum : integer; st : string);
begin
DBFActive^.MemoInsLine(linenum, st);
end;
procedure MemoGet(st : string);
begin
DBFActive^.MemoGet(st);
end;
procedure MemoGetN(n : integer);
begin
DBFActive^.MemoGetN(n);
end;
Procedure MemoWidth(l : integer);
begin
DBFActive^.MemoWidth(l);
end;
function MemoLines : integer;
begin
MemoLines := DBFActive^.Memolines;
end;
procedure MemoPut(st : string);
begin
DBFActive^.MemoPut(st);
end;
procedure MemoPutN(n : integer);
begin
DBFActive^.MemoPutN(n);
end;
Function DateGet(st : string) : longint;
begin
DateGet := DBFActive^.DateGet(st);
end;
Function DateGetN(n : integer) : longint;
begin
DateGetN := DBFActive^.DateGetN(n);
end;
Procedure DatePut(st : string; jdte : longint);
begin
DBFActive^.DatePut(st, jdte);
end;
Procedure DatePutN(n : integer; jdte : longint);
begin
DBFActive^.DatePutN(n, jdte);
end;
Function FieldGet(fnam : string) : string;
begin
FieldGet := DBFActive^.FieldGet(fnam);
end<
