ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBServices.pas

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
27	+	{    IBX For Lazarus (Firebird Express)                                  }
28	+	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	+	{    Portions created by MWA Software are copyright McCallum Whyman      }
30	+	{    Associates Ltd 2011                                                 }
31	+	{                                                                        }
32		{************************************************************************}
33
34		{
35		InterBase Express provides component interfaces to
36		functions introduced in InterBase 6.0.  The Services
37	<	components (TIB*Service, TIBServerProperties) and
33	<	Install components (TIBInstall, TIBUninstall, TIBSetup)
37	>	components (TIB*Service, TIBServerProperties)
38		function only if you have installed InterBase 6.0 or
39	<	later software
39	>	later software, including Firebird
40		}
41
42		unit IBServices;
43
44	+	{$Mode Delphi}
45	+	{$IF FPC_FULLVERSION >= 20700 }
46	+	{$codepage UTF8}
47	+	{$ENDIF}
48	+
49		interface
50
51		uses
52	<	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
53	<	IBDialogs, IBHeader, IB, IBExternals;
52	>	{$IFDEF WINDOWS }
53	>	Windows,
54	>	{$ELSE}
55	>	unix,
56	>	{$ENDIF}
57	>	SysUtils, Classes, IBHeader, IB, IBExternals, CustApp;
58
59		const
60		DefaultBufferSize = 32000;
#	Line 86 | Line 99 | type
99		TLoginEvent = procedure(Database: TIBCustomService;
100		LoginParams: TStrings) of object;
101
102	+	{ TIBCustomService }
103	+
104		TIBCustomService = class(TComponent)
105		private
106		FIBLoaded: Boolean;
#	Line 125 | Line 140 | type
140
141		protected
142		procedure Loaded; override;
143	<	function Login: Boolean;
143	>	function Login(var aServerName: string): Boolean;
144		procedure CheckActive;
145		procedure CheckInactive;
146	+	procedure HandleException(Sender: TObject);
147		property OutputBuffer : PChar read FOutputBuffer;
148		property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
149		property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
#	Line 301 | Line 317 | type
317		published
318		end;
319
320	<	TStatOption = (DataPages, DbLog, HeaderPages, IndexPages, SystemRelations);
320	>	TStatOption = (DataPages, {DbLog,} HeaderPages, IndexPages, SystemRelations);
321		TStatOptions = set of TStatOption;
322
323		TIBStatisticalService = class(TIBControlAndQueryService)
#	Line 500 | Line 516 | type
516		implementation
517
518		uses
519	<	IBIntf, IBSQLMonitor;
519	>	IBIntf , IBSQLMonitor, Math;
520
521		{ TIBCustomService }
522
#	Line 508 | Line 524 | procedure TIBCustomService.Attach;
524		var
525		SPB: String;
526		ConnectString: String;
527	+	aServerName: string;
528		begin
529		CheckInactive;
530		CheckServerName;
531
532	<	if FLoginPrompt and not Login then
532	>	aServerName := FServerName;
533	>	if FLoginPrompt and not Login(aServerName) then
534		IBError(ibxeOperationCancelled, [nil]);
535
536		{ Generate a new SPB if necessary }
#	Line 524 | Line 542 | begin
542		Move(SPB[1], FSPB[0], FSPBLength);
543		end;
544		case FProtocol of
545	<	TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
546	<	SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
547	<	NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
545	>	TCP: ConnectString := aServerName + ':service_mgr'; {do not localize}
546	>	SPX: ConnectString := aServerName + '@service_mgr'; {do not localize}
547	>	NamedPipe: ConnectString := '\\' + aServerName + '\service_mgr'; {do not localize}
548		Local: ConnectString := 'service_mgr'; {do not localize}
549		end;
550		if call(isc_service_attach(StatusVector, Length(ConnectString),
#	Line 551 | Line 569 | begin
569		Attach;
570		except
571		if csDesigning in ComponentState then
572	<	Application.HandleException(Self)
572	>	HandleException(self)
573		else
574		raise;
575		end;
576		end;
577
578	<	function TIBCustomService.Login: Boolean;
578	>	function TIBCustomService.Login(var aServerName: string): Boolean;
579		var
580		IndexOfUser, IndexOfPassword: Integer;
581		Username, Password: String;
#	Line 570 | Line 588 | begin
588		LoginParams.Assign(Params);
589		FOnLogin(Self, LoginParams);
590		Params.Assign (LoginParams);
591	+	aServerName := ServerName;
592		finally
593		LoginParams.Free;
594		end;
595		end
596	<	else begin
596	>	else
597	>	if assigned(IBGUIInterface)  then
598	>	begin
599		IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
600		if IndexOfUser <> -1 then
601		Username := Copy(Params[IndexOfUser],
#	Line 585 | Line 606 | begin
606		Password := Copy(Params[IndexOfPassword],
607		Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
608		Length(Params[IndexOfPassword]));
609	<	result := ServerLoginDialog(serverName, Username, Password);
609	>	result := IBGUIInterface.ServerLoginDialog(aServerName, Username, Password);
610		if result then
611		begin
612		IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
#	Line 599 | Line 620 | begin
620		else
621		Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
622		'=' + Password;
623	<	end;
624	<	end;
623	>	end
624	>	end
625	>	else
626	>	IBError(ibxeNoLoginDialog,[]);
627		end;
628
629		procedure TIBCustomService.CheckActive;
#	Line 617 | Line 640 | begin
640		IBError(ibxeServiceInActive, [nil]);
641		end;
642
643	+	procedure TIBCustomService.HandleException(Sender: TObject);
644	+	var aParent: TComponent;
645	+	begin
646	+	aParent := Owner;
647	+	while aParent <> nil do
648	+	begin
649	+	if aParent is TCustomApplication then
650	+	begin
651	+	TCustomApplication(aParent).HandleException(Sender);
652	+	Exit;
653	+	end;
654	+	aParent := aParent.Owner;
655	+	end;
656	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
657	+	end;
658	+
659		constructor TIBCustomService.Create(AOwner: TComponent);
660		begin
661		inherited Create(AOwner);
#	Line 634 | Line 673 | begin
673		FHandle := nil;
674		FLoginPrompt := True;
675		FTraceFlags := [];
676	+	FOutputbuffer := nil;
677	+	FProtocol := Local;
678	+	if (AOwner <> nil) and
679	+	(AOwner is TCustomApplication) and
680	+	TCustomApplication(AOwner).ConsoleApplication then
681	+	LoginPrompt := false;
682		end;
683
684		destructor TIBCustomService.Destroy;
#	Line 646 | Line 691 | begin
691		FSPB := nil;
692		FParams.Free;
693		end;
694	+	ReallocMem(FOutputBuffer, 0);
695		inherited Destroy;
696		end;
697
#	Line 721 | Line 767 | begin
767		if csReading in ComponentState then
768		FStreamedActive := Value
769		else
770	<	if Value then
771	<	Attach
772	<	else
773	<	Detach;
770	>	if Value <> Active then
771	>	if Value then
772	>	Attach
773	>	else
774	>	Detach;
775		end;
776
777		procedure TIBCustomService.SetBufferSize(const Value: Integer);
#	Line 864 | Line 911 | begin
911		SPB := SPB + Char(isc_spb_current_version);
912		{ Iterate through the textual service parameters, constructing
913		a SPB on-the-fly }
914	+	if sl.Count > 0 then
915		for i := 0 to sl.Count - 1 do
916		begin
917		{ Get the parameter's name and value from the list,
#	Line 1367 | Line 1415 | begin
1415		param := 0;
1416		if (DataPages in Options) then
1417		param := param or isc_spb_sts_data_pages;
1418	<	if (DbLog in Options) then
1419	<	param := param or isc_spb_sts_db_log;
1418	>	{  if (DbLog in Options) then
1419	>	param := param or isc_spb_sts_db_log; -- removed from Firebird 2}
1420		if (HeaderPages in Options) then
1421		param := param or isc_spb_sts_hdr_pages;
1422		if (IndexPages in Options) then
#	Line 1480 | Line 1528 | begin
1528		if (Trim(FBackupFile[i]) = '') then continue;
1529		if (Pos('=', FBackupFile[i]) <> 0) then  {mbcs ok}
1530		begin
1531	<	ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1531	>	ServiceStartAddParam(AnsiUpperCase(FBackupFile.Names[i]), isc_spb_bkp_file);
1532		value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1533		param := StrToInt(value);
1534		ServiceStartAddParam(param, isc_spb_bkp_length);
#	Line 1729 | Line 1777 | begin
1777		for i := 0 to High(FUserInfo) do
1778		FUserInfo[i].Free;
1779		FUserInfo := nil;
1780	<	inherited destroy;
1780	>	inherited Destroy;
1781		end;
1782
1783		procedure TIBSecurityService.FetchUserInfo;
#	Line 1795 | Line 1843 | end;
1843
1844		function TIBSecurityService.GetUserInfoCount: Integer;
1845		begin
1846	<	Result := High(FUSerInfo);
1846	>	Result := Max(High(FUSerInfo),0);
1847		end;
1848
1849		procedure TIBSecurityService.AddUser;
#	Line 2043 | Line 2091 | end;
2091		destructor TDatabaseInfo.Destroy;
2092		begin
2093		DbName := nil;
2094	<	inherited;
2094	>	inherited Destroy;
2095		end;
2096
2097		{ TLicenseInfo }
#	Line 2060 | Line 2108 | begin
2108		Key := nil;
2109		Id := nil;
2110		Desc := nil;
2111	<	inherited;
2111	>	inherited Destroy;
2112		end;
2113
2114		{ TConfigFileData }
#	Line 2075 | Line 2123 | destructor TConfigFileData.Destroy;
2123		begin
2124		ConfigFileValue := nil;
2125		ConfigFileKey := nil;
2126	<	inherited;
2126	>	inherited Destroy;
2127		end;
2128
2129		{ TConfigParams }
#	Line 2090 | Line 2138 | destructor TConfigParams.Destroy;
2138		begin
2139		ConfigFileData.Free;
2140		ConfigFileParams := nil;
2141	<	inherited;
2141	>	inherited Destroy;
2142		end;
2143
2144		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines