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: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 7466 byte(s)
Log Message:
Fixes Merged

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 procedure CheckActive;
87 procedure CheckInactive;
88 protected
89 procedure InternalAttach(ConnectString: AnsiString); override;
90 public
91 property Handle: TISC_SVC_HANDLE read FHandle;
92
93 public
94 {IServiceManager}
95 procedure Detach(Force: boolean=false); override;
96 function IsAttached: boolean;
97 function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
98 function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
99 end;
100
101 implementation
102
103 uses FBMessages;
104
105 { TFBServiceManager }
106
107 procedure TFB25ServiceManager.CheckActive;
108 begin
109 if FHandle = nil then
110 IBError(ibxeServiceActive, [nil]);
111 end;
112
113 procedure TFB25ServiceManager.CheckInactive;
114 begin
115 if FHandle <> nil then
116 IBError(ibxeServiceInActive, [nil]);
117 end;
118
119 procedure TFB25ServiceManager.InternalAttach(ConnectString: AnsiString);
120 begin
121 with Firebird25ClientAPI do
122 if FSPB = nil then
123 begin
124 if isc_service_attach(StatusVector, Length(ConnectString),
125 PAnsiChar(ConnectString), @FHandle, 0, nil) > 0 then
126 IBDataBaseError;
127 end
128 else
129 begin
130 if isc_service_attach(StatusVector, Length(ConnectString),
131 PAnsiChar(ConnectString), @FHandle,
132 (FSPB as TSPB).getDataLength,
133 (FSPB as TSPB).getBuffer) > 0 then
134 IBDataBaseError;
135 end;
136 end;
137
138 procedure TFB25ServiceManager.Detach(Force: boolean);
139 begin
140 if FHandle = nil then
141 Exit;
142 with Firebird25ClientAPI do
143 if isc_service_detach(StatusVector, @FHandle) > 0 then
144 begin
145 FHandle := nil;
146 if not Force then
147 IBDataBaseError;
148 end
149 else
150 FHandle := nil;
151 end;
152
153 function TFB25ServiceManager.IsAttached: boolean;
154 begin
155 Result := FHandle <> nil;
156 end;
157
158 function TFB25ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
159 ): boolean;
160 begin
161 Result := true;
162 CheckActive;
163 with Firebird25ClientAPI do
164 begin
165 Result := isc_service_start(StatusVector, @FHandle, nil,
166 (Request as TSRB).getDataLength,
167 (Request as TSRB).getBuffer) = 0;
168 if not Result and RaiseExceptionOnError then
169 IBDataBaseError;
170 end;
171 end;
172
173 function TFB25ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
174 RaiseExceptionOnError: boolean): IServiceQueryResults;
175 var QueryResults: TServiceQueryResults;
176 begin
177 CheckActive;
178 QueryResults := TServiceQueryResults.Create;
179 Result := QueryResults;
180 with Firebird25ClientAPI do
181 if SQPB = nil then
182 begin
183 if isc_service_query(StatusVector, @FHandle, nil,0,nil,
184 (Request as TSRB).getDataLength,
185 (Request as TSRB).getBuffer,
186 QueryResults.getBufSize,
187 QueryResults.Buffer) > 0 then
188 begin
189 if RaiseExceptionOnError then
190 IBDataBaseError
191 else
192 Result := nil;
193 end;
194 end
195 else
196 if isc_service_query(StatusVector, @FHandle, nil,
197 (SQPB as TSQPB).getDataLength,
198 (SQPB as TSQPB).getBuffer,
199 (Request as TSRB).getDataLength,
200 (Request as TSRB).getBuffer,
201 QueryResults.getBufSize,
202 QueryResults.Buffer) > 0 then
203 begin
204 if RaiseExceptionOnError then
205 IBDataBaseError
206 else
207 Result := nil;
208 end;
209 end;
210
211 end.
212