io Programmo 23/IOPROG_23.ISO/SOFT/MEMTABLE.ZIP/kbmMemTable.pas

Pascal/Delphi Source File | 1999-02-04 | 29.1 KB | 1,027 lines

unit kbmMemTable;

// TKbmMemTable v. 1.04
// =========================================================================
// An inmemory temporary table.
// Can be used as a demonstration of how to create descendents of TDataSet,
// or as in my case, to allow a program to generate temporary data that can
// be used directly by all data aware controls.
//
// Copyright 1999 Kim Bo Madsen/Optical Services - Scandinavia
// All rights reserved.
//
// You are allowed to used this component in any project for free.
// You are NOT allowed to claim that you have created this component or to
// copy its code into your own component and claim that is was your idea.
// Im offering this for free for your convinience, and the ONLY thing I request
// is to get an e-mail about what project this component (or dirived versions)
// is used for. That will be my reward of offering this component for free to you!
//
// You dont need to state my name in your software, although it would be
// appreciated if you do.
//
// If you find bugs or alter the component (f.ex. see suggested enhancements
// further down), please DONT just send the corrected/new code out on the internet,
// but instead send it to me, so I can put it into the official version. You will
// be acredited if you do so.
//
//
// DISCLAIMER
// By using this component or parts theiroff you are accepting the full
// responsibility of the use. You are understanding that the author cant be
// made responsible in any way for any problems occuring using this component.
// You also recognize the author as the creator of this component and agrees
// not to claim otherwize!
//
// Please forward corrected versions (source code ONLY!), comments,
// and emails saying you are using it for this or that project to:
//            [e-mail]
//
// Suggestions for future enhancements:
//
//      - Index handling functions.
//      - Sorting.
//      - Support for SetKey, FindKey, FindNearest
//      - Support for MasterField, Lookupfields.
//      - IDE designer for adding static data to the memtable.
//
// History:
//
//1.00:    The first release. Was created due to a need for a component like this.
//                                                                    (15. Jan. 99)
//1.01:    The first update. Release 1.00 contained some bugs related to the ordering
//    of records inserted and to bookmarks. Problems fixed.         (21. Jan. 99)

//1.02:    Fixed handling of NULL values. Added SaveToStream, SaveToFile,
//    LoadFromStream and LoadFromFile. SaveToStream and SaveToFile is controlled
//    by a flag telling if to save data, contents of calculated fields,
//    contents of lookupfields and contents of non visible fields.
//    Added an example application with Delphi 3 source code.       (26. Jan. 99)
//
//1.03: Claude Rieth from Computer Team sarl ([e-mail]) came up with an
//      implementation of CommaText and made a validation check in _InternalInsert.
//      Because I allready have implemented the saveto.... functions, I decided
//      to implement Claude's idea using my own saveto.... functions. (27. Jan. 99)
//      I have decided to rename the component, because Claude let me know that
//      the RX library have a component with the same name as this.
//      Thus in the future the component will be named TkbmMemTable.
//      SaveToStream and LoadFromStream now set up date and decimal separator
//      temporary to make sure that the data saved can be loaded on another
//      installation with different date and decimal separator setups.
//      Added EmptyTable method to clear the contents of the memory table.
//
//1.04: Wagner ADP ([e-mail]) found a bug in the _internalinsert
//      procedure which he came up with a fix for.                     (4. Feb. 99)
//      Added support for the TDataset protected function findrecord.
//      Added support for CreateTable, DeleteTable.
//=============================================================================

{$ifndef VER100} // CBuilder only
{$ObjExportAll On}
{$ASSERTIONS ON}
{$endif}

interface

uses SysUtils,Classes,Db;

type
    EMemTableError = class(Exception);

    TRecInfo=record
        Bookmark: longint;
        RecordNo: integer;
        BookmarkFlag: TBookmarkFlag;
    end;
    PRecInfo=^TRecInfo;

{
Internal buffer layout:
+------------------------+------------------------+---------------------------+
|     RECORD DATA        |    Rec.Information     |     Calculated Fields     |
| Record length bytes    |  SizeOf(TRecInfo) bytes|    CalcFieldSize bytes    |
+------------------------+------------------------+---------------------------+
                         ^                        ^
                    StartRecInfo              StartCalculated
}

  TkbmMemTableSaveFlag = (mtfSaveData, mtfSaveCalculated, mtfSaveLookup,mtfSaveNonVisible);
  TkbmMemTableSaveFlags = set of TkbmMemTableSaveFlag;

  TkbmMemTable = class(TDataSet)
  private
        FIsOpen:                                Boolean;
        FRecNo:                                 integer;
        FFilterBuffer:                          PChar;
        FRecords:                               TList;
        FBufferSize,
        FStartRecInfo,
        FStartCalculated:integer;
        FRecordSize:                            integer;
        FFieldOfs:                              array [0..255] of integer;
        FReadOnly:                              boolean;
        function GetActiveRecordBuffer:         PChar;
        function FilterRecord(Buffer: PChar):   Boolean;
        procedure _InternalAdd(Buffer:Pointer);
        procedure _InternalDelete(Pos:integer);
        procedure _InternalInsert(Pos:integer; Buffer:Pointer);
        procedure _InternalEmpty;
        procedure _InternalFirst;
        procedure _InternalLast;
        function  _InternalNext:boolean;
        function  _InternalPrior:boolean;
  protected
        procedure InternalOpen; override;
        procedure InternalClose; override;
        procedure InternalFirst;override;
        procedure InternalLast;override;

        procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
        procedure InternalDelete; override;
        procedure InternalInitRecord(Buffer: PChar); override;
        procedure InternalPost; override;

        procedure InternalInitFieldDefs; override;
        procedure InternalSetToRecord(Buffer: PChar); override;

        function IsCursorOpen: Boolean; override;
        function GetCanModify: Boolean; override;
        function GetRecordSize: Word;override;
        function GetRecordCount: integer;override;

        function AllocRecordBuffer: PChar; override;
        procedure FreeRecordBuffer(var Buffer: PChar); override;

        function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
        procedure SetFieldData(Field: TField; Buffer: Pointer);override;

        function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
        function FindRecord(Restart, GoForward: Boolean): Boolean; override;

        function GetRecNo: integer;override;
        procedure SetRecNo(Value: integer);override;

        function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
        procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
        procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
        procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
        procedure InternalGotoBookmark(Bookmark: Pointer); override;

        procedure InternalHandleException; override;

        procedure SetCommaText(AString: String);
        function GetCommaText: String;
  public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure CreateTable;
        procedure DeleteTable;
        procedure LoadFromFile(const FileName: string);
        procedure LoadFromStream(Stream: TStream);
        procedure SaveToFile(const FileName: string; flags:TkbmMemTableSaveFlags);
        procedure SaveToStream(Stream: TStream; flags:TkbmMemTableSaveFlags);
        procedure EmptyTable;
        property CommaText:string read GetCommaText write SetCommaText;
  published
        property Active;
        property Filtered;
        property ReadOnly:boolean read FReadOnly write FReadOnly default false;
        property BeforeOpen;
        property AfterOpen;
        property BeforeClose;
        property AfterClose;
        property BeforeInsert;
        property AfterInsert;
        property BeforeEdit;
        property AfterEdit;
        property BeforePost;
        property AfterPost;
        property BeforeCancel;
        property AfterCancel;
        property BeforeDelete;
        property AfterDelete;
        property BeforeScroll;
        property AfterScroll;
        property OnCalcFields;
        property OnDeleteError;
        property OnEditError;
        property OnFilterRecord;
        property OnNewRecord;
        property OnPostError;
  end;

procedure Register;

implementation

uses
  TypInfo, Dialogs, Windows, Forms, Controls, IniFiles;

constructor TkbmMemTable.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     FRecords:=TList.Create;
end;

destructor TkbmMemTable.Destroy;
begin
     inherited Destroy;

     // Delete allocated records.
     _InternalEmpty;
     FRecords.free;
     FRecords:=nil;
end;

procedure TkbmMemTable.CreateTable;
var
   i:Integer;
