home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / ibdatabaseinfo.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  15KB  |  446 lines
  1. {********************************************************}
  2. {                                                        }
  3. {       Borland Delphi Visual Component Library          }
  4. {       InterBase Express core components                }
  5. {                                                        }
  6. {       Copyright (c) 1998-1999 Inprise Corporation      }
  7. {                                                        }
  8. {    InterBase Express is based in part on the product   }
  9. {    Free IB Components, written by Gregory H. Deatz for }
  10. {    Hoagland, Longo, Moran, Dunst & Doukas Company.     }
  11. {    Free IB Components is used under license.           }
  12. {                                                        }
  13. {********************************************************}
  14.  
  15. unit IBDatabaseInfo;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, SysUtils, Classes, Forms, ExtCtrls,
  21.   IBHeader, IBExternals, IB, IBDatabase;
  22.  
  23. type
  24.  
  25.   TIBDatabaseInfo = class(TComponent)
  26.   protected
  27.     FIBLoaded: Boolean;
  28.     FDatabase: TIBDatabase;
  29.     FUserNames   : TStringList;
  30.     FBackoutCount: TStringList;
  31.     FDeleteCount: TStringList;
  32.     FExpungeCount: TStringList;
  33.     FInsertCount: TStringList;
  34.     FPurgeCount: TStringList;
  35.     FReadIdxCount: TStringList;
  36.     FReadSeqCount: TStringList;
  37.     FUpdateCount: TStringList;
  38.     function GetAllocation: Long;
  39.     function GetBaseLevel: Long;
  40.     function GetDBFileName: String;
  41.     function GetDBSiteName: String;
  42.     function GetDBImplementationNo: Long;
  43.     function GetDBImplementationClass: Long;
  44.     function GetNoReserve: Long;
  45.     function GetODSMinorVersion: Long;
  46.     function GetODSMajorVersion: Long;
  47.     function GetPageSize: Long;
  48.     function GetVersion: String;
  49.     function GetCurrentMemory: Long;
  50.     function GetForcedWrites: Long;
  51.     function GetMaxMemory: Long;
  52.     function GetNumBuffers: Long;
  53.     function GetSweepInterval: Long;
  54.     function GetUserNames: TStringList;
  55.     function GetFetches: Long;
  56.     function GetMarks: Long;
  57.     function GetReads: Long;
  58.     function GetWrites: Long;
  59.     function GetBackoutCount: TStringList;
  60.     function GetDeleteCount: TStringList;
  61.     function GetExpungeCount: TStringList;
  62.     function GetInsertCount: TStringList;
  63.     function GetPurgeCount: TStringList;
  64.     function GetReadIdxCount: TStringList;
  65.     function GetReadSeqCount: TStringList;
  66.     function GetUpdateCount: TStringList;
  67.     function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
  68.     function GetReadOnly: Long;
  69.     function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
  70.     function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
  71.     function GetDBSQLDialect: Long;
  72.   public
  73.     constructor Create(AOwner: TComponent); override;
  74.     destructor Destroy; override;
  75.     function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
  76.     property Allocation: Long read GetAllocation;
  77.     property BaseLevel: Long read GetBaseLevel;
  78.     property DBFileName: String read GetDBFileName;
  79.     property DBSiteName: String read GetDBSiteName;
  80.     property DBImplementationNo: Long read GetDBImplementationNo;
  81.     property DBImplementationClass: Long read GetDBImplementationClass;
  82.     property NoReserve: Long read GetNoReserve;
  83.     property ODSMinorVersion: Long read GetODSMinorVersion;
  84.     property ODSMajorVersion: Long read GetODSMajorVersion;
  85.     property PageSize: Long read GetPageSize;
  86.     property Version: String read GetVersion;
  87.     property CurrentMemory: Long read GetCurrentMemory;
  88.     property ForcedWrites: Long read GetForcedWrites;
  89.     property MaxMemory: Long read GetMaxMemory;
  90.     property NumBuffers: Long read GetNumBuffers;
  91.     property SweepInterval: Long read GetSweepInterval;
  92.     property UserNames: TStringList read GetUserNames;
  93.     property Fetches: Long read GetFetches;
  94.     property Marks: Long read GetMarks;
  95.     property Reads: Long read GetReads;
  96.     property Writes: Long read GetWrites;
  97.     property BackoutCount: TStringList read GetBackoutCount;
  98.     property DeleteCount: TStringList read GetDeleteCount;
  99.     property ExpungeCount: TStringList read GetExpungeCount;
  100.     property InsertCount: TStringList read GetInsertCount;
  101.     property PurgeCount: TStringList read GetPurgeCount;
  102.     property ReadIdxCount: TStringList read GetReadIdxCount;
  103.     property ReadSeqCount: TStringList read GetReadSeqCount;
  104.     property UpdateCount: TStringList read GetUpdateCount;
  105.     property DBSQLDialect : Long read GetDBSQLDialect;
  106.     property ReadOnly: Long read GetReadOnly;
  107.   published
  108.     property Database: TIBDatabase read FDatabase write FDatabase;
  109.   end;
  110.  
  111. implementation
  112.  
  113. uses
  114.   IBIntf;
  115.  
  116. { TIBDatabaseInfo }
  117.  
  118. constructor TIBDatabaseInfo.Create(AOwner: TComponent);
  119. begin
  120.   inherited Create(AOwner);
  121.   FIBLoaded := False;
  122.   CheckIBLoaded;
  123.   FIBLoaded := True;
  124.   FUserNames := TStringList.Create;
  125.   FBackoutCount                        := nil;
  126.   FDeleteCount                         := nil;
  127.   FExpungeCount                        := nil;
  128.   FInsertCount                         := nil;
  129.   FPurgeCount                          := nil;
  130.   FReadIdxCount                        := nil;
  131.   FReadSeqCount                        := nil;
  132.   FUpdateCount                         := nil;
  133. end;
  134.  
  135. destructor TIBDatabaseInfo.Destroy;
  136. begin
  137.   if FIBLoaded then
  138.   begin
  139.     FUserNames.Free;
  140.     FBackoutCount.Free;
  141.     FDeleteCount.Free;
  142.     FExpungeCount.Free;
  143.     FInsertCount.Free;
  144.     FPurgeCount.Free;
  145.     FReadIdxCount.Free;
  146.     FReadSeqCount.Free;
  147.     FUpdateCount.Free;
  148.   end;
  149.   inherited Destroy;
  150. end;
  151.  
  152.  
  153. function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
  154.   RaiseError: Boolean): ISC_STATUS;
  155. begin
  156.   result := ErrCode;
  157.   if RaiseError and (ErrCode > 0) then
  158.     IBDataBaseError;
  159. end;
  160. function TIBDatabaseInfo.GetAllocation: Long;
  161. begin
  162.   result := GetLongDatabaseInfo(isc_info_allocation);
  163. end;
  164.  
  165. function TIBDatabaseInfo.GetBaseLevel: Long;
  166. var
  167.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  168.   DatabaseInfoCommand: Char;
  169. begin
  170.   DatabaseInfoCommand := Char(isc_info_base_level);
  171.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  172.                          IBLocalBufferLength, local_buffer), True);
  173.   result := isc_vax_integer(@local_buffer[4], 1);
  174. end;
  175.  
  176. function TIBDatabaseInfo.GetDBFileName: String;
  177. var
  178.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  179.   DatabaseInfoCommand: Char;
  180. begin
  181.   DatabaseInfoCommand := Char(isc_info_db_id);
  182.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  183.                          IBLocalBufferLength, local_buffer), True);
  184.   local_buffer[5 + Int(local_buffer[4])] := #0;
  185.   result := String(PChar(@local_buffer[5]));
  186. end;
  187.  
  188. function TIBDatabaseInfo.GetDBSiteName: String;
  189. var
  190.   local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  191.   p: PChar;
  192.   DatabaseInfoCommand: Char;
  193. begin
  194.   DatabaseInfoCommand := Char(isc_info_db_id);
  195.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  196.                         IBLocalBufferLength, local_buffer), True);
  197.   p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
  198.   p := p + Int(p^) + 1;                         { End of DBSiteName }
  199.   p^ := #0;                                     { Null it }
  200.   result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
  201. end;
  202.  
  203. function TIBDatabaseInfo.GetDBImplementationNo: Long;
  204. var
  205.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  206.   DatabaseInfoCommand: Char;
  207. begin
  208.   DatabaseInfoCommand := Char(isc_info_implementation);
  209.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  210.                         IBLocalBufferLength, local_buffer), True);
  211.   result := isc_vax_integer(@local_buffer[3], 1);
  212. end;
  213.  
  214. function TIBDatabaseInfo.GetDBImplementationClass: Long;
  215. var
  216.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  217.   DatabaseInfoCommand: Char;
  218. begin
  219.   DatabaseInfoCommand := Char(isc_info_implementation);
  220.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  221.                          IBLocalBufferLength, local_buffer), True);
  222.   result := isc_vax_integer(@local_buffer[4], 1);
  223. end;
  224.  
  225. function TIBDatabaseInfo.GetNoReserve: Long;
  226. begin
  227.   result := GetLongDatabaseInfo(isc_info_no_reserve);
  228. end;
  229.  
  230. function TIBDatabaseInfo.GetODSMinorVersion: Long;
  231. begin
  232.   result := GetLongDatabaseInfo(isc_info_ods_minor_version);
  233. end;
  234.  
  235. function TIBDatabaseInfo.GetODSMajorVersion: Long;
  236. begin
  237.   result := GetLongDatabaseInfo(isc_info_ods_version);
  238. end;
  239.  
  240. function TIBDatabaseInfo.GetPageSize: Long;
  241. begin
  242.   result := GetLongDatabaseInfo(isc_info_page_size);
  243. end;
  244.  
  245. function TIBDatabaseInfo.GetVersion: String;
  246. var
  247.   local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  248.   DatabaseInfoCommand: Char;
  249. begin
  250.   DatabaseInfoCommand := Char(isc_info_version);
  251.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  252.                         IBBigLocalBufferLength, local_buffer), True);
  253.   local_buffer[5 + Int(local_buffer[4])] := #0;
  254.   result := String(PChar(@local_buffer[5]));
  255. end;
  256.  
  257. function TIBDatabaseInfo.GetCurrentMemory: Long;
  258. begin
  259.   result := GetLongDatabaseInfo(isc_info_current_memory);
  260. end;
  261.  
  262. function TIBDatabaseInfo.GetForcedWrites: Long;
  263. begin
  264.   result := GetLongDatabaseInfo(isc_info_forced_writes);
  265. end;
  266.  
  267. function TIBDatabaseInfo.GetMaxMemory: Long;
  268. begin
  269.   result := GetLongDatabaseInfo(isc_info_max_memory);
  270. end;
  271.  
  272. function TIBDatabaseInfo.GetNumBuffers: Long;
  273. begin
  274.   result := GetLongDatabaseInfo(isc_info_num_buffers);
  275. end;
  276.  
  277. function TIBDatabaseInfo.GetSweepInterval: Long; 
  278. begin
  279.   result := GetLongDatabaseInfo(isc_info_sweep_interval);
  280. end;
  281.  
  282. function TIBDatabaseInfo.GetUserNames: TStringList;
  283. var
  284.   local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
  285.   temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
  286.   DatabaseInfoCommand: Char;
  287.   i, user_length: Integer;
  288. begin
  289.   result := FUserNames;
  290.   DatabaseInfoCommand := Char(isc_info_user_names);
  291.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  292.                         IBHugeLocalBufferLength, local_buffer), True);
  293.   FUserNames.Clear;
  294.   i := 0;
  295.   while local_buffer[i] = Char(isc_info_user_names) do
  296.   begin
  297.     Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
  298.     user_length := Long(local_buffer[i]);
  299.     Inc(i,1);
  300.     Move(local_buffer[i], temp_buffer[0], user_length);
  301.     Inc(i, user_length);
  302.     temp_buffer[user_length] := #0;
  303.     FUserNames.Add(String(temp_buffer));
  304.   end;
  305. end;
  306.  
  307. function TIBDatabaseInfo.GetFetches: Long;
  308. begin
  309.   result := GetLongDatabaseInfo(isc_info_fetches);
  310. end;
  311.  
  312. function TIBDatabaseInfo.GetMarks: Long;
  313. begin
  314.   result := GetLongDatabaseInfo(isc_info_marks);
  315. end;
  316.  
  317. function TIBDatabaseInfo.GetReads: Long;
  318. begin
  319.   result := GetLongDatabaseInfo(isc_info_reads);
  320. end;
  321.  
  322. function TIBDatabaseInfo.GetWrites: Long;
  323. begin
  324.   result := GetLongDatabaseInfo(isc_info_writes);
  325. end;
  326.  
  327. function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
  328. var
  329.   local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
  330.   DatabaseInfoCommand: Char;
  331.   i, qtd_tables, id_table, qtd_operations: Integer;
  332. begin
  333.   if FOperation = nil then FOperation := TStringList.Create;
  334.   result := FOperation;
  335.   DatabaseInfoCommand := Char(DBInfoCommand);
  336.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  337.                          IBHugeLocalBufferLength, local_buffer), True);
  338.   FOperation.Clear;
  339.   { 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
  340.     2. 2 bytes telling how many bytes compose the subsequent value pairs.
  341.     3. A pair of values for each table in the database on wich the requested
  342.       type of operation has occurred since the database was last attached.
  343.     Each pair consists of:
  344.     1. 2 bytes specifying the table ID.
  345.     2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
  346.   }
  347.   qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
  348.   for i := 0 to qtd_tables - 1 do
  349.   begin
  350.     id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
  351.     qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
  352.     FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
  353.   end;
  354. end;
  355.  
  356. function TIBDatabaseInfo.GetBackoutCount: TStringList;
  357. begin
  358.   result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
  359. end;
  360.  
  361. function TIBDatabaseInfo.GetDeleteCount: TStringList;
  362. begin
  363.   result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
  364. end;
  365.  
  366. function TIBDatabaseInfo.GetExpungeCount: TStringList;
  367. begin
  368.   result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
  369. end;
  370.  
  371. function TIBDatabaseInfo.GetInsertCount: TStringList;
  372. begin
  373.   result := GetOperationCounts(isc_info_insert_count,FInsertCount);
  374. end;
  375.  
  376. function TIBDatabaseInfo.GetPurgeCount: TStringList;
  377. begin
  378.   result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
  379. end;
  380.  
  381. function TIBDatabaseInfo.GetReadIdxCount: TStringList;
  382. begin
  383.   result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
  384. end;
  385.  
  386. function TIBDatabaseInfo.GetReadSeqCount: TStringList;
  387. begin
  388.   result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
  389. end;
  390.  
  391. function TIBDatabaseInfo.GetUpdateCount: TStringList;
  392. begin
  393.   result := GetOperationCounts(isc_info_update_count,FUpdateCount);
  394. end;
  395.  
  396. function TIBDatabaseInfo.GetReadOnly: Long;
  397. begin
  398.   result := GetLongDatabaseInfo(isc_info_db_read_only);
  399. end;
  400.  
  401. function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
  402. var
  403.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  404.   length: Integer;
  405.   _DatabaseInfoCommand: Char;
  406. begin
  407.   _DatabaseInfoCommand := Char(DatabaseInfoCommand);
  408.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
  409.                          IBLocalBufferLength, local_buffer), True);
  410.   length := isc_vax_integer(@local_buffer[1], 2);
  411.   result := isc_vax_integer(@local_buffer[3], length);
  412. end;
  413.  
  414. function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
  415. var
  416.   local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  417.   _DatabaseInfoCommand: Char;
  418. begin
  419.   _DatabaseInfoCommand := Char(DatabaseInfoCommand);
  420.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
  421.                          IBBigLocalBufferLength, local_buffer), True);
  422.   local_buffer[4 + Int(local_buffer[3])] := #0;
  423.   result := String(PChar(@local_buffer[4]));
  424. end;
  425.  
  426.  
  427. function TIBDatabaseInfo.GetDBSQLDialect: Integer;
  428. var
  429.   local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  430.   length: Integer;
  431.   DatabaseInfoCommand: Char;
  432. begin
  433.   DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
  434.   Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
  435.                        IBLocalBufferLength, local_buffer), True);
  436.   if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
  437.     result := 1
  438.   else begin
  439.     length := isc_vax_integer(@local_buffer[1], 2);
  440.     result := isc_vax_integer(@local_buffer[3], length);
  441.   end;
  442. end;
  443.  
  444.  
  445. end.
  446.