home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / inmemory / inmem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  4.6 KB  |  146 lines
  1. {
  2.  
  3.  This is an InMemoryTable example. Free for anyone to use, modify and do
  4.  whatever else you wish.
  5.  
  6.  Just like all things free it comes with no guarantees. I cannot be responsible
  7.  for any damage this code may cause. Let me repeat this:
  8.  
  9.  WARNING! THIS CODE IS PROVIDED AS IS WITH NO GUARANTEES OF ANY KIND!
  10.  USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE FOR
  11.  ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!
  12.  
  13.  THANKS to Steve Garland <72700.2407@compuserve.com> for his help. He
  14.  created his own variation of an in-memory table component and I used it
  15.  to get started.
  16.  
  17.  InMemory tables are a feature of the Borland Database Engine (BDE).
  18.  InMemory tables are created in RAM and deleted when you close them. They
  19.  are much faster and are very useful when you need fast operations on small
  20.  tables. This example uses the DbiCreateInMemoryTable DBE function call.
  21.  
  22.  This object should work just like a regular table, except InMemory tables
  23.  do not support certain features (like referntial integrity, secondary
  24.  indexes and BLOBs) and currently this code doesn't do anything to
  25.  prevent you from trying to use them. You will probably get some error if
  26.  you try to create a memo field.
  27.  
  28.  If you have comments - please contact me at INTERNET:grisha@mira.com
  29.  
  30.  Happy hacking!
  31.  
  32.  Gregory Trubetskoy
  33.  http://www.mira.com/home/grisha
  34.  
  35. }
  36.  
  37. unit Inmem;
  38.  
  39. interface
  40.  
  41. uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;
  42.  
  43.  
  44. type TInMemoryTable = class(TTable)
  45.   private
  46.     hCursor: hDBICur;
  47.     procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
  48.       const Name: string; DataType: TFieldType; Size: Word);
  49.     function CreateHandle: HDBICur; override;
  50.   public
  51.     procedure CreateTable;
  52.   end;
  53.  
  54. implementation
  55.  
  56. { luckely this function is virtual - so I could override it. In the original
  57.   VCL code for TTable this function actually opens the table - but since
  58.   we already have the handle to the table - we just return it }
  59.  
  60. function TInMemoryTable.CreateHandle;
  61. begin
  62.   Result := hCursor;
  63. end;
  64.  
  65. { This function is cut-and-pasted from the VCL source code. I had to do this
  66.   because it is declared private in the TTable component so I had no access
  67.   to it from here. }
  68.  
  69. procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
  70.   const Name: string; DataType: TFieldType; Size: Word);
  71. const
  72.   TypeMap: array[TFieldType] of Byte = (
  73.     fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
  74.     fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
  75.     fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);
  76. begin
  77.   with FieldDesc do
  78.   begin
  79.     AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
  80.     iFldType := TypeMap[DataType];
  81.     case DataType of
  82.       ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:
  83.         iUnits1 := Size;
  84.       ftBCD:
  85.         begin
  86.           iUnits1 := 32;
  87.           iUnits2 := Size;
  88.         end;
  89.     end;
  90.     case DataType of
  91.       ftCurrency:
  92.         iSubType := fldstMONEY;
  93.       ftBlob:
  94.         iSubType := fldstBINARY;
  95.       ftMemo:
  96.         iSubType := fldstMEMO;
  97.       ftGraphic:
  98.         iSubType := fldstGRAPHIC;
  99.     end;
  100.   end;
  101. end;
  102.  
  103. { This is where all the fun happens. I copied this function from the VCL source
  104.   and then changed it to use DbiCreateInMemoryTable instead of DbiCreateTable.
  105.   Since InMemory tables do not support Indexes - I took all of the index-related
  106.   things out }
  107.  
  108. procedure TInMemoryTable.CreateTable;
  109. var
  110.   I: Integer;
  111.   pFieldDesc: pFLDDesc;
  112.   szTblName: DBITBLNAME;
  113.   iFields: Word;
  114.   Dogs: pfldDesc;
  115. begin
  116.   CheckInactive;
  117.   if FieldDefs.Count = 0 then
  118.     for I := 0 to FieldCount - 1 do
  119.       with Fields[I] do
  120.         if not Calculated then
  121.           FieldDefs.Add(FieldName, DataType, Size, Required);
  122.   pFieldDesc := nil;
  123.   SetDBFlag(dbfTable, True);
  124.   try
  125.     AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
  126.     iFields := FieldDefs.Count;
  127.     pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc));
  128.     for I := 0 to FieldDefs.Count - 1 do
  129.       with FieldDefs[I] do
  130.       begin
  131.         EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name,
  132.           DataType, Size);
  133.       end;
  134.       { the driver type is nil = logical fields }
  135.       Check(DbiTranslateRecordStructure(nil, iFields, pFieldDesc,
  136.         nil, nil, pFieldDesc));
  137.       { here we go - this is where hCursor gets its value }
  138.     Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc, hCursor));
  139.   finally
  140.     if pFieldDesc <> nil then FreeMem(pFieldDesc, iFields * SizeOf(FLDDesc));
  141.     SetDBFlag(dbfTable, False);
  142.   end;
  143. end;
  144.  
  145. end.
  146.