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); |
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; |
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; |
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; |
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; |
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); |
752 |
|
end; |
753 |
|
end; |
754 |
|
finally |
755 |
< |
while IsServiceRunning do; {flush} |
755 |
> |
WaitForServiceStop; {flush} |
756 |
|
end; |
757 |
|
end; |
758 |
|
|
791 |
|
end; |
792 |
|
finally |
793 |
|
F.Free; |
794 |
< |
while IsServiceRunning do; {flush} |
794 |
> |
WaitForServiceStop; {flush} |
795 |
|
FEof := false; |
796 |
|
end; |
797 |
|
end; |
818 |
|
while not Eof do |
819 |
|
ReceiveNextChunk(S); |
820 |
|
BytesWritten := S.Size - InitialSize; |
821 |
+ |
WaitForServiceStop; |
822 |
|
end; |
823 |
|
|
824 |
|
procedure TIBXClientSideBackupService.BackupToFile(aFileName: string; |
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; |
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; |
1490 |
|
begin |
1491 |
|
SecurityAction := ActionModifyUser; |
1492 |
|
ServiceStart; |
1493 |
< |
while IsServiceRunning do; |
1493 |
> |
WaitForServiceStop; |
1494 |
|
end; |
1495 |
|
|
1496 |
|
function TIBXSecurityService.HasAdminRole: boolean; |
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); |
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); |
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); |
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); |
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; |
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; |
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); |
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); |
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); |
2068 |
|
else |
2069 |
|
AsByte := isc_spb_prp_am_readwrite; |
2070 |
|
InternalServiceStart; |
2071 |
< |
while IsServiceRunning do; |
2071 |
> |
WaitForServiceStop; |
2072 |
|
end; |
2073 |
|
|
2074 |
|
procedure TIBXConfigService.SetNoLinger; |
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 } |
2313 |
|
else |
2314 |
|
GetNextLine; |
2315 |
|
finally |
2316 |
< |
while IsServiceRunning do; {flush} |
2316 |
> |
WaitForServiceStop; {flush} |
2317 |
|
end; |
2318 |
|
end; |
2319 |
|
|
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); |
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; |
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 |
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; |
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 |
|
|