begin
     CheckInactive;

     // If no fielddefs existing, use the previously defined fields.
     if FieldDefs.Count = 0 then
        for i:=0 to FieldCount-1 do
            with Fields[i] do
                 if FieldKind = fkData then
                    FieldDefs.Add(FieldName, DataType, Size, Required);

     // Remove previously defined fields and create new from fielddefs.
     DestroyFields;
     CreateFields;
end;

procedure TkbmMemTable.DeleteTable;
begin
     CheckInactive;
     DestroyFields;
end;

procedure TkbmMemTable._InternalAdd(Buffer:Pointer);
begin
     FRecords.Add(Buffer);
end;

procedure TkbmMemTable._InternalInsert(Pos:integer; Buffer:Pointer);
var
   i:integer;
   b:PChar;
begin
     if Pos<0 then Pos:=0;
     if (Pos = FRecords.Count) or(Pos = -1) then
        FRecords.Add(Buffer)
     else
        FRecords.Insert(Pos,Buffer);

     for i:=Pos+1 to FRecords.Count-1 do
     begin
          b:=FRecords.Items[i];
          inc(PRecInfo(b+FStartRecInfo).RecordNo);
     end;
end;

procedure TkbmMemTable._InternalDelete(Pos:integer);
var
   i:integer;
   b:PChar;
begin
     FreeMem(FRecords.Items[Pos]);
     FRecords.Delete(Pos);

     for i:=Pos to FRecords.Count-1 do
     begin
          b:=FRecords.Items[i];
          dec(PRecInfo(b+FStartRecInfo)^.RecordNo);
     end;
end;

// Purge all records.
procedure TkbmMemTable._InternalEmpty;
var
   i:integer;
begin
     for i:=0 to FRecords.Count-1 do FreeMem(FRecords[i]);
     FRecords.Clear;
end;

procedure TkbmMemTable.InternalOpen;
var
   i: integer;
begin
     // Calculate recordsize and field offsets.
     FRecordSize:=0;
     for i:=0 to FieldCount - 1 do
         with TField(Fields[i]) do
              if FieldKind = fkData then
              begin
                   FFieldOfs[i]:=FRecordSize;
                   inc(FRecordSize,DataSize+1); // 1.st byte is boolean flag for Null or not.
              end;

     InternalInitFieldDefs;
     BindFields(True);
     FRecNo:=-1;
     BookmarkSize:=sizeof(longint);
     FStartRecInfo:=FRecordSize;
     FStartCalculated:=FStartRecInfo+SizeOf(TRecInfo);
     FBufferSize:=FRecordSize+Sizeof(TRecInfo)+CalcFieldsSize;
     FIsOpen:=True;
end;

procedure TkbmMemTable.InternalClose;
begin
     _InternalEmpty;
     FIsOpen:=False;
     BindFields(False);
end;

procedure TkbmMemTable.InternalInitFieldDefs;
var
   i:integer;
begin
     FieldDefs.clear;
     for i:=0 to Fieldcount-1 do
     begin
          FieldDefs.Add(Fields[i].FieldName,Fields[i].DataType,Fields[i].Size,Fields[i].Required);
     end;
end;

function TkbmMemTable.GetActiveRecordBuffer:  PChar;
begin
     case State of
          dsBrowse:        if IsEmpty then
                              Result := nil
                           else
                              Result := ActiveBuffer;
          dsCalcFields:    Result := CalcBuffer;
          dsFilter:        Result:=FFilterBuffer;
          dsEdit,dsInsert: Result:=ActiveBuffer;
     else
          Result:=nil;
     end;
end;

// Result is data in the buffer and a boolean return (true=not null, false=is null).
function TkbmMemTable.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
   SourceBuffer: PChar;
begin
     Result:=False;
     SourceBuffer:=GetActiveRecordBuffer;
     if not FIsOpen or (SourceBuffer=nil) then Exit;
     if (Field.FieldKind=fkCalculated) or (Field.FieldKind=fkLookup) then
        Inc(SourceBuffer,FStartCalculated+Field.Offset)
     else
        Inc(SourceBuffer,FFieldOfs[Field.FieldNo-1]);

     if Assigned(Buffer) then Move(SourceBuffer[1], Buffer^, Field.DataSize);
     Result:=boolean(SourceBuffer[0]);
