ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/2.5/FB25Services.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 7895 byte(s)
Log Message:
Release 2.3.2 committed

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 {************************************************************************}
31 { }
32 { Borland Delphi Visual Component Library }
33 { InterBase Express core components }
34 { }
35 { Copyright (c) 1998-2000 Inprise Corporation }
36 { }
37 { InterBase Express is based in part on the product }
38 { Free IB Components, written by Gregory H. Deatz for }
39 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40 { Free IB Components is used under license. }
41 { }
42 { The contents of this file are subject to the InterBase }
43 { Public License Version 1.0 (the "License"); you may not }
44 { use this file except in compliance with the License. You }
45 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46 { Software distributed under the License is distributed on }
47 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48 { express or implied. See the License for the specific language }
49 { governing rights and limitations under the License. }
50 { The Original Code was created by InterBase Software Corporation }
51 { and its successors. }
52 { Portions created by Inprise Corporation are Copyright (C) Inprise }
53 { Corporation. All Rights Reserved. }
54 { Contributor(s): Jeff Overcash }
55 { }
56 { IBX For Lazarus (Firebird Express) }
57 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58 { Portions created by MWA Software are copyright McCallum Whyman }
59 { Associates Ltd 2011 - 2015 }
60 { }
61 {************************************************************************}
62 unit FB25Services;
63 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$interfaces COM}
70 {$ENDIF}
71
72 interface
73
74 uses
75 Classes, SysUtils, IB, FB25ClientAPI, IBHeader, FBParamBlock, FBOutputBlock,
76 FBServices;
77
78 type
79 { TFBServiceManager }
80
81 { TFB25ServiceManager }
82
83 TFB25ServiceManager = class(TFBServiceManager,IServiceManager)
84 private
85 FHandle: TISC_SVC_HANDLE;
86 FFirebird25ClientAPI: TFB25ClientAPI;
87 procedure CheckActive;
88 procedure CheckInactive;
89 protected
90 procedure InternalAttach(ConnectString: AnsiString); override;
91 public
92 constructor Create(api: TFB25ClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
93 property Handle: TISC_SVC_HANDLE read FHandle;
94
95 public
96 {IServiceManager}
97 procedure Detach(Force: boolean=false); override;
98 function IsAttached: boolean;
99 function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
100 function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
101 end;
102
103 implementation
104
105 uses FBMessages;
106
107 { TFBServiceManager }
108
109 procedure TFB25ServiceManager.CheckActive;
110 begin
111 if FHandle = nil then
112 IBError(ibxeServiceActive, [nil]);
113 end;
114
115 procedure TFB25ServiceManager.CheckInactive;
116 begin
117 if FHandle <> nil then
118 IBError(ibxeServiceInActive, [nil]);
119 end;
120
121 procedure TFB25ServiceManager.InternalAttach(ConnectString: AnsiString);
122 begin
123 with FFirebird25ClientAPI do
124 if FSPB = nil then
125 begin
126 if isc_service_attach(StatusVector, Length(ConnectString),
127 PAnsiChar(ConnectString), @FHandle, 0, nil) > 0 then
128 IBDataBaseError;
129 end
130 else
131 begin
132 if isc_service_attach(StatusVector, Length(ConnectString),
133 PAnsiChar(ConnectString), @FHandle,
134 (FSPB as TSPB).getDataLength,
135 (FSPB as TSPB).getBuffer) > 0 then
136 IBDataBaseError;
137 end;
138 end;
139
140 constructor TFB25ServiceManager.Create(api: TFB25ClientAPI;
141 ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
142 begin
143 FFirebird25ClientAPI := api;
144 inherited Create(api,ServerName, Protocol, SPB, Port);
145 end;
146
147 procedure TFB25ServiceManager.Detach(Force: boolean);
148 begin
149 if FHandle = nil then
150 Exit;
151 with FFirebird25ClientAPI do
152 if isc_service_detach(StatusVector, @FHandle) > 0 then
153 begin
154 FHandle := nil;
155 if not Force then
156 IBDataBaseError;
157 end
158 else
159 FHandle := nil;
160 end;
161
162 function TFB25ServiceManager.IsAttached: boolean;
163 begin
164 Result := FHandle <> nil;
165 end;
166
167 function TFB25ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
168 ): boolean;
169 begin
170 Result := true;
171 CheckActive;
172 with FFirebird25ClientAPI do
173 begin
174 Result := isc_service_start(StatusVector, @FHandle, nil,
175 (Request as TSRB).getDataLength,
176 (Request as TSRB).getBuffer) = 0;
177 if not Result and RaiseExceptionOnError then
178 IBDataBaseError;
179 end;
180 end;
181
182 function TFB25ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
183 RaiseExceptionOnError: boolean): IServiceQueryResults;
184 var QueryResults: TServiceQueryResults;
185 begin
186 CheckActive;
187 QueryResults := TServiceQueryResults.Create(FFirebird25ClientAPI);
188 Result := QueryResults;
189 with FFirebird25ClientAPI do
190 if SQPB = nil then
191 begin
192 if isc_service_query(StatusVector, @FHandle, nil,0,nil,
193 (Request as TSRB).getDataLength,
194 (Request as TSRB).getBuffer,
195 QueryResults.getBufSize,
196 QueryResults.Buffer) > 0 then
197 begin
198 if RaiseExceptionOnError then
199 IBDataBaseError
200 else
201 Result := nil;
202 end;
203 end
204 else
205 if isc_service_query(StatusVector, @FHandle, nil,
206 (SQPB as TSQPB).getDataLength,
207 (SQPB as TSQPB).getBuffer,
208 (Request as TSRB).getDataLength,
209 (Request as TSRB).getBuffer,
210 QueryResults.getBufSize,
211 QueryResults.Buffer) > 0 then
212 begin
213 if RaiseExceptionOnError then
214 IBDataBaseError
215 else
216 Result := nil;
217 end;
218 end;
219
220 end.
221