In-Memory Tables in Delphi 4 (DBICreateInMemTable)

Hi,

I have a project where i need to use an in-memory table in delphi 4. I've
surfed the web and looked around and there are components available but they
are all descendants of TDataset. I need a TBDEDataset descendant because i
need to use the TBatchMove component to eventually move the data to a
database server.

I've found an example from Gregory Trubetskoy on the net, however it's a
Delphi 2 example and doesn't compile under Delphi 4. I've managed to convert
it to Delphi 4 and it compiles fine, but doesn't seem to work.

I create the in-memory table as follows:

 MyInMemoryTable := TInMemoryTable.Create(TestForm);
 with MyInMemoryTable do
begin
    DatabaseName := 'DBDEMOS';
    TableName := 'xxx.db';
    FieldDefs.Add('Field1', ftString, 10, False);
    FieldDefs.Add('Field2', ftString, 15, False);
    CreateTable;
    Active := True;

    Append;
    Fieldbyname('Field1').AsString := 'hello';
    Post;
end;

The Post method fails as somehow the table claims it doesn't have any
fields. Below is the source code for the modified TTable:

(*************** INMEM.PAS  *************)

unit Inmem;

interface

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

type TInMemoryTable = class(TTable)
  private
   hCursor: hDBICur;
   procedure EncodeFieldDesc(var FieldDesc: FLDDesc;  const Name: string;
DataType: TFieldType; Size, Precision: Word);
   function CreateHandle: HDBICur; override;
   function GetDriverTypeName(Buffer: PChar): PChar;
   function GetTableTypeName: PChar;
   function SetTempLocale(ActiveCheck: Boolean): TLocale;
   procedure RestoreLocale(LocaleSave: TLocale);
  public
    procedure CreateTable;
  end;

implementation

const
  TableTypeDriverNames: array[TTableType] of PChar =
    (szPARADOX, szPARADOX, szDBASE, szFOXPRO, szASCII);

function TInMemoryTable.SetTempLocale(ActiveCheck: Boolean): TLocale;
var
  LName: string;
  TempLocale: TLocale;
begin
  if not ActiveCheck or (Handle = nil) then
  begin
    Result := Locale;
    LName := GetLanguageDriverName;
    if (LName <> '') and (OsLdLoadBySymbName(PChar(LName), TempLocale) = 0)
then
      if TempLocale <> Locale then
        SetLocale(TempLocale) else
        OsLdUnloadObj(TempLocale);
  end else
  begin
    if DbiGetLdObj(Handle, TempLocale) = 0 then SetLocale(TempLocale);
    Result := TempLocale;
  end;
end;

procedure TInMemoryTable.RestoreLocale(LocaleSave: TLocale);
var
 ALocale : TLocale;
begin
  if (LocaleSave <> Locale) and (Locale <> nil) then
  begin
    ALocale := Locale;
    OsLdUnloadObj(ALocale);
    SetLocale(LocaleSave);
  end;
end;

function TInMemoryTable.GetTableTypeName: PChar;
begin
  if Database.IsSQLBased then Result := nil
  else Result := TableTypeDriverNames[GetTableType];
end;

function TInMemoryTable.GetDriverTypeName(Buffer: PChar): PChar;
var
  Length: Word;
begin
  Result := Buffer;
  Check(DbiGetProp(HDBIOBJ(DBHandle), dbDATABASETYPE, Buffer,
    SizeOf(DBINAME), Length));
  if StrIComp(Buffer, szCFGDBSTANDARD) = 0 then
  begin
    Result := GetTableTypeName;
    if Result <> nil then Result := StrCopy(Buffer, Result);
  end;
end;

function TInMemoryTable.CreateHandle;
begin
  Result := hCursor;
end;

procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
  const Name: string; DataType: TFieldType; Size, Precision: Word);
const
  TypeMap: array[TFieldType] of byte = (
    fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
    fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
    fldVARBYTES, fldINT32, fldBLOB, fldBLOB, fldBLOB, fldBLOB, fldBLOB,
    fldBLOB, fldBLOB, fldCURSOR, fldZSTRING, fldZSTRING, fldINT64, fldADT,
    fldArray, fldREF, fldTABLE);

  SubTypeMap: array[TFieldType] of Word = (
    0, 0, 0, 0, 0, 0, 0, fldstMONEY, 0, 0, 0, 0, 0, 0, fldstAUTOINC,
    fldstBINARY, fldstMEMO, fldstGRAPHIC, fldstFMTMEMO, fldstOLEOBJ,
    fldstDBSOLEOBJ, fldstTYPEDBINARY, 0, fldstFIXED, fldstUNICODE,
    0, 0, 0, 0, 0);
