* Revert rev r33905, started from too old version

git-svn-id: trunk@33912 -

packages/fcl-db/src/sqldb/interbase/fbadmin.pp

@@ -1,4 +1,4 @@
-unit fbadmin;
+unit FBAdmin;
 
 { Interbase/Firebird Administration using the service manager
 
@@ -47,14 +47,17 @@ uses
 
 type
   TIBBackupOption=(IBBkpVerbose,IBBkpIgnoreChecksums,IBBkpIgnoreLimbo,IBBkpMetadataOnly,
-     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert,IBBkpWait);
+     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert);
   TIBBackupOptions= set of TIBBackupOption;
   TIBRestoreOption=(IBResVerbose,IBResDeactivateIdx,IBResNoShadow,IBResNoValidity,
-     IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,
-     IBResAMReadWrite, IBResWait);
+     IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite,
+     IBFixFssData, IBFixFssMeta);
   TIBRestoreOptions= set of TIBRestoreOption;
   TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
   TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
+  TIBStatOption = (IBDataPages, IBDbLog, IBHeaderPages, IBIndexPages, IBSystemRelations,
+    IBRecordVersions, IBStatTables);
+  TIBStatOptions = set of TIBStatOption;
 
   { TFBAdmin }
 
@@ -62,6 +65,7 @@ type
   private
     FErrorCode: longint;
     FErrorMsg: string;
+    FFixFssDataCharSet: String;
     FHost: string;
     FOnOutput: TIBOnOutput;
     FOutput: TStringList;
@@ -78,7 +82,6 @@ type
     FSvcHandle: isc_svc_handle;
     FUseExceptions: boolean;
     FUser: string;
-    FWaitInterval: Integer;
     function CheckConnected(ProcName: string):boolean;
     procedure CheckError(ProcName : string; Status : PISC_STATUS);
     function GetDBInfo:boolean;
@@ -91,6 +94,7 @@ type
     function IBSPBParamSerialize(isccode:byte;value:longint):string;
     function MakeBackupOptions(options:TIBBackupOptions):longint;
     function MakeRestoreOptions(options:TIBRestoreOptions):longint;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -136,12 +140,8 @@ type
     function GetUsers(Users:TStrings):boolean;
     //Get database server log file
     function GetDatabaseLog:boolean;
-    // For Backup, Restore this will check if the service call is still running.
-    function ServiceRunning: Boolean;
-    // Wait till the service stops running, or until aTimeout (in milliseconds) is reached.
-    // Return true if the service stopped, false if timeout reached.
-    // WaitInterval is the interval (in milliseconds) between ServiceRunning calls.
-    function WaitForServiceCompletion(aTimeOut: Integer): Boolean;
+    //Get database statistics
+    function GetDatabaseStats(Database:string;Options:TIBStatOptions;TableNames:String = ''): boolean;
     //Database server version
     property ServerVersion:string read FServerVersion;
     //Implementation string of the database server
@@ -154,6 +154,8 @@ type
     property ServerMsgDir:string read FServerMsgDir;
     //Path to the security database in use by the server
     property ServerSecDBDir:string read FServerSecDBDir;
+    // FixFxxData/FixFxxMetaData code page
+    property FixFssDataCharSet: String read FFixFssDataCharSet write FFixFssDataCharSet;
   published
     //User name to connect to service manager
     property User: string read FUser write FUser;
@@ -181,15 +183,11 @@ type
     //Event handler for Service output messages
     //Used in Backup and Restore operations and GetLog
     property OnOutput: TIBOnOutput read FOnOutput write FOnOutput;
-    // Interval (in milliseconds) to sleep while waiting for the service operation to end.
-    Property WaitInterval : Integer Read FWaitInterval Write FWaitInterval;
   end;
 
 
 implementation
 
-uses dateutils;
-
 resourcestring
   SErrNotConnected = '%s : %s : Not connected.';
   SErrError = '%s : %s : %s';
@@ -209,17 +207,11 @@ end;
 
 procedure TFBAdmin.IBRaiseError(GDSErrorCode: Longint; const msg: string;
   const args: array of const);
-var
-  E:EIBDatabaseError;
 begin
-  FErrorMsg:=format(msg,args);
+  FErrorMsg:=Format(msg,args);
   FErrorCode:=GDSErrorCode;
   if FUseExceptions then
