Browse Source

* Patch from Michal Gawrycki to add GetDatabaseStats (Bug ID 26334)

git-svn-id: trunk@27942 -
michael 11 years ago
parent
commit
f8e828ac46
1 changed files with 41 additions and 0 deletions
  1. 41 0
      packages/fcl-db/src/sqldb/interbase/fbadmin.pp

+ 41 - 0
packages/fcl-db/src/sqldb/interbase/fbadmin.pp

@@ -54,6 +54,9 @@ type
   TIBRestoreOptions= set of TIBRestoreOption;
   TIBRestoreOptions= set of TIBRestoreOption;
   TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
   TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
   TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
   TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
+  TIBStatOption = (IBDataPages, IBDbLog, IBHeaderPages, IBIndexPages, IBSystemRelations,
+    IBRecordVersions, IBStatTables);
+  TIBStatOptions = set of TIBStatOption;
 
 
   { TFBAdmin }
   { TFBAdmin }
 
 
@@ -135,6 +138,8 @@ type
     function GetUsers(Users:TStrings):boolean;
     function GetUsers(Users:TStrings):boolean;
     //Get database server log file
     //Get database server log file
     function GetDatabaseLog:boolean;
     function GetDatabaseLog:boolean;
+    //Get database statistics
+    function GetDatabaseStats(Database:string;Options:TIBStatOptions;TableNames:String = ''): boolean;
     //Database server version
     //Database server version
     property ServerVersion:string read FServerVersion;
     property ServerVersion:string read FServerVersion;
     //Implementation string of the database server
     //Implementation string of the database server
@@ -763,5 +768,41 @@ begin
   result:=GetOutput('GetLogFile');
   result:=GetOutput('GetLogFile');
 end;
 end;
 
 
+function TFBAdmin.GetDatabaseStats(Database:string;Options: TIBStatOptions; TableNames: String
+  ): boolean;
+var
+  spb:string;
+  param: Integer;
+begin
+  Result:=CheckConnected('GetDatabaseStats');
+  param := 0;
+  if (IBDataPages in Options) then
+    param := param or isc_spb_sts_data_pages;
+  if (IBDbLog in Options) then
+    param := param or isc_spb_sts_db_log;
+  if (IBHeaderPages in Options) then
+    param := param or isc_spb_sts_hdr_pages;
+  if (IBIndexPages in Options) then
+    param := param or isc_spb_sts_idx_pages;
+  if (IBSystemRelations in Options) then
+    param := param or isc_spb_sts_sys_relations;
+  if (IBRecordVersions in Options) then
+    param := param or isc_spb_sts_record_versions;
+  if (IBStatTables in Options) then
+    param := param or isc_spb_sts_table;
+  spb  := Char(isc_action_svc_db_stats)+IBSPBParamSerialize(isc_spb_dbname,Database)+
+    IBSPBParamSerialize(isc_spb_options, param);
+  if (IBStatTables in Options) and (TableNames <> '') then
+    spb := spb+IBSPBParamSerialize(isc_spb_command_line, TableNames);
+  Result:=isc_service_start(@FStatus[0], @FSvcHandle, nil, length(spb),
+    @spb[1])=0;
+  if not Result then
+    begin
+    CheckError('GetDatabaseStats',FStatus);
+    exit;
+    end;
+  Result:=GetOutput('GetDatabaseStats');
+end;
+
 end.
 end.