fbintf/client/FBServices.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBServices;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB,  FBParamBlock, FBActivityMonitor;

type

  { TFBServiceManager }

  TFBServiceManager = class(TFBInterfacedObject)
  private
    FFirebirdAPI: IFirebirdAPI;
    FProtocol: TProtocol;
    FServerName: string;
    procedure CheckServerName;
  protected
    FSPB: ISPB;
    procedure InternalAttach(ConnectString: string); virtual; abstract;
  public
    constructor Create(ServerName: string; Protocol: TProtocol; SPB: ISPB);
    destructor Destroy; override;
  public
    {IServiceManager}
    function getSPB: ISPB;
    function getServerName: string;
    procedure Attach;
    procedure Detach(Force: boolean=false); virtual; abstract;
    function AllocateSRB: ISRB;
    function AllocateSQPB: ISQPB;
    function Query(SQPB: ISQPB; Request: ISRB): IServiceQueryResults; virtual; abstract; overload;
    function Query(Request: ISRB): IServiceQueryResults;  overload;
  end;

implementation

uses FBMessages, FBClientAPI;

{ TFBServiceManager }

procedure TFBServiceManager.CheckServerName;
begin
  if (FServerName = '') and (FProtocol <> Local) then
    IBError(ibxeServerNameMissing, [nil]);
end;

constructor TFBServiceManager.Create(ServerName: string; Protocol: TProtocol;
  SPB: ISPB);
begin
  inherited Create;
  FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
  FProtocol := Protocol;
  FSPB := SPB;
  FServerName := ServerName;
  Attach;
end;

destructor TFBServiceManager.Destroy;
begin
  Detach(true);
  inherited Destroy;
end;

function TFBServiceManager.getSPB: ISPB;
begin
  Result := FSPB;
end;

function TFBServiceManager.getServerName: string;
begin
  Result := FServerName;
end;

procedure TFBServiceManager.Attach;
var ConnectString: String;
begin
  case FProtocol of
    TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
    SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
    NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
    Local: ConnectString := 'service_mgr'; {do not localize}
  end;
  InternalAttach(ConnectString);
end;

function TFBServiceManager.AllocateSRB: ISRB;
begin
  Result := TSRB.Create;
end;

function TFBServiceManager.AllocateSQPB: ISQPB;
begin
   Result := TSQPB.Create;
end;

function TFBServiceManager.Query(Request: ISRB): IServiceQueryResults;
begin
   Result := Query(nil,Request);
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	3642 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API. Although predominantly
4			* a new development they include source code taken from IBX and may be
5			* considered a derived product. This software thus also includes the copyright
6			* notice and license conditions from IBX.
7			*
8			* Except for those parts dervied from IBX, contents of this file are subject
9			* to the Initial Developer's Public License Version 1.0 (the "License"); you
10			* may not use this file except in compliance with the License. You may obtain a
11			* copy of the License here:
12			*
13			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14			*
15			* Software distributed under the License is distributed on an "AS
16			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17			* implied. See the License for the specific language governing rights
18			* and limitations under the License.
19			*
20			* The Initial Developer of the Original Code is Tony Whyman.
21			*
22			* The Original Code is (C) 2016 Tony Whyman, MWA Software
23			* (http://www.mwasoftware.co.uk).
24			*
25			* All Rights Reserved.
26			*
27			* Contributor(s): ______________________________________.
28			*
29			*)
30			unit FBServices;
31
32			{$IFDEF FPC}
33			{$mode objfpc}{$H+}
34			{$interfaces COM}
35			{$ENDIF}
36
37			interface
38
39			uses
40			Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
41
42			type
43
44			{ TFBServiceManager }
45
46			TFBServiceManager = class(TFBInterfacedObject)
47			private
48			FFirebirdAPI: IFirebirdAPI;
49			FProtocol: TProtocol;
50			FServerName: string;
51			procedure CheckServerName;
52			protected
53			FSPB: ISPB;
54			procedure InternalAttach(ConnectString: string); virtual; abstract;
55			public
56			constructor Create(ServerName: string; Protocol: TProtocol; SPB: ISPB);
57			destructor Destroy; override;
58			public
59			{IServiceManager}
60			function getSPB: ISPB;
61			function getServerName: string;
62			procedure Attach;
63			procedure Detach(Force: boolean=false); virtual; abstract;
64			function AllocateSRB: ISRB;
65			function AllocateSQPB: ISQPB;
66			function Query(SQPB: ISQPB; Request: ISRB): IServiceQueryResults; virtual; abstract; overload;
67			function Query(Request: ISRB): IServiceQueryResults; overload;
68			end;
69
70			implementation
71
72			uses FBMessages, FBClientAPI;
73
74			{ TFBServiceManager }
75
76			procedure TFBServiceManager.CheckServerName;
77			begin
78			if (FServerName = '') and (FProtocol <> Local) then
79			IBError(ibxeServerNameMissing, [nil]);
80			end;
81
82			constructor TFBServiceManager.Create(ServerName: string; Protocol: TProtocol;
83			SPB: ISPB);
84			begin
85			inherited Create;
86			FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
87			FProtocol := Protocol;
88			FSPB := SPB;
89			FServerName := ServerName;
90			Attach;
91			end;
92
93			destructor TFBServiceManager.Destroy;
94			begin
95			Detach(true);
96			inherited Destroy;
97			end;
98
99			function TFBServiceManager.getSPB: ISPB;
100			begin
101			Result := FSPB;
102			end;
103
104			function TFBServiceManager.getServerName: string;
105			begin
106			Result := FServerName;
107			end;
108
109			procedure TFBServiceManager.Attach;
110			var ConnectString: String;
111			begin
112			case FProtocol of
113			TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
114			SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
115			NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
116			Local: ConnectString := 'service_mgr'; {do not localize}
117			end;
118			InternalAttach(ConnectString);
119			end;
120
121			function TFBServiceManager.AllocateSRB: ISRB;
122			begin
123			Result := TSRB.Create;
124			end;
125
126			function TFBServiceManager.AllocateSQPB: ISQPB;
127			begin
128			Result := TSQPB.Create;
129			end;
130
131			function TFBServiceManager.Query(Request: ISRB): IServiceQueryResults;
132			begin
133			Result := Query(nil,Request);
134			end;
135
136			end.
137