end;

procedure TkbmMemTable.SetFieldData(Field: TField; Buffer: Pointer);
var
   DestinationBuffer: PChar;
begin
     DestinationBuffer:=GetActiveRecordBuffer;

     // Is it a calculated/lookup field or a real datafield?
     if (Field.FieldKind=fkCalculated) or (Field.FieldKind=fkLookup) then
          Inc(DestinationBuffer,FStartCalculated+Field.Offset)
     else
          Inc(DestinationBuffer,FFieldOfs[Field.FieldNo-1]);

    Boolean(DestinationBuffer[0]):=(Buffer<>nil);

    if Assigned(Buffer) then
       Move(Buffer^,DestinationBuffer[1],Field.DataSize);

    DataEvent (deFieldChange, Longint(Field));
end;

function TkbmMemTable.IsCursorOpen: Boolean;
begin
     Result:=FIsOpen;
end;

function TkbmMemTable.GetCanModify: Boolean;
begin
     Result:=not FReadOnly;
end;

function TkbmMemTable.GetRecordSize: Word;
begin
     Result:=FRecordSize;
end;

function TkbmMemTable.AllocRecordBuffer: PChar;
begin
     GetMem(Result,FBufferSize);
     FillChar(Result^,FBufferSize,0);
end;

procedure TkbmMemTable.FreeRecordBuffer(var Buffer: PChar);
begin
     FreeMem(Buffer);
end;

procedure TkbmMemTable.InternalFirst;
begin
     _InternalFirst;
end;

procedure TkbmMemTable.InternalLast;
begin
     _InternalLast;
end;

procedure TkbmMemTable._InternalFirst;
begin
     FRecNo:=-1;
end;

procedure TkbmMemTable._InternalLast;
begin
     FRecNo:=FRecords.Count;
end;

function TkbmMemTable._InternalNext:boolean;
begin
     if FrecNo<FRecords.Count-1 then
     begin
          Inc(FRecNo);
          Result:=true;
     end
     else Result:=false;
end;

function TkbmMemTable._InternalPrior:boolean;
begin
     if FrecNo>0 then
     begin
          Dec(FRecNo);
          Result:=true;
     end
     else Result:=false;
end;

function TkbmMemTable.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
   Acceptable: Boolean;
begin
     Result:=grOK;
     Acceptable:=False;
     repeat
         begin
              case GetMode of
                   gmCurrent: begin
                                   if FRecNo>=FRecords.Count then Result:=grEOF
                                   else if FRecNo<0 then Result:=grBOF
                                   else Result:=grOk;
                              end;
                   gmNext:    begin
                                   if _InternalNext then Result:=grOK
                                   else Result:=grEOF;
                              end;
                   gmPrior:   begin
                                   if _InternalPrior then Result:=grOK
                                   else Result:=grBOF;
                              end;
              end;
              if Result=grOk then
              begin
                      //fill TARrecord part of buffer
                      Move(FRecords.Items[FRecNo]^,Buffer^,FBufferSize);

                      //fill information part of buffer
                      with PRecInfo(Buffer+FStartRecInfo)^ do
                      begin
                           RecordNo:=FRecNo;
                           BookmarkFlag:=bfCurrent;
                      end;

                      //fill calc fields part of buffer
                      ClearCalcFields(Buffer);
                      GetCalcFields(Buffer);
                      Acceptable:=FilterRecord(Buffer);
                      if (GetMode=gmCurrent) and not Acceptable then Result:=grError;
              end
         end;
     until (Result<>grOk) or Acceptable;
end;

function TkbmMemTable.FindRecord(Restart, GoForward: Boolean): Boolean;
var
   Status:boolean;
begin
     CheckBrowseMode;
     DoBeforeScroll;
     SetFound(False);
     UpdateCursorPos;
     CursorPosChanged;

     if GoForward then
     begin
          if Restart then _InternalFirst;
          Status := _InternalNext;
     end else
     begin
          if Restart then _InternalLast;
          Status := _InternalPrior;
     end;

     if Status then
     begin
          Resync([rmExact, rmCenter]);
          SetFound(True);
     end;
     Result := Found;
     if Result then DoAfterScroll;
