Таблицы в памяти

unit Inmem;

interface

uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;

type
  TInMemoryTable = class(TTable)

  private
    hCursor: hDBICur;
    procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
      const Name: string; DataType: TFieldType; Size: Word);
    function CreateHandle: HDBICur; override;
  public
    procedure CreateTable;
  end;

implementation

{ Эта функция виртуальная, так что я смог перекрыть ее.
В оригинальном VCL-коде для TTable эта функция реально
открывает таблицу, но, поскольку мы уже имеем дескриптор
таблицы, то мы просто возвращаем его }

function TInMemoryTable.CreateHandle;
begin

  Result := hCursor;
end;

{ Эта функция получена ее простым копированием из исходного
кода VCL. Я должен был это сделать, поскольку это было
объявлено в секции private компонента TTable, поэтому отсюда
у меня не было к этому досупа. }

procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc;

  const Name: string; DataType: TFieldType; Size: Word);
const

  TypeMap: array[TFieldType] of Byte = (
    fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
    fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
    fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);
begin

  with FieldDesc do
  begin
    AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
    iFldType := TypeMap[DataType];
    case DataType of
      ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:
        iUnits1 := Size;
      ftBCD:
        begin
          iUnits1 := 32;
          iUnits2 := Size;
        end;
    end;
    case DataType of
      ftCurrency:
        iSubType := fldstMONEY;
      ftBlob:
        iSubType := fldstBINARY;
      ftMemo:
        iSubType := fldstMEMO;
      ftGraphic:
        iSubType := fldstGRAPHIC;
    end;
  end;
end;

{ Вот кухня, где все это происходит. Я скопировал эту
функцию из исходников VCL и затем изменил ее для
использования DbiCreateInMemoryTable вместо DbiCreateTable.
Поскольку InMemory-таблицы не поддерживают индексы,
я удалил весь соответствующий код. }

procedure TInMemoryTable.CreateTable;
var

  I: Integer;
  pFieldDesc: pFLDDesc;
  szTblName: DBITBLNAME;
  iFields: Word;
  Dogs: pfldDesc;
begin

  CheckInactive;
  if FieldDefs.Count = 0 then
    for I := 0 to FieldCount - 1 do
      with Fields[I] do
        if not Calculated then
          FieldDefs.Add(FieldName, DataType, Size, Required);
  pFieldDesc := nil;
  SetDBFlag(dbfTable, True);
  try
    AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
    iFields := FieldDefs.Count;
    pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc));
    for I := 0 to FieldDefs.Count - 1 do
      with FieldDefs[I] do
      begin
        EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name,
          DataType, Size);
      end;
    { тип драйвера nil, т.к. поля логические }
    Check(DbiTranslateRecordStructure(nil, iFields, pFieldDesc,
      nil, nil, pFieldDesc));
    { здесь hCursor получает свое значение }
    Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc,
      hCursor));

  finally
    if pFieldDesc <> nil then
      FreeMem(pFieldDesc, iFields *
        SizeOf(FLDDesc));

    SetDBFlag(dbfTable, False);
  end;
end;

end.

{Данный код взят из файлов помощи Ллойда!}