ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBServices.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
File size: 3713 byte(s)
Log Message:
Committing updates for Trunk

File Contents

# Content
1 (*
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 {$IFDEF MSWINDOWS}
32 {$DEFINE WINDOWS}
33 {$ENDIF}
34
35 {$IFDEF FPC}
36 {$mode delphi}
37 {$interfaces COM}
38 {$ENDIF}
39
40 interface
41
42 uses
43 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
44
45 type
46
47 { TFBServiceManager }
48
49 TFBServiceManager = class(TFBInterfacedObject)
50 private
51 FFirebirdAPI: IFirebirdAPI;
52 FProtocol: TProtocol;
53 FServerName: AnsiString;
54 procedure CheckServerName;
55 protected
56 FSPB: ISPB;
57 procedure InternalAttach(ConnectString: AnsiString); virtual; abstract;
58 public
59 constructor Create(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB);
60 destructor Destroy; override;
61 public
62 {IServiceManager}
63 function getSPB: ISPB;
64 function getServerName: AnsiString;
65 procedure Attach;
66 procedure Detach(Force: boolean=false); virtual; abstract;
67 function AllocateSRB: ISRB;
68 function AllocateSQPB: ISQPB;
69 function Query(SQPB: ISQPB; Request: ISRB): IServiceQueryResults; overload; virtual; abstract;
70 function Query(Request: ISRB): IServiceQueryResults; overload;
71 end;
72
73 implementation
74
75 uses FBMessages, FBClientAPI;
76
77 { TFBServiceManager }
78
79 procedure TFBServiceManager.CheckServerName;
80 begin
81 if (FServerName = '') and (FProtocol <> Local) then
82 IBError(ibxeServerNameMissing, [nil]);
83 end;
84
85 constructor TFBServiceManager.Create(ServerName: AnsiString; Protocol: TProtocol;
86 SPB: ISPB);
87 begin
88 inherited Create;
89 FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
90 FProtocol := Protocol;
91 FSPB := SPB;
92 FServerName := ServerName;
93 Attach;
94 end;
95
96 destructor TFBServiceManager.Destroy;
97 begin
98 Detach(true);
99 inherited Destroy;
100 end;
101
102 function TFBServiceManager.getSPB: ISPB;
103 begin
104 Result := FSPB;
105 end;
106
107 function TFBServiceManager.getServerName: AnsiString;
108 begin
109 Result := FServerName;
110 end;
111
112 procedure TFBServiceManager.Attach;
113 var ConnectString: AnsiString;
114 begin
115 case FProtocol of
116 TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
117 SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
118 NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
119 Local: ConnectString := 'service_mgr'; {do not localize}
120 end;
121 InternalAttach(ConnectString);
122 end;
123
124 function TFBServiceManager.AllocateSRB: ISRB;
125 begin
126 Result := TSRB.Create;
127 end;
128
129 function TFBServiceManager.AllocateSQPB: ISQPB;
130 begin
131 Result := TSQPB.Create;
132 end;
133
134 function TFBServiceManager.Query(Request: ISRB): IServiceQueryResults;
135 begin
136 Result := Query(nil,Request);
137 end;
138
139 end.
140