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

File Contents

# User Rev Content
1 tony 45 (*
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 FBAttachment;
28 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33 tony 56 {$mode delphi}
34 tony 45 {$interfaces COM}
35     {$ENDIF}
36    
37     interface
38    
39     uses
40     Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
41    
42     type
43    
44     { TFBAttachment }
45    
46     TFBAttachment = class(TActivityHandler)
47     private
48     FDPB: IDPB;
49     FFirebirdAPI: IFirebirdAPI;
50     protected
51 tony 56 FDatabaseName: AnsiString;
52 tony 45 FRaiseExceptionOnConnectError: boolean;
53     FSQLDialect: integer;
54     FHasDefaultCharSet: boolean;
55     FCharSetID: integer;
56     FCodePage: TSystemCodePage;
57 tony 56 constructor Create(DatabaseName: AnsiString; DPB: IDPB;
58 tony 45 RaiseExceptionOnConnectError: boolean);
59     procedure CheckHandle; virtual; abstract;
60 tony 56 function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
61 tony 45 procedure EndAllTransactions;
62     procedure SetParameters(SQLParams: ISQLParams; params: array of const);
63     public
64     destructor Destroy; override;
65     function getDPB: IDPB;
66     function AllocateBPB: IBPB;
67     function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
68     function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
69     procedure Disconnect(Force: boolean=false); virtual; abstract;
70 tony 56 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
71     procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
72     procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
73     procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
74     function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
75     function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
76     function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
77     function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
78     function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
79     function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
80 tony 45 params: array of const): IResultSet; overload;
81 tony 56 function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
82     function OpenCursor(transaction: ITransaction; sql: AnsiString;
83 tony 45 params: array of const): IResultSet; overload;
84 tony 56 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
85     function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
86 tony 45 params: array of const): IResultSet; overload;
87 tony 56 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
88     function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
89 tony 45 params: array of const): IResultSet; overload;
90 tony 56 function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
91     function OpenCursorAtStart(sql: AnsiString;
92 tony 45 params: array of const): IResultSet; overload;
93 tony 56 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
94     function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
95     function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
96 tony 45 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
97 tony 56 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
98 tony 45 GenerateParamNames: boolean=false): IStatement; overload;
99     function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
100 tony 56 function GetEventHandler(Event: AnsiString): IEvents; overload;
101 tony 45
102     function GetSQLDialect: integer;
103 tony 56 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
104 tony 45 function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
105     property SQLDialect: integer read FSQLDialect;
106     property HasDefaultCharSet: boolean read FHasDefaultCharSet;
107     property CharSetID: integer read FCharSetID;
108     property CodePage: TSystemCodePage read FCodePage;
109     property DPB: IDPB read FDPB;
110     end;
111    
112     implementation
113    
114     uses FBMessages, FBTransaction;
115    
116     { TFBAttachment }
117    
118 tony 56 constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
119 tony 45 RaiseExceptionOnConnectError: boolean);
120     begin
121     inherited Create;
122     FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
123     FSQLDialect := 3;
124     FDatabaseName := DatabaseName;
125     FDPB := DPB;
126     FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
127     end;
128    
129 tony 56 function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
130     var CreateParams: AnsiString;
131 tony 45 DPBItem: IDPBItem;
132     begin
133     CreateParams := '';
134    
135     if aDPB <> nil then
136     begin
137     DPBItem := aDPB.Find(isc_dpb_user_name);
138     if DPBItem <> nil then
139 tony 56 CreateParams := CreateParams + ' USER ''' + DPBItem.AsString + '''';
140 tony 45
141     DPBItem := aDPB.Find(isc_dpb_password);
142     if DPBItem <> nil then
143 tony 56 CreateParams := CreateParams + ' Password ''' + DPBItem.AsString + '''';
144 tony 45
145     DPBItem := aDPB.Find(isc_dpb_page_size);
146     if DPBItem <> nil then
147 tony 56 CreateParams := CreateParams + ' PAGE_SIZE ' + DPBItem.AsString;
148 tony 45
149     DPBItem := aDPB.Find(isc_dpb_lc_ctype);
150     if DPBItem <> nil then
151 tony 56 CreateParams := CreateParams + ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
152 tony 45
153     DPBItem := aDPB.Find(isc_dpb_sql_dialect);
154     if DPBItem <> nil then
155     FSQLDialect := DPBItem.AsInteger;
156     end;
157    
158     Result := 'CREATE DATABASE ''' + DatabaseName + ''' ' + CreateParams; {do not localize}
159     end;
160    
161     procedure TFBAttachment.EndAllTransactions;
162     var i: integer;
163     intf: TInterfacedObject;
164     begin
165     for i := 0 to InterfaceCount - 1 do
166     begin
167     intf := GetInterface(i);
168     if (intf <> nil) and (intf is TFBTransaction) then
169     TFBTransaction(intf).DoDefaultTransactionEnd(true);
170     end;
171     end;
172    
173     procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
174     params: array of const);
175     var i: integer;
176     begin
177     if SQLParams.Count <> Length(params) then
178     IBError(ibxeInvalidParamCount,[SQLParams.Count,Length(params)]);
179    
180     for i := 0 to High(params) do
181     begin
182     case params[i].vtype of
183     vtinteger :
184     SQLParams[i].AsInteger := params[i].vinteger;
185     vtboolean :
186     SQLParams[i].AsBoolean := params[i].vboolean;
187     vtchar :
188     SQLParams[i].AsString := params[i].vchar;
189     vtextended :
190     SQLParams[i].AsDouble := params[i].VExtended^;
191     vtCurrency:
192     SQLParams[i].AsDouble := params[i].VCurrency^;
193     vtString :
194     SQLParams[i].AsString := params[i].VString^;
195     vtPChar :
196     SQLParams[i].AsString := strpas(params[i].VPChar);
197     vtAnsiString :
198     SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
199     vtVariant:
200     SQLParams[i].AsVariant := params[i].VVariant^;
201     else
202     IBError(ibxeInvalidVariantType,[nil]);
203     end;
204     end;
205     end;
206    
207     destructor TFBAttachment.Destroy;
208     begin
209     Disconnect(true);
210     inherited Destroy;
211     end;
212    
213     function TFBAttachment.getDPB: IDPB;
214     begin
215     Result := FDPB;
216     end;
217    
218     function TFBAttachment.AllocateBPB: IBPB;
219     begin
220     Result := TBPB.Create;
221     end;
222    
223 tony 56 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
224 tony 45 aSQLDialect: integer);
225     begin
226     ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
227     end;
228    
229 tony 56 procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
230 tony 45 begin
231     ExecImmediate(transaction,sql,FSQLDialect);
232     end;
233    
234 tony 56 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
235 tony 45 begin
236     ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
237     end;
238    
239 tony 56 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
240 tony 45 SQLDialect: integer; params: array of const): IResults;
241     begin
242     Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
243     end;
244    
245 tony 56 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
246 tony 45 SQLDialect: integer; params: array of const): IResults;
247     begin
248     with Prepare(transaction,sql,SQLDialect) do
249     begin
250     SetParameters(SQLParams,params);
251     Result := Execute;
252     end;
253     end;
254    
255 tony 56 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
256 tony 45 params: array of const): IResults;
257     begin
258     Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
259     end;
260    
261 tony 56 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
262 tony 45 params: array of const): IResults;
263     begin
264     with Prepare(transaction,sql,FSQLDialect) do
265     begin
266     SetParameters(SQLParams,params);
267     Result := Execute;
268     end;
269     end;
270    
271 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
272 tony 45 aSQLDialect: integer): IResultSet;
273     begin
274     Result := OpenCursor(transaction,sql,aSQLDialect,[]);
275     end;
276    
277 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
278 tony 45 aSQLDialect: integer; params: array of const): IResultSet;
279     var Statement: IStatement;
280     begin
281     CheckHandle;
282     Statement := Prepare(transaction,sql,aSQLDialect);
283     SetParameters(Statement.SQLParams,params);
284     Result := Statement.OpenCursor;
285     end;
286    
287 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
288 tony 45 ): IResultSet;
289     begin
290     Result := OpenCursor(transaction,sql,FSQLDialect,[]);
291     end;
292    
293 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
294 tony 45 params: array of const): IResultSet;
295     begin
296     Result := OpenCursor(transaction,sql,FSQLDialect,params);
297     end;
298    
299     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
300 tony 56 sql: AnsiString; aSQLDialect: integer): IResultSet;
301 tony 45 begin
302     Result := OpenCursor(transaction,sql,aSQLDialect,[]);
303     Result.FetchNext;
304     end;
305    
306     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
307 tony 56 sql: AnsiString; aSQLDialect: integer; params: array of const): IResultSet;
308 tony 45 begin
309     Result := OpenCursor(transaction,sql,aSQLDialect,params);
310     Result.FetchNext;
311     end;
312    
313 tony 56 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
314 tony 45 ): IResultSet;
315     begin
316     Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
317     end;
318    
319     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
320 tony 56 sql: AnsiString; params: array of const): IResultSet;
321 tony 45 begin
322     Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
323     end;
324    
325 tony 56 function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
326 tony 45 begin
327     Result := OpenCursorAtStart(sql,[]);
328     end;
329    
330 tony 56 function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
331 tony 45 params: array of const): IResultSet;
332     begin
333     Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
334     end;
335    
336 tony 56 function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
337 tony 45 ): IStatement;
338     begin
339     Result := Prepare(transaction,sql,FSQLDialect);
340     end;
341    
342     function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
343 tony 56 sql: AnsiString; GenerateParamNames: boolean): IStatement;
344 tony 45 begin
345     Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
346     end;
347    
348 tony 56 function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
349 tony 45 var S: TStringList;
350     begin
351     S := TStringList.Create;
352     try
353     S.Add(Event);
354     Result := GetEventHandler(S);
355     finally
356     S.Free;
357     end;
358     end;
359    
360     function TFBAttachment.GetSQLDialect: integer;
361     begin
362     Result := FSQLDialect;
363     end;
364    
365     function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
366     BPB: IBPB): IBlob;
367     begin
368     Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
369     end;
370    
371     end.
372