end;

function TkbmMemTable.FilterRecord(Buffer: PChar): Boolean;
var
   SaveState: TDatasetState;
begin
     Result:=True;
     if not Filtered or not Assigned(OnFilterRecord) then Exit;
     SaveState:=SetTempState(dsFilter);
     FFilterBuffer:=Buffer;
     OnFilterRecord(self,Result);
     RestoreState(SaveState);
end;

procedure TkbmMemTable.InternalSetToRecord(Buffer: PChar);
begin
     FRecNo:=PRecInfo(Buffer+FStartRecInfo).RecordNo;
end;

function TkbmMemTable.GetRecordCount: integer;
var
   SaveState: TDataSetState;
   SavePosition: integer;
   TempBuffer: PChar;
begin
     if not Filtered then Result:=FRecords.Count
     else
     begin
          Result:=0;
          SaveState:=SetTempState(dsBrowse);
          SavePosition:=FRecNo;
          try
             TempBuffer:=AllocRecordBuffer;
             InternalFirst;
             while GetRecord(TempBuffer,gmNext,True)=grOk do Inc(Result);
          finally
             RestoreState(SaveState);
             FRecNo:=SavePosition;
             FreeRecordBuffer(TempBuffer);
          end;
     end;
end;

function TkbmMemTable.GetRecNo: integer;
var
   SaveState: TDataSetState;
   SavePosition: integer;
   TempBuffer: PChar;
begin
     if not Filtered then Result:=FRecNo
     else
     begin
          Result:=0;
          SaveState:=SetTempState(dsBrowse);
          SavePosition:=FRecNo;
          try
             TempBuffer:=AllocRecordBuffer;
             InternalFirst;
             repeat
                   if GetRecord(TempBuffer,gmNext,True)=grOk then Inc(Result);
             until PRecInfo(TempBuffer+FStartRecInfo).RecordNo=SavePosition
          finally
             RestoreState(SaveState);
             FRecNo:=SavePosition;
             FreeRecordBuffer(TempBuffer);
          end;
     end;
end;

procedure TkbmMemTable.SetRecNo(Value: Integer);
var
   SaveState: TDataSetState;
   SavePosition: integer;
   TempBuffer: PChar;
begin
     if not Filtered then FRecNo:=Value
     else
     begin
          SaveState:=SetTempState(dsBrowse);
          SavePosition:=FRecNo;
          try
             TempBuffer:=AllocRecordBuffer;
             InternalFirst;
             repeat
                   begin
                        if GetRecord(TempBuffer,gmNext,True)=grOk then Dec(Value)
                        else
                        begin
                             FRecNo:=SavePosition;
                             break;
                        end;
                   end;
             until Value=0;
          finally
             RestoreState(SaveState);
             FreeRecordBuffer(TempBuffer);
          end;
     end;
end;

procedure TkbmMemTable.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
   b:Pointer;
begin
     // Allocate room for buffer in list.
     GetMem(b,FBufferSize);
     Move(Buffer^, b^, FBufferSize);
     if Append then
        _InternalAdd(b)
     else
         _InternalInsert(FRecNo,b);
end;

procedure TkbmMemTable.InternalDelete;
begin
     _InternalDelete(FRecNo);
end;

procedure TkbmMemTable.InternalInitRecord(Buffer: PChar);
begin
     FillChar(Buffer^,FBufferSize,0);
     PRecInfo(Buffer+FStartRecInfo)^.RecordNo:=FRecNo;
end;

procedure TkbmMemTable.InternalPost;
var
   b:pointer;
   n:integer;
begin
     n:=PRecInfo(ActiveBuffer+FStartRecInfo)^.RecordNo;
     if State = dsEdit then
        Move(ActiveBuffer^, FRecords.Items[n]^, FBufferSize)
     else
     begin
          GetMem(b,FBufferSize);
          Move(ActiveBuffer^, b^, FBufferSize);
          if GetBookmarkFlag(b) = bfEOF then
             _InternalAdd(b)
          else
             _InternalInsert(n,b);
     end;
end;

procedure TkbmMemTable.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
     PRecInfo(Buffer + FStartRecInfo).BookmarkFlag := Value;