begin
  with FieldDesc do
  begin
    AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
    iFldType := TypeMap[DataType];
    iSubType := SubTypeMap[DataType];
    case DataType of
      ftString, ftFixedChar, ftBytes, ftVarBytes, ftBlob..ftTypedBinary:
        iUnits1 := Size;
      ftBCD:
        begin
          { Default precision is 32, Size = Scale }
          if (Precision > 0) and (Precision <= 32) then
            iUnits1 := Precision else
            iUnits1 := 32;
          iUnits2 := Size;  {Scale}
        end;
    end;
  end;
end;

procedure TInMemoryTable.CreateTable;
var
  LocaleSave: TLocale;
  IndexDescs: TIndexDescList;
  TableDesc: CRTblDesc;
  FieldDescs: TFieldDescList;
  ValChecks: TValCheckList;
  DriverTypeName: DBINAME;
  SQLLName: DBINAME;
  PSQLLName: PChar;
  LvlFldDesc: FLDDesc;
  Level: DBINAME;

  procedure InitTableSettings;
  var
    PTblType: PChar;
  begin
    FillChar(TableDesc, SizeOf(TableDesc), 0);
    with TableDesc do
    begin
      AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
      PTblType := GetTableTypeName;
      if Assigned(PTblType) then StrCopy(szTblType, PTblType);
      if TableLevel > 0 then
      begin
        iOptParams := 1;
        StrCopy(@Level, PChar(IntToStr(TableLevel)));
        pOptData := @Level;
        StrCopy(LvlFldDesc.szName, szCFGDRVLEVEL);
        LvlFldDesc.iLen := StrLen(Level) + 1;
        LvlFldDesc.iOffset := 0;
        pfldOptParams :=  @LvlFldDesc;
      end;
    end;
  end;

  procedure InitFieldDescriptors;
  var
    I: Integer;
    TempFieldDescs: TFieldDescList;
  begin
    with TableDesc do
    begin
      InitFieldDefsFromFields;
      iFldCount := FieldDefs.Count;
      SetLength(TempFieldDescs, iFldCount);
      for I := 0 to FieldDefs.Count - 1 do
      with FieldDefs[I] do
      begin

        EncodeFieldDesc(TempFieldDescs[I], Name, DataType, Size, Precision);
        if Required then Inc(iValChkCount);
      end;
      SetLength(FieldDescs, iFldCount);
      pFldDesc := BDE.PFLDDesc(FieldDescs);
      PSQLLName := nil;
      if Database.IsSQLBased then
        if DbiGetLdNameFromDB(DBHandle, nil, SQLLName) = 0 then
          PSQLLName := SQLLName;
      Check(DbiTranslateRecordStructure(nil, iFldCount,
BDE.PFLDDesc(TempFieldDescs),
        GetDriverTypeName(DriverTypeName), PSQLLName, pFLDDesc, False));
    end;
  end;

  procedure InitIndexDescriptors;
  var
    I: Integer;
  begin
    TableDesc.iIdxCount := IndexDefs.Count;
    SetLength(IndexDescs, TableDesc.iIdxCount);
    TableDesc.pIdxDesc := PIDXDesc(IndexDescs);
    for I := 0 to IndexDefs.Count - 1 do
    with IndexDefs[I] do
      EncodeIndexDesc(IndexDescs[I], Name, FieldExpression, Options,
DescFields);
  end;

  procedure InitValChecks;
  var
    I, ValCheckNo: Integer;
  begin
    with TableDesc do
    if iValChkCount > 0 then
    begin
      SetLength(ValChecks, iValChkCount);
      ValCheckNo := 0;
      for I := 0 to FieldDefs.Count - 1 do
        if FieldDefs[I].Required then
        begin
          ValChecks[ValCheckNo].iFldNum := I + 1;
          ValChecks[ValCheckNo].bRequired := True;
          Inc(ValCheckNo);
        end;
      pvchkDesc := BDE.pVCHKDesc(ValChecks);
    end;
  end;

begin
  CheckInactive;
  SetDBFlag(dbfTable, True);
  try
    InitTableSettings;
    LocaleSave := SetTempLocale(False);
    try
      InitFieldDescriptors;
     // InitIndexDescriptors;
      InitValChecks;
    //   Check(DbiCreateTable(DBHandle, True, TableDesc));

      Check(DbiCreateInMemTable(DBHandle, TableDesc.szTblName,
TableDesc.iFldCount, TableDesc.pFldDesc, hCursor));

    finally
      RestoreLocale(LocaleSave);
    end;
  finally
    SetDBFlag(dbfTable, False);
  end;
end;

end.

(****************************************************)

I've had to cut and paste a few functions from the VCL to make it compile in
Delphi 4.

If anyone has any idea how to fix this code or has some working code
allready available, it would be greatly appreciated.

Thanks
  Russell

rusvdw@iafrica<dot>com