home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / dbtools.pak / BDETABLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  3.1 KB  |  155 lines
  1. unit BDETable;
  2.  
  3. interface
  4.  
  5. uses SysUtils, DbiTypes, DbiProcs, Classes, DsgnIntf, DB, DBCtrls;
  6.  
  7. type
  8.  
  9. { TDatabaseList }
  10.  
  11.   TDatabaseList = class(TDBDataSet)
  12.   protected
  13.     function CreateHandle: HDBICur; override;
  14.   end;
  15.  
  16. { TTableList }
  17.  
  18.   TTableList = class(TDBDataSet)
  19.   private
  20.     FExtended: Boolean;
  21.     FSystemTables: Boolean;
  22.   protected
  23.     function CreateHandle: HDBICur; override;
  24.   published
  25.     property ExtendedInfo: Boolean read FExtended write FExtended;
  26.     property SystemTables: Boolean read FSystemTables write FSystemTables;
  27.   end;
  28.  
  29. { TTableItems }
  30.  
  31.   TTableItems = class(TDBDataSet)
  32.   private
  33.     FTableName: TFileName;
  34.   published
  35.     property TableName: TFileName read FTableName write FTableName;
  36.   end;
  37.  
  38. { TFieldList }
  39.  
  40.   TFieldList = class(TTableItems)
  41.   protected
  42.     function CreateHandle: HDBICur; override;
  43.   end;
  44.  
  45. { TIndexList }
  46.  
  47.   TIndexList = class(TTableItems)
  48.   protected
  49.     function CreateHandle: HDBICur; override;
  50.   end;
  51.  
  52. { TDatabaseDesc }
  53.  
  54.   TDatabaseDesc = class(TObject)
  55.   private
  56.     FDescription: DBDesc;
  57.   public
  58.     property Description: DBDesc read FDescription;
  59.     constructor Create(DataBaseName: string);
  60.   end;
  61.  
  62. { TDriverDesc }
  63.  
  64.   TDriverDesc = class(TObject)
  65.   private
  66.     FDescription: DRVType;
  67.   public
  68.     property Description: DRVType read FDescription;
  69.     constructor Create(DriverType: string);
  70.   end;
  71.  
  72.   { Component registration }
  73.  
  74.   procedure Register;
  75.  
  76. implementation
  77.  
  78. uses TypInfo, Controls, WinProcs, WinTypes;
  79.  
  80. { TDatabaseList }
  81.  
  82. function TDatabaseList.CreateHandle: HDBICur;
  83. begin
  84.   Check(DbiOpenDatabaseList(Result));
  85. end;
  86.  
  87. { TTableList }
  88.  
  89. function TTableList.CreateHandle: HDBICur;
  90. begin
  91.   Check(DbiOpenTableList(DBHandle, ExtendedInfo, SystemTables, nil, Result));
  92. end;
  93.  
  94. { TFieldList }
  95.  
  96. function TFieldList.CreateHandle: HDBICur;
  97. var
  98.   STableName: array[0..SizeOf(TFileName) - 1] of Char;
  99. begin
  100.   Check(DbiOpenFieldList(DBHandle, AnsiToNative(DBLocale, FTableName,
  101.     STableName, Sizeof (STableName)), nil, False, Result));
  102. end;
  103.  
  104. { TIndexList }
  105.  
  106. function TIndexList.CreateHandle: HDBICur;
  107. var
  108.   STableName: array[0..SizeOf(TFileName) - 1] of Char;
  109. begin
  110.   Check(DbiOpenIndexList(DBHandle, AnsiToNative(DBLocale, FTableName,
  111.     STableName, Sizeof (STableName)), nil, Result));
  112. end;
  113.  
  114. { TDatabaseDesc }
  115.  
  116. constructor TDatabaseDesc.Create(DataBaseName: String);
  117. var
  118.   Buffer: PChar;
  119.   BufLen: Word;
  120. begin
  121.   BufLen := Length(DatabaseName) + 1;
  122.   Buffer := AllocMem(BufLen);
  123.   try
  124.     StrPCopy(Buffer, DatabaseName);
  125.     Check(DbiGetDatabaseDesc(Buffer, @FDescription));
  126.   finally
  127.     FreeMem(Buffer, BufLen);
  128.   end;
  129. end;
  130.  
  131. { TDriverDesc }
  132.  
  133. constructor TDriverDesc.Create(DriverType: String);
  134. var
  135.   Buffer: PChar;
  136.   BufLen: Word;
  137. begin
  138.   BufLen := Length(DriverType) + 1;
  139.   Buffer := AllocMem(BufLen);
  140.   try
  141.     StrPCopy(Buffer, DriverType);
  142.     Check(DbiGetDriverDesc(Buffer, FDescription));
  143.   finally
  144.     FreeMem(Buffer, BufLen);
  145.   end;
  146. end;
  147.  
  148. procedure Register;
  149. begin
  150.   RegisterComponents ('Samples',
  151.                       [TDatabaseList, TTableList, TFieldList, TIndexList]);
  152. end;
  153.  
  154. end.
  155.