end;

function TkbmMemTable.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
     Result:=PRecInfo(Buffer+FStartRecInfo).BookmarkFlag;
end;

procedure TkbmMemTable.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
     PInteger(Data)^ := PRecInfo(Buffer + FStartRecInfo).Bookmark;
end;

procedure TkbmMemTable.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
     PRecInfo(Buffer + FStartRecInfo).Bookmark := PInteger(Data)^;
end;

procedure TkbmMemTable.InternalGotoBookmark (Bookmark: Pointer);
var
  ReqBookmark: Integer;
begin
     ReqBookmark := PInteger (Bookmark)^;
     if (ReqBookmark >= 0) and (ReqBookmark < RecordCount) then
        FRecNo := ReqBookmark
     else
        raise eMemTableError.Create('Bookmark ' + IntToStr(ReqBookmark) + ' not found');
end;

procedure TkbmMemTable.InternalHandleException;
begin
     Application.HandleException(Self);
end;

procedure TkbmMemTable.SaveToFile(const FileName: string; flags:TkbmMemTableSaveFlags);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream,flags);
  finally
    Stream.Free;
  end;
end;

procedure TkbmMemTable.SaveToStream(Stream: TStream; flags:TkbmMemTableSaveFlags);
var
  i:integer;
  bm:TBookmark;
  nf:integer;
  s,a:string;
  l:integer;
  fset,f:^Boolean;
  Ods,Oms:char;
begin
  // Setup standard layout for data.
  Ods:=DateSeparator;
  Oms:=DecimalSeparator;
  DateSeparator:='/';
  DecimalSeparator:='.';

  bm:=GetBookmark;
  fset:=nil;
  try
     DisableControls;

     // Setup flags for fields to save.
     nf:=Fieldcount;
     GetMem(fset,nf * sizeof(boolean));
     f:=fset;
     for i:=0 to nf-1 do
     begin
          f^:=false;
          case Fields[i].FieldKind of
               fkData: if mtfSaveData in flags then f^:=true;
               fkCalculated: if mtfSaveCalculated in flags then f^:=true;
               fkLookup: if mtfSaveLookup in flags then f^:=true;
               else f^:=true;
          end;
          if not (Fields[i].Visible or (mtfSaveNonVisible in flags)) then f^:=false;
          inc(f);
     end;

     // Write all field display names in CSV format.
     s:='';
     a:='';
     f:=fset;
     for i:=0 to nf-1 do
     begin
          if f^ then
          begin
               s:=s+a+AnsiQuotedStr(PChar(Fields[i].DisplayName),'"');
               a:=',';
          end;
          inc(f);
     end;
     s:=s+#13+#10;
     l:=length(s);
     Stream.Write(Pointer(s)^, l);

     // Write all records in CSV format.
     first;
     while not EOF do
     begin
          // Write current record.
          s:='';
          a:='';
          f:=fset;
          for i:=0 to nf-1 do
          begin
               if f^ then
               begin
                    if (Fields[i].IsNull) then s:=s+a
                    else s:=s+a+AnsiQuotedStr(PChar(Fields[i].AsString),'"');
                    a:=',';
               end;
               inc(f);
          end;
          s:=s+#13+#10;
          l:=length(s);
          Stream.WriteBuffer(Pointer(s)^, l);

          // Next record.
          next;
     end;
  finally
     GotoBookmark(bm);
     EnableControls;
     FreeBookmark(bm);
     if fset<>nil then FreeMem(fset);
     DateSeparator:=Ods;
     DecimalSeparator:=Oms;
  end;
end;

procedure TkbmMemTable.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TkbmMemTable.LoadFromStream(Stream: TStream);
const
   BUFSIZE=8192;
