ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30Services.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 4906 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.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FB30Services;
28 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$ENDIF}
36
37 interface
38
39 uses
40 Classes, SysUtils, Firebird, IB, FB30ClientAPI, FBParamBlock, FBOutputBlock,
41 FBServices;
42
43 type
44 { TFBServiceManager }
45
46 { TFB30ServiceManager }
47
48 TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
49 private
50 FServiceIntf: Firebird.IService;
51 procedure CheckActive;
52 procedure CheckInactive;
53 protected
54 procedure InternalAttach(ConnectString: AnsiString); override;
55 public
56 property ServiceIntf: Firebird.IService read FServiceIntf;
57
58 public
59 {IServiceManager}
60 procedure Detach(Force: boolean=false); override;
61 function IsAttached: boolean;
62 function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
63 function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
64 end;
65
66 implementation
67
68 uses FBMessages;
69
70 { TFBServiceManager }
71
72 procedure TFB30ServiceManager.CheckActive;
73 begin
74 if FServiceIntf = nil then
75 IBError(ibxeServiceActive, [nil]);
76 end;
77
78 procedure TFB30ServiceManager.CheckInactive;
79 begin
80 if FServiceIntf <> nil then
81 IBError(ibxeServiceInActive, [nil]);
82 end;
83
84 procedure TFB30ServiceManager.InternalAttach(ConnectString: AnsiString);
85 begin
86 with Firebird30ClientAPI do
87 if FSPB = nil then
88 begin
89 FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PAnsiChar(ConnectString), 0, nil);
90 Check4DataBaseError;
91 end
92 else
93 begin
94 FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
95 PAnsiChar(ConnectString),
96 (FSPB as TSPB).getDataLength,
97 BytePtr((FSPB as TSPB).getBuffer));
98 Check4DataBaseError;
99 end;
100 end;
101
102 procedure TFB30ServiceManager.Detach(Force: boolean);
103 begin
104 if FServiceIntf = nil then
105 Exit;
106 with Firebird30ClientAPI do
107 begin
108 FServiceIntf.detach(StatusIntf);
109 if not Force and InErrorState then
110 IBDataBaseError;
111 FServiceIntf := nil;
112 end;
113 end;
114
115 function TFB30ServiceManager.IsAttached: boolean;
116 begin
117 Result := FServiceIntf <> nil;
118 end;
119
120 function TFB30ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
121 ): boolean;
122 begin
123 Result := true;
124 CheckActive;
125 with Firebird30ClientAPI do
126 begin
127 FServiceIntf.Start(StatusIntf,
128 (Request as TSRB).getDataLength,
129 BytePtr((Request as TSRB).getBuffer));
130 if RaiseExceptionOnError then
131 Check4DataBaseError
132 else
133 Result := not InErrorState;
134 end;
135 end;
136
137 function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
138 RaiseExceptionOnError: boolean): IServiceQueryResults;
139 var QueryResults: TServiceQueryResults;
140 begin
141 CheckActive;
142 QueryResults := TServiceQueryResults.Create;
143 Result := QueryResults;
144 with Firebird30ClientAPI do
145 begin
146 if SQPB <> nil then
147 begin
148 FServiceIntf.query(StatusIntf,
149 (SQPB as TSQPB).getDataLength,
150 BytePtr((SQPB as TSQPB).getBuffer),
151 (Request as TSRB).getDataLength,
152 BytePtr((Request as TSRB).getBuffer),
153 QueryResults.getBufSize,
154 BytePtr(QueryResults.Buffer));
155 if RaiseExceptionOnError then
156 Check4DataBaseError
157 else
158 if InErrorState then
159 Result := nil;
160 end
161 else
162 begin
163 FServiceIntf.query(StatusIntf, 0, nil,
164 (Request as TSRB).getDataLength,
165 BytePtr((Request as TSRB).getBuffer),
166 QueryResults.getBufSize,
167 BytePtr(QueryResults.Buffer));
168 if RaiseExceptionOnError then
169 Check4DataBaseError
170 else
171 if InErrorState then
172 Result := nil;
173 end;
174 end;
175 end;
176
177 end.
178