-    begin
-    E := EIBDatabaseError.Create(FErrorMsg);
-    E.GDSErrorCode := GDSErrorCode;
-    Raise E;
-    end;
+    raise EIBDatabaseError.CreateFmt(msg,args,nil,GDSErrorCode,'');
 end;
 
 function TFBAdmin.IBSPBParamSerialize(isccode: byte; value: string): string;
@@ -385,7 +377,7 @@ begin
   inherited Create(AOwner);
   FPort:= 3050;
   FOutput:=TStringList.Create;
-  WaitInterval:=100;
+  FFixFssDataCharSet:= '';
 end;
 
 destructor TFBAdmin.Destroy;
@@ -398,7 +390,6 @@ end;
 
 function TFBAdmin.Connect: boolean;
 var
-  E:EIBDatabaseError;
   Service:string;
   spb:string;
 begin
@@ -407,11 +398,7 @@ begin
   result:=InitialiseIBase60<>0;
   {$EndIf}
   if FSvcHandle<>FB_API_NULLHANDLE then
-    begin
-    E := EIBDatabaseError.CreateFmt(SErrConnected,[self.Name]);
-    E.GDSErrorCode := 0;
-    Raise E;
-    end;
+    raise EIBDatabaseError.CreateFmt(SErrConnected,[Self.Name],nil,0,'');
   Service:='service_mgr';
   case FProtocol of
     IBSPTCPIP:if FPort=3050 then
@@ -467,9 +454,7 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('Backup')
-  else if (IBBkpWait in Options) then
-    WaitForServiceCompletion(0);
+    result:=GetOutput('Backup');
 end;
 
 function TFBAdmin.BackupMultiFile(Database: string; Filenames: TStrings;
@@ -498,52 +483,9 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('BackupMultiFile')
-  else if (IBBkpWait in Options) then
-    WaitForServiceCompletion(0);
+    result:=GetOutput('BackupMultiFile');
 end;
 
-Function TFBAdmin.ServiceRunning : Boolean;
-
-const
-  BUFFERSIZE=1000;
-
-var
-  res:integer;
-  buffer: string;
-  spb:string;
-
-begin
-  FOutput.Clear;
-  spb:=chr(isc_info_svc_running);
-  setlength(buffer,BUFFERSIZE);
-  result:=isc_service_query(@FStatus[0], @FSvcHandle, nil, 0, nil, length(spb),
-          @spb[1],BUFFERSIZE,@buffer[1])=0;
-  if Not Result then
-    CheckError('ServiceRunning',FSTatus);
-  if (Buffer[1]=Char(isc_info_svc_running)) then
-    begin
-    res:=isc_vax_integer(@Buffer[2],4);
-    Result:=res=1;
-    end
-  else
-    IBRaiseError(0,'%s: Service status detection returned wrong result',[self.Name]);
-end;
-
-Function TFBAdmin.WaitForServiceCompletion(aTimeOut : Integer) : Boolean;
-
-Var
-  N : TDateTime;
-
-begin
-  N:=Now;
-  Repeat
-    Sleep(WaitInterval);
-    Result:=not ServiceRunning;
-  until Result or ((aTimeOut<>0) and (MilliSecondsBetween(Now,N)>aTimeOut*WaitInterval));
-end;
-
-
 function TFBAdmin.Restore(Database, Filename: string;
   Options: TIBRestoreOptions; RoleName: string): boolean;
 var
@@ -569,6 +511,10 @@ begin
     else
       spb:=spb+chr(isc_spb_res_access_mode)+chr(isc_spb_res_am_readwrite);
     end;
+  if (IBFixFssData in Options) and (FixFssDataCharSet > ' ') then
+    spb:=spb+IBSPBParamSerialize(isc_spb_res_fix_fss_data, FixFssDataCharSet);
+  if (IBFixFssMeta in Options) and (FixFssDataCharSet > ' ') then
+    spb:=spb+IBSPBParamSerialize(isc_spb_res_fix_fss_metadata, FixFssDataCharSet);
   spb:=spb+IBSPBParamSerialize(isc_spb_options,MakeRestoreOptions(Options));
   result:=isc_service_start(@FStatus[0], @FSvcHandle, nil, length(spb),
     @spb[1])=0;
@@ -578,9 +524,7 @@ begin
     exit;
     end;
   if IBResVerbose in Options then
-    result:=GetOutput('Restore')
-  else if IBResWait in Options then
-    WaitForServiceCompletion(0);
+    result:=GetOutput('Restore');
 end;
 
 
@@ -822,5 +766,41 @@ begin
   result:=GetOutput('GetLogFile');
 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.