var
   i:integer;
   bm:TBookmark;
   nf:integer;
   s:string;
   buf,ptr:PChar;
   buflen:integer;
   Line:string;
   lptr,elptr:PChar;
   null:boolean;
   Ods,Oms:char;

   function GetLine:boolean;
   var
     Start: PChar;
     sz:integer;
   begin
        // If less than 1024 bytes left in buffer, fill up the buffer.
        // Notice: This means that if a line is longer than 1024 bytes it could fail.
        sz:=BUFSIZE-(ptr-buf);
        if (sz<1024) then
        begin
             // Move the rest of data to the start of the buffer.
             if (sz>0) then Move(ptr,buf,sz);
             ptr:=buf+sz;

             // Fill up the buffer.
             buflen:=BUFSIZE;
             if Stream.Size<buflen then buflen:=Stream.Size;
             buflen:=Stream.Read(Pointer(buf)^,buflen-sz)+sz;
             ptr:=buf;
        end;

        // Check if finished.
        if ((ptr-buf) = buflen) then
        begin
             Result:=false;
             exit;
        end;

        // Cut out a line.
        Start := ptr;
        while not (ptr^ in [#0, #10, #13]) do Inc(ptr);
        SetString(Line, Start, ptr - Start);
        lptr:=PChar(Line);
        elptr:=PChar(Line)+Length(Line)-1;
        if ptr^ = #13 then Inc(ptr);
        if ptr^ = #10 then Inc(ptr);
        Result:=true;
   end;

   function GetWord(var null:boolean):string;
   label
     L_exit;
   begin

     // Cut out next word.
     Result:='';

     // Look for starting " or ,.
     while (lptr^ <> '"') and (lptr^ <> ',') and (lptr<elptr) do inc(lptr);
     if (lptr>=elptr) then exit;
     if (lptr^ = ',') then
     begin
          null:=true;
          inc(lptr);
          exit;
     end
     else null:=false;
     inc(lptr);

     while true do
     begin
          // Look for ending ".
          while not (lptr^ = '"') do
          begin
               if (lptr>=elptr) then goto L_exit;
               Result:=Result+lptr^;
               inc(lptr);
          end;
          inc(lptr);

          // Is it a double "" or end of word ?.
          if (lptr^ = '"') then
          begin
               Result:=Result+'"';
               inc(lptr);
               continue;
          end;

L_exit:
          // Found end, remove comma's if any.
          while (lptr<elptr) and (lptr^ = ',') do inc(lptr);
          break;
     end;
   end;

begin
  // Setup standard layout for data.
  Ods:=DateSeparator;
  Oms:=DecimalSeparator;
  DateSeparator:='/';
  DecimalSeparator:='.';

  bm:=GetBookmark;

  try
     // Allocate space for a buffer.
     GetMem(buf,BUFSIZE);

     // Place pointer at end of buffer to notify getword to read a chunk of streamdata.
     ptr:=buf+BUFSIZE;

     // Read data from stream.
     nf:=Fieldcount;

     // Read headerline and skip it.
     GetLine;

     DisableControls;

     // Read all lines in CSV format.
     while GetLine do
     begin
          append;

          i:=0;
          while (lptr<elptr) and (i<nf) do
          begin
               s:=GetWord(null);
               if null then Fields[i].Clear
               else Fields[i].AsString:=s;
               inc(i);
          end;

          post;
     end;
  finally
     FreeMem(buf);
     GotoBookmark(bm);
     EnableControls;
     FreeBookmark(bm);
     DateSeparator:=Ods;
     DecimalSeparator:=Oms;
  end;
end;

procedure TkbmMemTable.EmptyTable;
begin
     _InternalEmpty;
end;

procedure TkbmMemTable.SetCommaText(AString: String);
var
   stream:TMemoryStream;
begin
     EmptyTable;
     stream:=TMemoryStream.Create;
     try
        stream.Write(Pointer(AString)^,length(AString));
        stream.Seek(0,soFromBeginning);
        LoadFromStream(stream);
     finally
        stream.free;
     end;
end;

function TkbmMemTable.GetCommaText: String;
var
   stream:TMemoryStream;
   sz:integer;
   p:PChar;
begin
     Result:='';
     stream:=TMemoryStream.Create;
     try
        SaveToStream(stream,[mtfSaveData]);
        stream.Seek(0,soFromBeginning);
        sz:=stream.Size;
        p:=stream.Memory;
        setstring(Result,p,sz);
     finally
        stream.free;
     end;
end;

procedure Register;
begin
     RegisterComponents('Data Access', [TkbmMemTable]);
end;

end.