* Added ServiceRunning and WaitForServiceCompletion functions

git-svn-id: trunk@33905 -

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

@@ -1,4 +1,4 @@
-unit FBAdmin;
+unit fbadmin2;
 
 { Interbase/Firebird Administration using the service manager
 
@@ -47,17 +47,14 @@ uses
 
 type
   TIBBackupOption=(IBBkpVerbose,IBBkpIgnoreChecksums,IBBkpIgnoreLimbo,IBBkpMetadataOnly,
-     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert);
+     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert,IBBkpWait);
   TIBBackupOptions= set of TIBBackupOption;
   TIBRestoreOption=(IBResVerbose,IBResDeactivateIdx,IBResNoShadow,IBResNoValidity,
-     IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite,
-     IBFixFssData, IBFixFssMeta);
+     IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,
+     IBResAMReadWrite, IBResWait);
   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 }
 
@@ -65,7 +62,6 @@ type
   private
     FErrorCode: longint;
     FErrorMsg: string;
-    FFixFssDataCharSet: String;
     FHost: string;
     FOnOutput: TIBOnOutput;
     FOutput: TStringList;
@@ -82,6 +78,7 @@ 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;
@@ -94,7 +91,6 @@ 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;
@@ -140,8 +136,12 @@ type
     function GetUsers(Users:TStrings):boolean;
     //Get database server log file
     function GetDatabaseLog:boolean;
-    //Get database statistics
-    function GetDatabaseStats(Database:string;Options:TIBStatOptions;TableNames:String = ''): 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;
     //Database server version
     property ServerVersion:string read FServerVersion;
     //Implementation string of the database server
@@ -154,8 +154,6 @@ 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;
@@ -183,11 +181,15 @@ 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';
@@ -207,11 +209,17 @@ 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
-    raise EIBDatabaseError.CreateFmt(msg,args,nil,GDSErrorCode,'');
+    begin
+    E := EIBDatabaseError.Create(FErrorMsg);
+    E.GDSErrorCode := GDSErrorCode;
+    Raise E;
+    end;
 end;
 
 function TFBAdmin.IBSPBParamSerialize(isccode: byte; value: string): string;
@@ -377,7 +385,7 @@ begin
   inherited Create(AOwner);
   FPort:= 3050;
   FOutput:=TStringList.Create;
-  FFixFssDataCharSet:= '';
+  WaitInterval:=100;
 end;
 
 destructor TFBAdmin.Destroy;
@@ -390,6 +398,7 @@ end;
 
 function TFBAdmin.Connect: boolean;
 var
+  E:EIBDatabaseError;
   Service:string;
   spb:string;
 begin
@@ -398,7 +407,11 @@ begin
   result:=InitialiseIBase60<>0;
   {$EndIf}
   if FSvcHandle<>FB_API_NULLHANDLE then
-    raise EIBDatabaseError.CreateFmt(SErrConnected,[Self.Name],nil,0,'');
+    begin
+    E := EIBDatabaseError.CreateFmt(SErrConnected,[self.Name]);
+    E.GDSErrorCode := 0;
+    Raise E;
+    end;
   Service:='service_mgr';
   case FProtocol of
     IBSPTCPIP:if FPort=3050 then
@@ -454,7 +467,9 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('Backup');
+    result:=GetOutput('Backup')
+  else if (IBBkpWait in Options) then
+    WaitForServiceCompletion(0);
 end;
 
 function TFBAdmin.BackupMultiFile(Database: string; Filenames: TStrings;
@@ -483,9 +498,52 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('BackupMultiFile');
+    result:=GetOutput('BackupMultiFile')
+  else if (IBBkpWait in Options) then
+    WaitForServiceCompletion(0);
 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
@@ -511,10 +569,6 @@ 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;
@@ -524,7 +578,9 @@ begin
     exit;
     end;
   if IBResVerbose in Options then
-    result:=GetOutput('Restore');
+    result:=GetOutput('Restore')
+  else if IBResWait in Options then
+    WaitForServiceCompletion(0);
 end;
 
 
@@ -766,41 +822,5 @@ 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.