Power-Programmierung/CD1.mdf/pascal/library/dos/database/gsdb28/gs_makmo.pas

Pascal/Delphi Source File | 1992-02-24 | 5.3 KB | 179 lines

unit GS_MakMo;
{------------------------------------------------------------------------------
                            DBase Memo File Builder

       Copyright (c)  Richard F. Griffin

       20 February 1992

       102 Molded Stone Pl
       Warner Robins, GA  31088

       -------------------------------------------------------------
       This unit creates a test dBase memo record.

       This unit consists of the unit GS_MakeMemo.  This will initialize
       a work buffer, find the next available memo file block, store items
       in an assigned memory buffer, and write the memo to the memo file
       upon command.

       The object is initialized as follows:

          Init(m, siz);

          where:
                  m     = dbase file object pointer of type GSP_dBFld_Objt.
                          this must be assigned by the calling program.
                          Init assuumes there was a memo field in the
                          .DBF file the calling program initialized.  If
                          a memo field is not in the dBase file, strange
                          things will happen.

                  siz   = Size of memory buffer to assign.  Must be greater
                          than the maximum memo field to be created.

       The memo filed is initialized as follows:

          ResetMemoData

                           This resets the buffer to a zero contents count
                           and fills the buffer with zeros.

       The memo data is added as follows:

          InsertMemoData(st);

          where:
                  st    = string to be stored in the buffer.  If a CR/LF is
                          desired, they must be added by the caller.  For
                          example: st := st+#13#10.

       The memo data is written to the file as follows:

          st := WriteMemoRecord;

          where:
                  st    = string will contain the memo block number in the
                          format for storage in the dBase.DBF memo field.
                          Typically, this function would be called as:

                          FieldPut(memofield, memoobject.WriteMemoRecord);

-------------------------------------------------------------------------------}

interface
{$D-}

uses
   CRT,
   DOS,
   GS_Strng,
   GS_dBase,
   GS_FileH,
   GS_dBFld;

type
   MemoBlockPntr = ^MemoBlockArry;
   MemoBlockArry = array[0..MaxInt] of byte;

   GS_MakeMemoP = ^GS_MakeMemo;
   GS_MakeMemo = object
      mCnt,
      tcnt  :  longint;              {Counter for input buffer char position}
      Result  : word;                {BlockWrite number of bytes written}
      Mem_Block : MemoBlockPntr;
      Memo_Loc  : longint;
      Memo_Size : integer;
      ml  : GSP_dBFld_Objt;
      fli : text;
      constructor Init(m : GSP_dBFld_Objt; siz : integer);
      destructor Done;
      procedure InsertMemoData(st : string);
      procedure ResetMemoData;
      function WriteMemoRecord : string;
   end;
implementation
const
   EOFMark : byte = $1A;              {End of disk file code}

var
   valu  : string[10];                {work string to convert block number}
   n,
   s,
   w   : string;
   r   : longint;
   i   : integer;
   d   : integer;

constructor GS_MakeMemo.Init(m : GSP_dBFld_Objt; siz : integer);
BEGIN
   ml := m;
   Memo_Size := siz;
   GetMem(Mem_Block, Memo_Size);
   GS_FileRead(ml^.mFile, 0, Mem_Block^, 1, Result);
                                      {read a block from the .DBT}
   Move(Mem_Block^[0],Memo_Loc,4);     {Get next block number to append}
   tcnt := Memo_Loc;
   mcnt := 0;
   FillChar(Mem_Block^,Memo_Size,#0);
end;

destructor GS_MakeMemo.Done;
begin
   if Mem_Block <> nil then FreeMem(Mem_Block, Memo_Size);
   Mem_Block := nil;
end;

procedure GS_MakeMemo.InsertMemoData(st : string);
begin
   move(st[1],Mem_Block^[mCnt],length(st));
   mCnt := mCnt + length(st);
end;

procedure GS_MakeMemo.ResetMemoData;
BEGIN
   GS_FileRead(ml^.mFile, 0, Mem_Block^, 1, Result);
                                      {read a block from the .DBT}
   Move(Mem_Block^[0],Memo_Loc,4);     {Get next block number to append}
   tcnt := Memo_Loc;
   mcnt := 0;
   FillChar(Mem_Block^,Memo_Size,#0);
end;


function GS_MakeMemo.WriteMemoRecord : string;
var
   loc : integer;
   li  : longint;
begin
   if mCnt = 0 then
   begin
      WriteMemoRecord := '          ';
      exit;
   end;
   Mem_Block^[mCnt] := EOFMark;
   inc(mCnt);
   loc := 0;
   while (mCnt > GS_dBase_MaxMemoRec) do
   begin
      GS_FileWrite(ml^.mFile,tcnt,Mem_Block^[loc],1, Result);
                                                 {write a block to the .DBT}
      inc(tcnt);
      loc := loc + GS_dBase_MaxMemoRec;
      mCnt := mCnt - GS_dBase_MaxMemoRec;
   end;
   GS_FileWrite(ml^.mFile,tcnt,Mem_Block^[loc],1, Result);
                                      {Write the last block to the .DBT}
   FillChar(Mem_Block^,GS_dBase_MaxMemoRec,#0);
   li := GS_FileSize(ml^.mFile);
   Move(li,Mem_Block^[0],4);
   GS_FileWrite(ml^.mFile,0,Mem_Block^,1, Result);
                                      {Write the block to the .DBT.  It will}
                                      {point to the next available block};
   str(Memo_Loc:10,valu);
   WriteMemoRecord := valu;
end;

end.