ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBXServices.pas
(Generate patch)

Comparing ibx/trunk/runtime/nongui/IBXServices.pas (file contents):
Revision 271 by tony, Fri Dec 28 10:44:23 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

# Line 85 | Line 85 | type
85      procedure HandleException(Sender: TObject);
86      procedure HandleSecContextException(Sender: TIBXControlService; var action: TSecContextAction);
87      function Login(var aServerName: string; LoginParams: TStrings): Boolean;
88 +    procedure ParseServerVersionNo;
89      procedure ParamsChanging(Sender: TObject);
90      procedure SetConfigOverrides(AValue: TStrings);
91      procedure SetConnectString(AValue: string);
# Line 93 | Line 94 | type
94      procedure SetPortNo(AValue: string);
95      procedure SetProtocol(AValue: TProtocol);
96      procedure SetServerName(AValue: string);
97 +    procedure SetServiceIntf(AValue: IServiceManager); overload;
98      procedure SetWireCompression(AValue: boolean);
99    protected
100      procedure DoConnect; override;
# Line 111 | Line 113 | type
113        omitting any parameters not appropriate for Services API. Typically, the
114        DBParams are TIBDatabase.Params}
115      procedure SetDBParams(DBParams: TStrings);
116 +    procedure SetServiceIntf(aServiceIntf: IServiceManager; aDatabase: TIBDatabase); overload;
117      property FirebirdAPI: IFirebirdAPI read GetFirebirdAPI;
118      property ServerVersionNo[index: integer]: integer read GetServerVersionNo;
119 <    property ServiceIntf: IServiceManager read FService;
119 >    property ServiceIntf: IServiceManager read FService write SetServiceIntf;
120    published
121      property Connected;
122      property ConnectString: string read FConnectString write SetConnectString;
# Line 248 | Line 251 | end;
251     procedure DoServiceQuery; override;
252     procedure SetServiceStartOptions; virtual;
253     procedure ServiceStart; virtual;
254 +   procedure WaitForServiceStop(AbortAfter: integer=5 {seconds});
255     property DatabaseName: string read FDatabaseName write SetDatabaseName;
256   public
257     procedure Assign(Source: TPersistent); override;
# Line 662 | Line 666 | end;
666      procedure FixErrors(GlobalAction: TTransactionGlobalAction; OutputLog: TStrings);
667    end;
668  
669 + function IsGbakFile(aFileName: string): boolean;
670 +
671   implementation
672  
673   uses FBMessages, IBUtils, RegExpr, CustApp, IBErrorCodes;
# Line 701 | Line 707 | const
707      isc_spb_expected_db
708    );
709  
710 + function IsGbakFile(aFileName: string): boolean;
711 + const
712 +  Signature = #$00#$02#$04;
713 + var F: TFilestream;
714 +    Buffer: array [1..3] of char;
715 + begin
716 +  Result := false;
717 +  F := TFileStream.Create(aFileName,fmOpenRead);
718 +  try
719 +    F.Read(Buffer,3);
720 +    Result := CompareText(Buffer,Signature) = 0;
721 +  finally
722 +    F.Free;
723 +  end;
724 + end;
725 +
726    { TIBXClientSideRestoreService }
727  
728   procedure TIBXClientSideRestoreService.Execute(OutputLog: TStrings);
# Line 730 | Line 752 | begin
752        end;
753      end;
754    finally
755 <    while IsServiceRunning do; {flush}
755 >    WaitForServiceStop; {flush}
756    end;
757   end;
758  
# Line 769 | Line 791 | begin
791        end;
792      finally
793        F.Free;
794 <      while IsServiceRunning do; {flush}
794 >      WaitForServiceStop; {flush}
795        FEof := false;
796      end;
797    end;
# Line 796 | Line 818 | begin
818    while not Eof do
819      ReceiveNextChunk(S);
820    BytesWritten := S.Size - InitialSize;
821 +  WaitForServiceStop;
822   end;
823  
824   procedure TIBXClientSideBackupService.BackupToFile(aFileName: string;
# Line 1326 | Line 1349 | begin
1349        ServiceStart; {Fix is implicit in non-zero list of Limbo transactions}
1350        while not Eof do
1351          OutputLog.Add(GetNextLine);
1352 <      while IsServiceRunning do;
1352 >      WaitForServiceStop;
1353        Clear;
1354      end;
1355   end;
# Line 1435 | Line 1458 | end;
1458    begin
1459      SecurityAction := ActionAddUser;
1460      ServiceStart;
1461 <    while IsServiceRunning do;
1461 >    WaitForServiceStop;
1462    end;
1463  
1464    procedure TIBXSecurityService.DeleteUser;
1465    begin
1466      SecurityAction := ActionDeleteUser;
1467      ServiceStart;
1468 <    while IsServiceRunning do;
1468 >    WaitForServiceStop;
1469    end;
1470  
1471    procedure TIBXSecurityService.DisplayUsers;
# Line 1467 | Line 1490 | end;
1490    begin
1491      SecurityAction := ActionModifyUser;
1492      ServiceStart;
1493 <    while IsServiceRunning do;
1493 >    WaitForServiceStop;
1494    end;
1495  
1496    function TIBXSecurityService.HasAdminRole: boolean;
# Line 1490 | Line 1513 | end;
1513      else
1514        SRB.Add(isc_action_svc_drop_mapping);
1515      InternalServiceStart;
1516 <    while IsServiceRunning do;
1516 >    WaitForServiceStop;
1517    end;
1518  
1519    procedure TIBXSecurityService.SetSecurityAction (Value: TSecurityAction);
# Line 1960 | Line 1983 | begin
1983    else
1984      SRB.Add(isc_spb_prp_deny_new_attachments).AsInteger := Wait;
1985    InternalServiceStart;
1986 <  while IsServiceRunning do;
1986 >  WaitForServiceStop;
1987   end;
1988  
1989   procedure TIBXConfigService.SetSweepInterval(Value: Integer);
# Line 1970 | Line 1993 | begin
1993    AddDBNameToSRB;
1994    SRB.Add(isc_spb_prp_sweep_interval).AsInteger := Value;
1995    InternalServiceStart;
1996 <  while IsServiceRunning do;
1996 >  WaitForServiceStop;
1997   end;
1998  
1999   procedure TIBXConfigService.SetDBSqlDialect(Value: Integer);
# Line 1979 | Line 2002 | begin
2002    AddDBNameToSRB;
2003    SRB.Add(isc_spb_prp_set_sql_dialect).AsInteger := Value;
2004    InternalServiceStart;
2005 <  while IsServiceRunning do;
2005 >  WaitForServiceStop;
2006   end;
2007  
2008   procedure TIBXConfigService.SetPageBuffers(Value: Integer);
# Line 1988 | Line 2011 | begin
2011    AddDBNameToSRB;
2012    SRB.Add(isc_spb_prp_page_buffers).AsInteger := Value;
2013    InternalServiceStart;
2014 <  while IsServiceRunning do;
2014 >  WaitForServiceStop;
2015   end;
2016  
2017   procedure TIBXConfigService.ActivateShadow;
# Line 1997 | Line 2020 | begin
2020    AddDBNameToSRB;
2021    SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_activate;
2022    InternalServiceStart;
2023 <  while IsServiceRunning do;
2023 >  WaitForServiceStop;
2024   end;
2025  
2026   procedure TIBXConfigService.BringDatabaseOnline;
# Line 2006 | Line 2029 | begin
2029    AddDBNameToSRB;
2030    SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_db_online;
2031    InternalServiceStart;
2032 <  while IsServiceRunning do;
2032 >  WaitForServiceStop;
2033   end;
2034  
2035   procedure TIBXConfigService.SetReserveSpace(Value: Boolean);
# Line 2019 | Line 2042 | begin
2042    else
2043      AsByte := isc_spb_prp_res_use_full;
2044    InternalServiceStart;
2045 <  while IsServiceRunning do;
2045 >  WaitForServiceStop;
2046   end;
2047  
2048   procedure TIBXConfigService.SetAsyncMode(Value: Boolean);
# Line 2032 | Line 2055 | begin
2055    else
2056      AsByte := isc_spb_prp_wm_sync;
2057    InternalServiceStart;
2058 <  while IsServiceRunning do;
2058 >  WaitForServiceStop;
2059   end;
2060  
2061   procedure TIBXConfigService.SetReadOnly(Value: Boolean);
# Line 2045 | Line 2068 | begin
2068    else
2069      AsByte := isc_spb_prp_am_readwrite;
2070    InternalServiceStart;
2071 <  while IsServiceRunning do;
2071 >  WaitForServiceStop;
2072   end;
2073  
2074   procedure TIBXConfigService.SetNoLinger;
# Line 2054 | Line 2077 | begin
2077    AddDBNameToSRB;
2078    SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_nolinger;
2079    InternalServiceStart;
2080 <  while IsServiceRunning do;
2080 >  WaitForServiceStop;
2081   end;
2082  
2083   { TIBXLogService }
# Line 2290 | Line 2313 | begin
2313        else
2314          GetNextLine;
2315    finally
2316 <    while IsServiceRunning do; {flush}
2316 >    WaitForServiceStop; {flush}
2317    end;
2318   end;
2319  
# Line 2446 | Line 2469 | begin
2469    InternalServiceStart;
2470   end;
2471  
2472 + procedure TIBXControlService.WaitForServiceStop(AbortAfter: integer);
2473 + var WaitUntil: TDateTime;
2474 + begin
2475 +  WaitUntil := Now + EncodeTime(0,0,AbortAfter,0);
2476 +  while IsServiceRunning do
2477 +  begin
2478 +    sleep(500);
2479 +    if Now > WaitUntil then Exit;
2480 +  end;
2481 + end;
2482 +
2483   procedure TIBXControlService.Assign(Source: TPersistent);
2484   begin
2485    inherited Assign(Source);
# Line 2974 | Line 3008 | begin
3008      IBError(ibxeNoLoginDialog,[]);
3009   end;
3010  
3011 + procedure TIBXServicesConnection.ParseServerVersionNo;
3012 + var Req: ISRB;
3013 +    Results: IServiceQueryResults;
3014 +    RegexObj: TRegExpr;
3015 +    s: string;
3016 + begin
3017 +  Req := FService.AllocateSRB;
3018 +  Req.Add(isc_info_svc_server_version);
3019 +  Results := FService.Query(nil,Req);
3020 +  if (Results.Count = 1) and (Results[0].getItemType = isc_info_svc_server_version) then
3021 +  RegexObj := TRegExpr.Create;
3022 +  try
3023 +    {extact database file spec}
3024 +    RegexObj.ModifierG := false; {turn off greedy matches}
3025 +    RegexObj.Expression := '[A-Z][A-Z]-V([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+) .*';
3026 +    s := Results[0].AsString;
3027 +    if RegexObj.Exec(s) then
3028 +    begin
3029 +      FServerVersionNo[1] := StrToInt(RegexObj.Match[1]);
3030 +      FServerVersionNo[2] := StrToInt(RegexObj.Match[2]);
3031 +      FServerVersionNo[3] := StrToInt(RegexObj.Match[3]);
3032 +      FServerVersionNo[4] := StrToInt(RegexObj.Match[4]);
3033 +    end;
3034 +  finally
3035 +    RegexObj.Free;
3036 +  end;
3037 + end;
3038 +
3039   procedure TIBXServicesConnection.ParamsChanging(Sender: TObject);
3040   begin
3041    CheckInactive;
# Line 3023 | Line 3085 | begin
3085    FConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPortNo);
3086   end;
3087  
3088 + procedure TIBXServicesConnection.SetServiceIntf(AValue: IServiceManager);
3089 + begin
3090 +  SetServiceIntf(AValue,nil);
3091 + end;
3092 +
3093   procedure TIBXServicesConnection.SetWireCompression(AValue: boolean);
3094   var Index: integer;
3095   begin
# Line 3038 | Line 3105 | end;
3105  
3106   procedure TIBXServicesConnection.DoConnect;
3107  
3041  procedure ParseServerVersionNo;
3042  var Req: ISRB;
3043      Results: IServiceQueryResults;
3044      RegexObj: TRegExpr;
3045      s: string;
3046  begin
3047    Req := FService.AllocateSRB;
3048    Req.Add(isc_info_svc_server_version);
3049    Results := FService.Query(nil,Req);
3050    if (Results.Count = 1) and (Results[0].getItemType = isc_info_svc_server_version) then
3051    RegexObj := TRegExpr.Create;
3052    try
3053      {extact database file spec}
3054      RegexObj.ModifierG := false; {turn off greedy matches}
3055      RegexObj.Expression := '[A-Z][A-Z]-V([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+) .*';
3056      s := Results[0].AsString;
3057      if RegexObj.Exec(s) then
3058      begin
3059        FServerVersionNo[1] := StrToInt(RegexObj.Match[1]);
3060        FServerVersionNo[2] := StrToInt(RegexObj.Match[2]);
3061        FServerVersionNo[3] := StrToInt(RegexObj.Match[3]);
3062        FServerVersionNo[4] := StrToInt(RegexObj.Match[4]);
3063      end;
3064    finally
3065      RegexObj.Free;
3066    end;
3067  end;
3068
3108   var aServerName: string;
3109      aProtocol: TProtocolAll;
3110      aPortNo: string;
# Line 3245 | Line 3284 | begin
3284    end;
3285   end;
3286  
3287 + procedure TIBXServicesConnection.SetServiceIntf(aServiceIntf: IServiceManager;
3288 +  aDatabase: TIBDatabase);
3289 + var i: integer;
3290 +    var aServerName,aDatabaseName: AnsiString;
3291 +        aProtocol: TProtocolAll;
3292 +        aPortNo: AnsiString;
3293 + begin
3294 +  if FService = aServiceIntf then Exit;
3295 +  if FService <> nil then
3296 +  begin
3297 +    if Assigned(BeforeDisconnect) then
3298 +      BeforeDisconnect(self);
3299 +    for i := 0 to Length(FIBXServices) - 1 do
3300 +      FIBXServices[i].OnBeforeDisconnect(self);
3301 +    FService := nil;
3302 +    if Assigned(AfterDisconnect) then
3303 +      AfterDisconnect(self);
3304 +  end;
3305 +  FFirebirdAPI := nil;
3306 +  if aServiceIntf <> nil then
3307 +  begin
3308 +    if Assigned(BeforeConnect) then
3309 +      BeforeConnect(self);
3310 +    FService := aServiceIntf;
3311 +    ParseServerVersionNo;
3312 +    FServername := FService.getServerName;
3313 +    FProtocol := FService.getProtocol;
3314 +    FPortNo := FService.getPortNo;
3315 +    FConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPortNo);
3316 +    if FFirebirdLibraryPathName <> '' then
3317 +      FFirebirdLibraryPathName := FService.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath;
3318 +    if aDatabase <> nil then
3319 +    begin
3320 +      if ParseConnectString(aDatabase.DatabaseName,aServerName,aDatabaseName,aProtocol,aPortNo) then
3321 +        for i := low(FIBXServices) to high(FIBXServices) do
3322 +          FIBXServices[i].OnAfterConnect(self,aDatabaseName);
3323 +    end;
3324 +    if Assigned(AfterConnect) then
3325 +      AfterConnect(self);
3326 +  end;
3327 + end;
3328 +
3329   end.
3330  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines