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