ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBAttachment.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 12691 byte(s)
Log Message:
Committing updates for Release R2-0-0

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