ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBAttachment.pas
Revision: 390
Committed: Sat Jan 22 16:15:12 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 58123 byte(s)
Log Message: 
In Firebird 3 and later API: the status vector is now a thread var

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 tony 371 * The Original Code is (C) 2016-2021 Tony Whyman, MWA Software
20 tony 45 * (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 tony 118 {$define HASREQEX}
36 tony 45 {$ENDIF}
37    
38     interface
39    
40     uses
41 tony 263 Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB, FBParamBlock,
42 tony 363 FBActivityMonitor, FBClientAPI, IBUtils;
43 tony 45
44 tony 345 const
45     DefaultMaxInlineBlobLimit = 8192;
46    
47 tony 45 type
48 tony 60 TCharsetMap = record
49     CharsetID: integer;
50     CharSetName: AnsiString;
51     CharSetWidth: integer;
52     CodePage: TSystemCodePage;
53     AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
54     end;
55 tony 45
56 tony 363 { Database Journalling.
57    
58     This class is intended to support a client side journal of all database
59     updates, inserts and deletes made by the client during a session. It also records
60     the transaction each update was made under.
61    
62     The database schema is required to include a control table "IBX$JOURNALS" and
63     an SQL Sequence IBX$SESSIONS. These are created by the class when the
64     database is opened, if they are not already present. However, it is recommended
65     that they are created as an orginal part of the database schema in order to
66     unnecessarily avoid each user being given sufficient priviledge to create tables
67     and Sequences.
68    
69     Syntax:
70    
71     Transaction Start:
72 tony 371 *S:<date/time>,<attachmentid>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
73 tony 363
74     Transaction Commit:
75 tony 371 *C:<date/time>,<attachmentid>,<session id>,<transaction no.>
76 tony 363
77     Transaction Commit retaining :
78 tony 371 *c:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
79 tony 363
80     Transaction Rollback:
81 tony 371 *R:<date/time>,<attachmentid>,<session id>,<transaction no.>
82 tony 363
83     Transaction Rollback retaining:
84 tony 371 *r:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
85 tony 363
86     Update/Insert/Delete
87 tony 371 *Q:<date/time>,<attachmentid>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88 tony 363
89     }
90    
91     { TFBJournaling }
92    
93     TFBJournaling = class(TActivityHandler, IJournallingHook)
94     private
95     {Logfile}
96 tony 371 const sQueryJournal = '*Q:''%s'',%d,%d,%d,%d:%s' + LineEnding;
97     const sTransStartJnl = '*S:''%s'',%d,%d,%d,%d:%s,%d:%s,%d' + LineEnding;
98     const sTransCommitJnl = '*C:''%s'',%d,%d,%d' + LineEnding;
99 tony 387 const sTransCommitFailJnl = '*F:''%s'',%d,%d,%d' + LineEnding;
100 tony 371 const sTransCommitRetJnl = '*c:''%s'',%d,%d,%d,%d' + LineEnding;
101     const sTransRollBackJnl = '*R:''%s'',%d,%d,%d' + LineEnding;
102 tony 387 const sTransRollBackFailJnl = '*f:''%s'',%d,%d,%d' + LineEnding;
103 tony 371 const sTransRollBackRetJnl = '*r:''%s'',%d,%d,%d,%d' + LineEnding;
104 tony 363 private
105     FOptions: TJournalOptions;
106     FJournalFilePath: string;
107     FJournalFileStream: TStream;
108     FSessionID: integer;
109     FDoNotJournal: boolean;
110     function GetDateTimeFmt: AnsiString;
111     protected
112     procedure EndSession(RetainJournal: boolean);
113     function GetAttachment: IAttachment; virtual; abstract;
114     public
115     {IAttachment}
116     procedure Disconnect(Force: boolean=false); virtual;
117     public
118     {IJournallingHook}
119     procedure TransactionStart(Tr: ITransaction);
120 tony 387 function TransactionEnd( TransactionID: integer; Completion: TTrCompletionState): boolean;
121 tony 363 procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer;
122     Action: TTransactionAction);
123     procedure ExecQuery(Stmt: IStatement);
124 tony 387 procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
125 tony 363 public
126     {Client side Journaling}
127     function JournalingActive: boolean;
128     function GetJournalOptions: TJournalOptions;
129     function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
130     function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
131 tony 371 function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
132 tony 363 procedure StopJournaling(RetainJournal: boolean);
133     end;
134    
135 tony 45 { TFBAttachment }
136    
137 tony 363 TFBAttachment = class(TFBJournaling)
138 tony 45 private
139     FDPB: IDPB;
140     FFirebirdAPI: IFirebirdAPI;
141 tony 117 FODSMajorVersion: integer;
142     FODSMinorVersion: integer;
143 tony 60 FUserCharSetMap: array of TCharSetMap;
144 tony 209 FSecDatabase: AnsiString;
145 tony 345 FInlineBlobLimit: integer;
146 tony 371 FAttachmentID: integer;
147 tony 45 FSQLDialect: integer;
148     FHasDefaultCharSet: boolean;
149     FCharSetID: integer;
150     FCodePage: TSystemCodePage;
151 tony 117 FRemoteProtocol: AnsiString;
152 tony 143 FAuthMethod: AnsiString;
153 tony 375 FHasConnectionInfo: boolean;
154     procedure NeedDBInfo;
155     procedure NeedConnectionInfo;
156     protected
157     FDatabaseName: AnsiString;
158     FRaiseExceptionOnConnectError: boolean;
159 tony 263 constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
160 tony 45 RaiseExceptionOnConnectError: boolean);
161     procedure CheckHandle; virtual; abstract;
162 tony 375 procedure ClearCachedInfo;
163 tony 56 function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
164 tony 143 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
165 tony 117 function IsConnected: boolean; virtual; abstract;
166 tony 45 procedure EndAllTransactions;
167 tony 117 procedure DPBFromCreateSQL(CreateSQL: AnsiString);
168 tony 45 procedure SetParameters(SQLParams: ISQLParams; params: array of const);
169 tony 375 procedure SetSQLDialect(aValue: integer);
170 tony 315 procedure UseServerICUChanged; virtual;
171 tony 45 public
172     destructor Destroy; override;
173 tony 375 procedure Disconnect(Force: boolean); override;
174 tony 263 function getFirebirdAPI: IFirebirdAPI;
175 tony 45 function getDPB: IDPB;
176     function AllocateBPB: IBPB;
177 tony 143 function AllocateDIRB: IDIRB;
178 tony 363 function StartTransaction(TPB: array of byte;
179     DefaultCompletion: TTransactionCompletion;
180     aName: AnsiString=''): ITransaction; overload; virtual; abstract;
181     function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
182     aName: AnsiString=''): ITransaction; overload; virtual; abstract;
183 tony 56 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
184     procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
185     procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
186     procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
187     function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
188     function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
189     function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
190     function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
191     function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
192 tony 350 Scrollable: boolean=false): IResultSet; overload;
193     function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
194 tony 45 params: array of const): IResultSet; overload;
195 tony 350 function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
196 tony 56 function OpenCursor(transaction: ITransaction; sql: AnsiString;
197 tony 45 params: array of const): IResultSet; overload;
198 tony 350 function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
199     params: array of const): IResultSet; overload;
200     function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
201     params: array of const): IResultSet; overload;
202 tony 56 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
203 tony 350 Scrollable: boolean=false): IResultSet; overload;
204     function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
205 tony 45 params: array of const): IResultSet; overload;
206 tony 350 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
207     params: array of const): IResultSet; overload;
208     function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
209 tony 56 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
210 tony 45 params: array of const): IResultSet; overload;
211 tony 350 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
212     params: array of const): IResultSet; overload;
213     function OpenCursorAtStart(sql: AnsiString;Scrollable: boolean=false): IResultSet; overload;
214     function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
215     params: array of const): IResultSet; overload;
216 tony 56 function OpenCursorAtStart(sql: AnsiString;
217 tony 45 params: array of const): IResultSet; overload;
218 tony 350 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
219     function Prepare(transaction: ITransaction; sql: AnsiString; CursorName: AnsiString=''): IStatement; overload;
220 tony 56 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
221 tony 270 aSQLDialect: integer; GenerateParamNames: boolean=false;
222 tony 350 CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
223 tony 56 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
224 tony 270 GenerateParamNames: boolean=false;
225 tony 350 CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
226 tony 45 function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
227 tony 56 function GetEventHandler(Event: AnsiString): IEvents; overload;
228 tony 45
229     function GetSQLDialect: integer;
230 tony 371 function GetAttachmentID: integer;
231 tony 291 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
232     function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
233 tony 56 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
234 tony 291 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
235 tony 45 function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
236 tony 291 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
237     ): IArray; overload;
238     function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
239     function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
240     function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
241 tony 375 property SQLDialect: integer read GetSQLDialect;
242 tony 45 property DPB: IDPB read FDPB;
243 tony 315 public
244     function GetDBInformation(Requests: array of byte): IDBInformation; overload;
245     function GetDBInformation(Request: byte): IDBInformation; overload;
246     function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
247     function GetConnectString: AnsiString;
248     function GetRemoteProtocol: AnsiString;
249     function GetAuthenticationMethod: AnsiString;
250     function GetSecurityDatabase: AnsiString;
251     function GetODSMajorVersion: integer;
252     function GetODSMinorVersion: integer;
253 tony 371 function GetCharSetID: integer;
254 tony 315 function HasDecFloatSupport: boolean; virtual;
255 tony 345 function GetInlineBlobLimit: integer;
256     procedure SetInlineBlobLimit(limit: integer);
257     function HasBatchMode: boolean; virtual;
258 tony 363 function HasTable(aTableName: AnsiString): boolean;
259 tony 371 function HasFunction(aFunctionName: AnsiString): boolean;
260     function HasProcedure(aProcName: AnsiString): boolean;
261 tony 315
262     public
263     {Character Sets}
264     function HasDefaultCharSet: boolean;
265     function GetDefaultCharSetID: integer;
266     function GetCharsetName(CharSetID: integer): AnsiString;
267     function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
268     function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
269     function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
270     function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
271     procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
272     AllowReverseLookup:boolean; out CharSetID: integer);
273     function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
274     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
275 tony 375 property CharSetID: integer read GetCharSetID;
276 tony 315 property CodePage: TSystemCodePage read FCodePage;
277    
278     public
279     {Time Zone Support}
280     function GetTimeZoneServices: ITimeZoneServices; virtual;
281     function HasTimeZoneSupport: boolean; virtual;
282    
283 tony 45 end;
284    
285 tony 315 { TDPBItem }
286    
287     TDPBItem = class(TParamBlockItem,IDPBItem)
288     public
289     function getParamTypeName: AnsiString; override;
290     end;
291    
292     { TDPB }
293    
294     TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
295     protected
296     function LookupItemType(ParamTypeName: AnsiString): byte; override;
297     public
298     constructor Create(api: TFBClientAPI);
299 tony 345 function GetParamTypeName(ParamType: byte): Ansistring;
300     {$IFDEF FPC}
301     function IDPB.GetDPBParamTypeName = GetParamTypeName;
302     {$ELSE}
303 tony 315 function GetDPBParamTypeName(ParamType: byte): Ansistring;
304 tony 345 {$ENDIF}
305 tony 315 end;
306    
307 tony 45 implementation
308    
309 tony 363 uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
310 tony 45
311 tony 60 const
312 tony 363 {Journaling}
313     sJournalTableName = 'IBX$JOURNALS';
314     sSequenceName = 'IBX$SESSIONS';
315    
316     sqlCreateJournalTable =
317     'Create Table ' + sJournalTableName + '(' +
318     ' IBX$SessionID Integer not null, '+
319     ' IBX$TransactionID Integer not null, '+
320     ' IBX$OldTransactionID Integer, '+
321     ' IBX$USER VarChar(32) Default CURRENT_USER, '+
322     ' IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
323     ' Primary Key(IBX$SessionID,IBX$TransactionID)' +
324     ')';
325    
326     sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
327    
328     sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
329    
330     sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
331     'Values(?,?,?)';
332    
333     sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
334    
335     const
336 tony 60 CharSetMap: array [0..69] of TCharsetMap = (
337     (CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_ACP; AllowReverseLookup: true),
338     (CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
339     (CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII; AllowReverseLookup: true),
340     (CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8; AllowReverseLookup: false),
341     (CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8; AllowReverseLookup: true),
342     (CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
343     (CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
344     (CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
345     (CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
346     (CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737; AllowReverseLookup: true),
347     (CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437; AllowReverseLookup: true),
348     (CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850; AllowReverseLookup: true),
349     (CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865; AllowReverseLookup: true),
350     (CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860; AllowReverseLookup: true),
351     (CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863; AllowReverseLookup: true),
352     (CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775; AllowReverseLookup: true),
353     (CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858; AllowReverseLookup: true),
354     (CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862; AllowReverseLookup: true),
355     (CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864; AllowReverseLookup: true),
356     (CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
357     (CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
358     (CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591; AllowReverseLookup: true),
359     (CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592; AllowReverseLookup: true),
360     (CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593; AllowReverseLookup: true),
361     (CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
362     (CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
363     (CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
364     (CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
365     (CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
366     (CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
367     (CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
368     (CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
369     (CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
370     (CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
371     (CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594; AllowReverseLookup: true),
372     (CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595; AllowReverseLookup: true),
373     (CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596; AllowReverseLookup: true),
374     (CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597; AllowReverseLookup: true),
375     (CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598; AllowReverseLookup: true),
376     (CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599; AllowReverseLookup: true),
377     (CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603; AllowReverseLookup: true),
378     (CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
379     (CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
380     (CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
381     (CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949; AllowReverseLookup: true),
382     (CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852; AllowReverseLookup: true),
383     (CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857; AllowReverseLookup: true),
384     (CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861; AllowReverseLookup: true),
385     (CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866; AllowReverseLookup: true),
386     (CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869; AllowReverseLookup: true),
387     (CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
388     (CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250; AllowReverseLookup: true),
389     (CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
390     (CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252; AllowReverseLookup: true),
391     (CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253; AllowReverseLookup: true),
392     (CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254; AllowReverseLookup: true),
393     (CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950; AllowReverseLookup: true),
394     (CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
395     (CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255; AllowReverseLookup: true),
396     (CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256; AllowReverseLookup: true),
397     (CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257; AllowReverseLookup: true),
398     (CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
399     (CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
400     (CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866; AllowReverseLookup: true),
401     (CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866; AllowReverseLookup: true),
402     (CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258; AllowReverseLookup: true),
403     (CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874; AllowReverseLookup: true),
404     (CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
405     (CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943; AllowReverseLookup: true),
406     (CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
407     );
408    
409 tony 315 const
410     isc_dpb_last_dpb_constant = isc_dpb_decfloat_traps;
411 tony 60
412 tony 315 DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
413     'cdd_pathname',
414     'allocation',
415     'journal',
416     'page_size',
417     'num_buffers',
418     'buffer_length',
419     'debug',
420     'garbage_collect',
421     'verify',
422     'sweep',
423     'enable_journal',
424     'disable_journal',
425     'dbkey_scope',
426     'number_of_users',
427     'trace',
428     'no_garbage_collect',
429     'damaged',
430     'license',
431     'sys_user_name',
432     'encrypt_key',
433     'activate_shadow',
434     'sweep_interval',
435     'delete_shadow',
436     'force_write',
437     'begin_log',
438     'quit_log',
439     'no_reserve',
440     'user_name',
441     'password',
442     'password_enc',
443     'sys_user_name_enc',
444     'interp',
445     'online_dump',
446     'old_file_size',
447     'old_num_files',
448     'old_file',
449     'old_start_page',
450     'old_start_seqno',
451     'old_start_file',
452     'drop_walfile',
453     'old_dump_id',
454     'wal_backup_dir',
455     'wal_chkptlen',
456     'wal_numbufs',
457     'wal_bufsize',
458     'wal_grp_cmt_wait',
459     'lc_messages',
460     'lc_ctype',
461     'cache_manager',
462     'shutdown',
463     'online',
464     'shutdown_delay',
465     'reserved',
466     'overwrite',
467     'sec_attach',
468     'disable_wal',
469     'connect_timeout',
470     'dummy_packet_interval',
471     'gbak_attach',
472     'sql_role_name',
473     'set_page_buffers',
474     'working_directory',
475     'sql_dialect',
476     'set_db_readonly',
477     'set_db_sql_dialect',
478     'gfix_attach',
479     'gstat_attach',
480     'set_db_charset',
481     'gsec_attach',
482     'address_path' ,
483     'process_id',
484     'no_db_triggers',
485     'trusted_auth',
486     'process_name',
487     'trusted_role',
488     'org_filename',
489 tony 387 'utf8_filename',
490 tony 315 'ext_call_depth',
491     'auth_block',
492     'client_version',
493     'remote_protocol',
494     'host_name',
495     'os_user',
496     'specific_auth_data',
497     'auth_plugin_list',
498     'auth_plugin_name',
499     'config',
500     'nolinger',
501     'reset_icu',
502     'map_attach',
503     'session_time_zone',
504     'set_db_replica',
505     'set_bind',
506     'decfloat_round',
507     'decfloat_traps'
508     );
509 tony 60
510 tony 363 type
511 tony 60
512 tony 363 { TQueryProcessor }
513 tony 315
514 tony 363 TQueryProcessor=class(TSQLTokeniser)
515     private
516     FInString: AnsiString;
517     FIndex: integer;
518     FStmt: IStatement;
519     function DoExecute: AnsiString;
520     function GetParamValue(ParamIndex: integer): AnsiString;
521     protected
522     function GetChar: AnsiChar; override;
523     public
524     class function Execute(Stmt: IStatement): AnsiString;
525     end;
526    
527     { TQueryProcessor }
528    
529     function TQueryProcessor.DoExecute: AnsiString;
530     var token: TSQLTokens;
531     ParamIndex: integer;
532     begin
533     Result := '';
534     ParamIndex := 0;
535    
536     while not EOF do
537     begin
538     token := GetNextToken;
539     case token of
540     sqltPlaceHolder:
541     begin
542     Result := Result + GetParamValue(ParamIndex);
543     Inc(ParamIndex);
544     end;
545     else
546     Result := Result + TokenText;
547     end;
548     end;
549     end;
550    
551     function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
552     begin
553     with FStmt.SQLParams[ParamIndex] do
554     begin
555     if IsNull then
556     Result := 'NULL'
557     else
558     case GetSQLType of
559     SQL_BLOB:
560     if getSubType = 1 then {string}
561     Result := '''' + SQLSafeString(GetAsString) + ''''
562     else
563     Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
564    
565     SQL_ARRAY:
566     Result := TSQLXMLReader.FormatArray(getAsArray);
567    
568     SQL_VARYING,
569     SQL_TEXT,
570     SQL_TIMESTAMP,
571     SQL_TYPE_DATE,
572     SQL_TYPE_TIME,
573     SQL_TIMESTAMP_TZ_EX,
574     SQL_TIME_TZ_EX,
575     SQL_TIMESTAMP_TZ,
576     SQL_TIME_TZ:
577     Result := '''' + SQLSafeString(GetAsString) + '''';
578     else
579     Result := GetAsString;
580     end;
581     end;
582     end;
583    
584     function TQueryProcessor.GetChar: AnsiChar;
585     begin
586     if FIndex <= Length(FInString) then
587     begin
588     Result := FInString[FIndex];
589     Inc(FIndex);
590     end
591     else
592     Result := #0;
593     end;
594    
595     class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
596     begin
597     if not Stmt.IsPrepared then
598     IBError(ibxeSQLClosed,[]);
599     with self.Create do
600     try
601     FStmt := Stmt;
602     FInString := Stmt.GetProcessedSQLText;
603     FIndex := 1;
604     Result := Trim(DoExecute);
605     finally
606     Free;
607     end;
608     end;
609    
610     { TFBJournaling }
611    
612     function TFBJournaling.GetDateTimeFmt: AnsiString;
613     begin
614     {$IF declared(DefaultFormatSettings)}
615     with DefaultFormatSettings do
616     {$ELSE}
617     {$IF declared(FormatSettings)}
618     with FormatSettings do
619     {$IFEND}
620     {$IFEND}
621     Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
622     end;
623    
624     procedure TFBJournaling.EndSession(RetainJournal: boolean);
625     begin
626 tony 371 if JournalingActive and (FJournalFilePath <> '') then
627 tony 363 begin
628     FreeAndNil(FJournalFileStream);
629 tony 371 if not (joNoServerTable in FOptions) and not RetainJournal then
630 tony 363 try
631     GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
632     sqlCleanUpSession,[FSessionID]);
633     sysutils.DeleteFile(FJournalFilePath);
634     except On E: EIBInterBaseError do
635     if E.IBErrorCode <> isc_lost_db_connection then
636     raise;
637     {ignore - do not delete journal if database gone away}
638     end;
639     FSessionID := -1;
640     end;
641     end;
642    
643     procedure TFBJournaling.Disconnect(Force: boolean);
644     begin
645     if JournalingActive then
646     EndSession(Force);
647     end;
648    
649     procedure TFBJournaling.TransactionStart(Tr: ITransaction);
650     var LogEntry: AnsiString;
651     TPBText: AnsiString;
652     begin
653 tony 371 if not (joNoServerTable in FOptions) then
654 tony 363 try
655 tony 387 FDoNotJournal := true;
656 tony 363 GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
657     finally
658     FDoNotJournal := false;
659     end;
660     TPBText := Tr.getTPB.AsText;
661     LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
662 tony 371 GetAttachment.GetAttachmentID,
663 tony 363 FSessionID,
664     Tr.GetTransactionID,
665     Length(Tr.TransactionName),
666     Tr.TransactionName,
667     Length(TPBText),TPBText,
668     ord(tr.GetDefaultCompletion)]);
669     if assigned(FJournalFileStream) then
670     FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
671     end;
672    
673     function TFBJournaling.TransactionEnd(TransactionID: integer;
674 tony 387 Completion: TTrCompletionState): boolean;
675 tony 363
676     var LogEntry: AnsiString;
677     begin
678     Result := false;
679 tony 387 case Completion of
680     trRolledback:
681 tony 363 begin
682 tony 371 LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
683     GetAttachment.GetAttachmentID,
684     FSessionID,TransactionID]);
685 tony 363 Result := true;
686     end;
687 tony 387
688     trRollbackFailed:
689 tony 363 begin
690 tony 387 LogEntry := Format(sTransRollbackFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
691     GetAttachment.GetAttachmentID,
692     FSessionID,TransactionID]);
693     Result := true;
694     end;
695    
696     trCommitted:
697     begin
698 tony 371 LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
699     GetAttachment.GetAttachmentID,
700     FSessionID,TransactionID]);
701 tony 363 Result := true;
702     end;
703 tony 387
704     trCommitFailed:
705     begin
706     LogEntry := Format(sTransCommitFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
707     GetAttachment.GetAttachmentID,
708     FSessionID,TransactionID]);
709     Result := true;
710     end;
711 tony 363 end;
712     if assigned(FJournalFileStream) then
713     FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
714     end;
715    
716     procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
717     OldTransactionID: integer; Action: TTransactionAction);
718     var LogEntry: AnsiString;
719     begin
720     case Action of
721     TACommitRetaining:
722     LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
723 tony 371 GetAttachment.GetAttachmentID,
724 tony 363 FSessionID,Tr.GetTransactionID,OldTransactionID]);
725     TARollbackRetaining:
726     LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
727 tony 371 GetAttachment.GetAttachmentID,
728 tony 363 FSessionID,Tr.GetTransactionID,OldTransactionID]);
729     end;
730     if assigned(FJournalFileStream) then
731     FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
732    
733 tony 371 if not (joNoServerTable in FOptions) then
734 tony 363 try
735 tony 387 FDoNotJournal := true;
736 tony 363 GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
737     finally
738     FDoNotJournal := false;
739     end;
740     end;
741    
742     procedure TFBJournaling.ExecQuery(Stmt: IStatement);
743     var SQL: AnsiString;
744     LogEntry: AnsiString;
745     begin
746     SQL := TQueryProcessor.Execute(Stmt);
747     LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
748 tony 371 GetAttachment.GetAttachmentID,
749 tony 363 FSessionID,
750     Stmt.GetTransaction.GetTransactionID,
751     Length(SQL),SQL]);
752     if assigned(FJournalFileStream) then
753     FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
754     end;
755    
756 tony 387 procedure TFBJournaling.ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
757     var LogEntry: AnsiString;
758     begin
759     LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
760     GetAttachment.GetAttachmentID,
761     FSessionID,
762     tr.GetTransactionID,
763     Length(sql),sql]);
764     if assigned(FJournalFileStream) then
765     FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
766     end;
767    
768 tony 363 function TFBJournaling.JournalingActive: boolean;
769     begin
770     Result := (FJournalFileStream <> nil) and not FDoNotJournal;
771     end;
772    
773     function TFBJournaling.GetJournalOptions: TJournalOptions;
774     begin
775     Result := FOptions;
776     end;
777    
778     function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
779     begin
780     Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
781     end;
782    
783     function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
784     Options: TJournalOptions): integer;
785     begin
786 tony 371 try
787     StartJournaling(TFileStream.Create(aJournalLogFile,fmCreate),Options);
788     finally
789     FJournalFilePath := aJournalLogFile;
790     end;
791     end;
792    
793     function TFBJournaling.StartJournaling(S: TStream; Options: TJournalOptions
794     ): integer;
795     begin
796 tony 363 FOptions := Options;
797 tony 371 if not (joNoServerTable in FOptions) then
798 tony 363 with GetAttachment do
799     begin
800 tony 371 if not HasTable(sJournalTableName) then
801 tony 363 begin
802     ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
803     ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
804     end;
805     FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
806     end;
807 tony 371 FJournalFileStream := S;
808 tony 363 Result := FSessionID;
809     end;
810    
811     procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
812     begin
813     EndSession(RetainJournal);
814     end;
815    
816 tony 45 { TFBAttachment }
817    
818 tony 375 procedure TFBAttachment.NeedConnectionInfo;
819     var Stmt: IStatement;
820 tony 117 ResultSet: IResultSet;
821     Param: IDPBItem;
822     begin
823 tony 375 if not IsConnected or FHasConnectionInfo then Exit;
824     NeedDBInfo;
825 tony 143 FCharSetID := 0;
826     FRemoteProtocol := '';
827     FAuthMethod := 'Legacy_Auth';
828 tony 209 FSecDatabase := 'Default';
829 tony 143 if FODSMajorVersion > 11 then
830 tony 117 begin
831     Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
832 tony 209 'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
833 tony 315 'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION ');
834 tony 143 ResultSet := Stmt.OpenCursor;
835     if ResultSet.FetchNext then
836     begin
837     FCharSetID := ResultSet[0].AsInteger;
838 tony 209 FRemoteProtocol := Trim(ResultSet[1].AsString);
839     FAuthMethod := Trim(ResultSet[2].AsString);
840     FSecDatabase := Trim(ResultSet[3].AsString);
841 tony 143 end
842     end
843     else
844     if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
845     begin
846     Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
847 tony 117 'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
848     'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
849     ResultSet := Stmt.OpenCursor;
850     if ResultSet.FetchNext then
851     begin
852     FCharSetID := ResultSet[0].AsInteger;
853 tony 209 FRemoteProtocol := Trim(ResultSet[1].AsString);
854 tony 117 end
855     end
856     else
857     if DPB <> nil then
858     begin
859     Param := DPB.Find(isc_dpb_lc_ctype);
860     if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
861     FCharSetID := 0;
862 tony 143 case GetProtocol(FDatabaseName) of
863     TCP: FRemoteProtocol := 'TCPv4';
864     Local: FRemoteProtocol := '';
865     NamedPipe: FRemoteProtocol := 'Netbui';
866     SPX: FRemoteProtocol := 'SPX'
867     end;
868 tony 117 end;
869     FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
870 tony 375 FHasConnectionInfo := true;
871 tony 117 end;
872    
873 tony 375 procedure TFBAttachment.NeedDBInfo;
874     var DBInfo: IDBInformation;
875     i: integer;
876     begin
877     if not IsConnected or (FAttachmentID > 0) then Exit;
878     DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
879     isc_info_db_SQL_Dialect, isc_info_attachment_id]);
880     for i := 0 to DBInfo.GetCount - 1 do
881     with DBInfo[i] do
882     case getItemType of
883     isc_info_ods_minor_version:
884     FODSMinorVersion := getAsInteger;
885     isc_info_ods_version:
886     FODSMajorVersion := getAsInteger;
887     isc_info_db_SQL_Dialect:
888     FSQLDialect := getAsInteger;
889     isc_info_attachment_id:
890     FAttachmentID := getAsInteger;
891     end;
892     end;
893    
894 tony 263 constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
895     DPB: IDPB; RaiseExceptionOnConnectError: boolean);
896 tony 45 begin
897     inherited Create;
898 tony 263 FFirebirdAPI := api.GetAPI; {Keep reference to interface}
899 tony 45 FSQLDialect := 3;
900     FDatabaseName := DatabaseName;
901 tony 60 SetLength(FUserCharSetMap,0);
902 tony 375 ClearCachedInfo;
903 tony 345 FInlineBlobLimit := DefaultMaxInlineBlobLimit;
904 tony 371 FDPB := DPB;
905     FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
906 tony 45 end;
907    
908 tony 375 procedure TFBAttachment.ClearCachedInfo;
909     begin
910     FHasDefaultCharSet := false;
911     FAttachmentID := 0;
912     FODSMajorVersion := 0;
913     FODSMinorVersion := 0;
914     FCodePage := CP_NONE;
915     FCharSetID := 0;
916     FRemoteProtocol := '';
917     FAuthMethod := '';
918     FSecDatabase := '';
919     FHasConnectionInfo := false;
920     end;
921    
922 tony 56 function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
923     var CreateParams: AnsiString;
924 tony 45 DPBItem: IDPBItem;
925     begin
926     CreateParams := '';
927    
928     if aDPB <> nil then
929     begin
930     DPBItem := aDPB.Find(isc_dpb_user_name);
931     if DPBItem <> nil then
932 tony 56 CreateParams := CreateParams + ' USER ''' + DPBItem.AsString + '''';
933 tony 45
934     DPBItem := aDPB.Find(isc_dpb_password);
935     if DPBItem <> nil then
936 tony 56 CreateParams := CreateParams + ' Password ''' + DPBItem.AsString + '''';
937 tony 45
938     DPBItem := aDPB.Find(isc_dpb_page_size);
939     if DPBItem <> nil then
940 tony 56 CreateParams := CreateParams + ' PAGE_SIZE ' + DPBItem.AsString;
941 tony 45
942     DPBItem := aDPB.Find(isc_dpb_lc_ctype);
943     if DPBItem <> nil then
944 tony 56 CreateParams := CreateParams + ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
945 tony 45
946     DPBItem := aDPB.Find(isc_dpb_sql_dialect);
947     if DPBItem <> nil then
948     FSQLDialect := DPBItem.AsInteger;
949     end;
950    
951     Result := 'CREATE DATABASE ''' + DatabaseName + ''' ' + CreateParams; {do not localize}
952     end;
953    
954     procedure TFBAttachment.EndAllTransactions;
955     var i: integer;
956     intf: TInterfacedObject;
957     begin
958     for i := 0 to InterfaceCount - 1 do
959     begin
960     intf := GetInterface(i);
961     if (intf <> nil) and (intf is TFBTransaction) then
962     TFBTransaction(intf).DoDefaultTransactionEnd(true);
963     end;
964     end;
965    
966 tony 118 {$IFDEF HASREQEX}
967 tony 117 procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
968     var RegexObj: TRegExpr;
969     begin
970     FDPB := FFirebirdAPI.AllocateDPB;
971     RegexObj := TRegExpr.Create;
972     try
973     {extact database file spec}
974     RegexObj.ModifierG := false; {turn off greedy matches}
975     RegexObj.ModifierI := true; {case insensitive match}
976     RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
977     if RegexObj.Exec(CreateSQL) then
978     begin
979     DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
980     DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
981     end
982     else
983     begin
984     RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
985     if RegexObj.Exec(CreateSQL) then
986     DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
987     end;
988     finally
989     RegexObj.Free;
990     end;
991     if FCharSetID > 0 then
992     DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
993     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
994     end;
995 tony 118 {$ELSE}
996     procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
997 tony 119 begin
998     FDPB := FFirebirdAPI.AllocateDPB;
999     if FCharSetID > 0 then
1000     DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
1001     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
1002 tony 118 end;
1003     {$ENDIF}
1004 tony 117
1005 tony 45 procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
1006     params: array of const);
1007     var i: integer;
1008     begin
1009     if SQLParams.Count <> Length(params) then
1010     IBError(ibxeInvalidParamCount,[SQLParams.Count,Length(params)]);
1011    
1012     for i := 0 to High(params) do
1013     begin
1014     case params[i].vtype of
1015     vtinteger :
1016     SQLParams[i].AsInteger := params[i].vinteger;
1017 tony 70 vtInt64:
1018     SQLParams[i].AsInt64 := params[i].VInt64^;
1019     {$IF declared (vtQWord)}
1020     vtQWord:
1021     SQLParams[i].AsInt64 := params[i].VQWord^;
1022     {$IFEND}
1023 tony 45 vtboolean :
1024     SQLParams[i].AsBoolean := params[i].vboolean;
1025     vtchar :
1026     SQLParams[i].AsString := params[i].vchar;
1027     vtextended :
1028     SQLParams[i].AsDouble := params[i].VExtended^;
1029     vtCurrency:
1030     SQLParams[i].AsDouble := params[i].VCurrency^;
1031     vtString :
1032 tony 70 SQLParams[i].AsString := strpas(PChar(params[i].VString));
1033 tony 45 vtPChar :
1034     SQLParams[i].AsString := strpas(params[i].VPChar);
1035     vtAnsiString :
1036 tony 70 SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
1037 tony 45 vtVariant:
1038     SQLParams[i].AsVariant := params[i].VVariant^;
1039 tony 70 vtWideChar:
1040     SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
1041     vtPWideChar:
1042     SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
1043     vtWideString:
1044     SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
1045     vtUnicodeString:
1046     SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
1047 tony 45 else
1048     IBError(ibxeInvalidVariantType,[nil]);
1049     end;
1050     end;
1051     end;
1052    
1053 tony 375 procedure TFBAttachment.SetSQLDialect(aValue: integer);
1054     begin
1055     FSQLDialect := aValue;
1056     end;
1057    
1058 tony 315 procedure TFBAttachment.UseServerICUChanged;
1059     begin
1060     // Do nothing by default
1061     end;
1062    
1063 tony 45 destructor TFBAttachment.Destroy;
1064     begin
1065     Disconnect(true);
1066     inherited Destroy;
1067     end;
1068    
1069 tony 375 procedure TFBAttachment.Disconnect(Force: boolean);
1070     begin
1071     inherited Disconnect(Force);
1072     ClearCachedInfo;
1073     end;
1074    
1075 tony 263 function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
1076     begin
1077     Result := FFirebirdAPI;
1078     end;
1079    
1080 tony 45 function TFBAttachment.getDPB: IDPB;
1081     begin
1082     Result := FDPB;
1083     end;
1084    
1085     function TFBAttachment.AllocateBPB: IBPB;
1086     begin
1087 tony 263 Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
1088 tony 45 end;
1089    
1090 tony 143 function TFBAttachment.AllocateDIRB: IDIRB;
1091     begin
1092 tony 263 Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
1093 tony 143 end;
1094    
1095 tony 56 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
1096 tony 45 aSQLDialect: integer);
1097 tony 387 var tr: ITransaction;
1098 tony 45 begin
1099 tony 387 tr := StartTransaction(TPB,taCommit);
1100     try
1101     ExecImmediate(tr,sql,aSQLDialect);
1102 tony 388 tr.Commit;
1103 tony 387 except
1104     tr.Rollback(true);
1105     raise;
1106     end;
1107 tony 45 end;
1108    
1109 tony 56 procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
1110 tony 45 begin
1111     ExecImmediate(transaction,sql,FSQLDialect);
1112     end;
1113    
1114 tony 56 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
1115 tony 45 begin
1116 tony 387 ExecImmediate(TPB,sql,FSQLDialect);
1117 tony 45 end;
1118    
1119 tony 56 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1120 tony 45 SQLDialect: integer; params: array of const): IResults;
1121 tony 387 var tr: ITransaction;
1122 tony 45 begin
1123 tony 387 tr := StartTransaction(TPB,taCommit);
1124     try
1125     Result := ExecuteSQL(tr,sql,SQLDialect,params);
1126 tony 390 tr.CommitRetaining;
1127 tony 387 except
1128     tr.Rollback(true);
1129     raise;
1130     end;
1131 tony 45 end;
1132    
1133 tony 56 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
1134 tony 45 SQLDialect: integer; params: array of const): IResults;
1135     begin
1136     with Prepare(transaction,sql,SQLDialect) do
1137     begin
1138     SetParameters(SQLParams,params);
1139     Result := Execute;
1140     end;
1141     end;
1142    
1143 tony 56 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1144 tony 45 params: array of const): IResults;
1145     begin
1146 tony 387 Result := ExecuteSQL(TPB,sql,FSQLDialect,params);
1147 tony 45 end;
1148    
1149 tony 56 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
1150 tony 45 params: array of const): IResults;
1151     begin
1152 tony 387 Result := ExecuteSQL(transaction,sql,FSQLDialect,params);
1153 tony 45 end;
1154    
1155 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1156 tony 350 aSQLDialect: integer; Scrollable: boolean): IResultSet;
1157 tony 45 begin
1158 tony 350 Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1159 tony 45 end;
1160    
1161 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1162 tony 45 aSQLDialect: integer; params: array of const): IResultSet;
1163 tony 350
1164 tony 45 begin
1165 tony 350 Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1166 tony 45 end;
1167    
1168 tony 350 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1169     Scrollable: boolean): IResultSet;
1170 tony 45 begin
1171 tony 350 Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,[]);
1172 tony 45 end;
1173    
1174 tony 56 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1175 tony 45 params: array of const): IResultSet;
1176     begin
1177 tony 350 Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1178 tony 45 end;
1179    
1180 tony 350 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1181     Scrollable: boolean; params: array of const): IResultSet;
1182     begin
1183     Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,params);
1184     end;
1185    
1186     function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1187     aSQLDialect: integer; Scrollable: boolean;
1188     params: array of const): IResultSet;
1189     var Statement: IStatement;
1190     begin
1191     CheckHandle;
1192     Statement := Prepare(transaction,sql,aSQLDialect);
1193     SetParameters(Statement.SQLParams,params);
1194     Result := Statement.OpenCursor(Scrollable);
1195     end;
1196    
1197 tony 45 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1198 tony 350 sql: AnsiString; aSQLDialect: integer; Scrollable: boolean): IResultSet;
1199 tony 45 begin
1200 tony 350 Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1201 tony 45 Result.FetchNext;
1202     end;
1203    
1204     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1205 tony 56 sql: AnsiString; aSQLDialect: integer; params: array of const): IResultSet;
1206 tony 45 begin
1207     Result := OpenCursor(transaction,sql,aSQLDialect,params);
1208     Result.FetchNext;
1209     end;
1210    
1211 tony 350 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1212     sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
1213     params: array of const): IResultSet;
1214 tony 45 begin
1215 tony 350 Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,params);
1216     Result.FetchNext;
1217 tony 45 end;
1218    
1219     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1220 tony 350 sql: AnsiString; Scrollable: boolean): IResultSet;
1221     begin
1222     Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,[]);
1223     end;
1224    
1225     function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1226 tony 56 sql: AnsiString; params: array of const): IResultSet;
1227 tony 45 begin
1228     Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
1229     end;
1230    
1231 tony 350 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1232     sql: AnsiString; Scrollable: boolean; params: array of const): IResultSet;
1233 tony 45 begin
1234 tony 350 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,params);
1235 tony 45 end;
1236    
1237 tony 350 function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean
1238     ): IResultSet;
1239     begin
1240     Result := OpenCursorAtStart(sql,Scrollable,[]);
1241     end;
1242    
1243     function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
1244     params: array of const): IResultSet;
1245 tony 387 var tr: ITransaction;
1246 tony 350 begin
1247 tony 387 tr := StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit);
1248     try
1249     Result := OpenCursorAtStart(tr,sql,FSQLDialect,Scrollable,params);
1250 tony 390 tr.CommitRetaining;
1251 tony 387 except
1252     tr.Rollback(true);
1253     raise;
1254     end;
1255 tony 350 end;
1256    
1257 tony 56 function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
1258 tony 45 params: array of const): IResultSet;
1259     begin
1260 tony 387 Result := OpenCursorAtStart(sql,false,params);
1261 tony 45 end;
1262    
1263 tony 350 function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString;
1264     CursorName: AnsiString): IStatement;
1265 tony 45 begin
1266 tony 350 Result := Prepare(transaction,sql,FSQLDialect,CursorName);
1267 tony 45 end;
1268    
1269     function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
1270 tony 350 sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean;
1271     CursorName: AnsiString): IStatement;
1272 tony 45 begin
1273 tony 350 Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams,CursorName);
1274 tony 45 end;
1275    
1276 tony 56 function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
1277 tony 45 var S: TStringList;
1278     begin
1279     S := TStringList.Create;
1280     try
1281     S.Add(Event);
1282     Result := GetEventHandler(S);
1283     finally
1284     S.Free;
1285     end;
1286     end;
1287    
1288     function TFBAttachment.GetSQLDialect: integer;
1289     begin
1290 tony 375 NeedDBInfo;
1291 tony 45 Result := FSQLDialect;
1292     end;
1293    
1294 tony 371 function TFBAttachment.GetAttachmentID: integer;
1295     begin
1296 tony 375 NeedDBInfo;
1297 tony 371 Result := FAttachmentID;
1298     end;
1299    
1300 tony 291 function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1301     ColumnName: AnsiString; BPB: IBPB): IBlob;
1302     begin
1303     Result := CreateBlob(transaction,GetBlobMetaData(Transaction,RelationName,ColumnName),BPB);
1304     end;
1305    
1306     function TFBAttachment.OpenBlob(transaction: ITransaction; RelationName,
1307     ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
1308     begin
1309     Result := OpenBlob(Transaction,
1310     GetBlobMetaData(Transaction,RelationName,ColumnName),
1311     BlobID,BPB);
1312     end;
1313    
1314 tony 45 function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
1315     BPB: IBPB): IBlob;
1316     begin
1317     Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
1318     end;
1319    
1320 tony 291 function TFBAttachment.CreateArray(transaction: ITransaction; RelationName,
1321     ColumnName: AnsiString): IArray;
1322     begin
1323     Result := CreateArray(transaction,GetArrayMetaData(transaction,RelationName,ColumnName));
1324     end;
1325    
1326     function TFBAttachment.OpenArray(transaction: ITransaction; RelationName,
1327     ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
1328     begin
1329     Result := OpenArray(transaction,
1330     GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
1331     end;
1332    
1333 tony 143 function TFBAttachment.GetDBInformation(Requests: array of byte
1334     ): IDBInformation;
1335     var ReqBuffer: PByte;
1336     i: integer;
1337     begin
1338     CheckHandle;
1339     if Length(Requests) = 1 then
1340     Result := GetDBInformation(Requests[0])
1341     else
1342     begin
1343     GetMem(ReqBuffer,Length(Requests));
1344     try
1345     for i := 0 to Length(Requests) - 1 do
1346     ReqBuffer[i] := Requests[i];
1347    
1348     Result := GetDBInfo(ReqBuffer,Length(Requests));
1349    
1350     finally
1351     FreeMem(ReqBuffer);
1352     end;
1353     end;
1354     end;
1355    
1356     function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
1357     begin
1358     CheckHandle;
1359     Result := GetDBInfo(@Request,1);
1360     end;
1361    
1362     function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
1363     begin
1364     CheckHandle;
1365     with Requests as TDIRB do
1366     Result := GetDBInfo(getBuffer,getDataLength);
1367     end;
1368    
1369 tony 117 function TFBAttachment.GetConnectString: AnsiString;
1370     begin
1371     Result := FDatabaseName;
1372     end;
1373    
1374     function TFBAttachment.GetRemoteProtocol: AnsiString;
1375     begin
1376 tony 375 NeedConnectionInfo;
1377 tony 117 Result := FRemoteProtocol;
1378     end;
1379    
1380 tony 143 function TFBAttachment.GetAuthenticationMethod: AnsiString;
1381     begin
1382 tony 375 NeedConnectionInfo;
1383 tony 143 Result := FAuthMethod;
1384     end;
1385    
1386 tony 209 function TFBAttachment.GetSecurityDatabase: AnsiString;
1387     begin
1388 tony 375 NeedConnectionInfo;
1389 tony 209 Result := FSecDatabase;
1390     end;
1391    
1392 tony 117 function TFBAttachment.GetODSMajorVersion: integer;
1393     begin
1394 tony 375 NeedDBInfo;
1395 tony 117 Result := FODSMajorVersion;
1396     end;
1397    
1398     function TFBAttachment.GetODSMinorVersion: integer;
1399     begin
1400 tony 375 NeedDBInfo;
1401 tony 117 Result := FODSMinorVersion;
1402     end;
1403    
1404 tony 371 function TFBAttachment.GetCharSetID: integer;
1405     begin
1406 tony 375 NeedConnectionInfo;
1407 tony 371 Result := FCharSetID;
1408     end;
1409    
1410 tony 315 function TFBAttachment.HasDecFloatSupport: boolean;
1411     begin
1412     Result := false;
1413     end;
1414    
1415 tony 345 function TFBAttachment.GetInlineBlobLimit: integer;
1416     begin
1417     Result := FInlineBlobLimit;
1418     end;
1419    
1420     procedure TFBAttachment.SetInlineBlobLimit(limit: integer);
1421     begin
1422     if limit > 32*1024 then
1423     FInlineBlobLimit := 32*1024
1424     else
1425     FInlineBlobLimit := limit;
1426     end;
1427    
1428     function TFBAttachment.HasBatchMode: boolean;
1429     begin
1430     Result := false;
1431     end;
1432    
1433 tony 363 function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
1434     begin
1435     Result := OpenCursorAtStart(
1436     'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
1437     [aTableName])[0].AsInteger > 0;
1438     end;
1439    
1440 tony 371 function TFBAttachment.HasFunction(aFunctionName: AnsiString): boolean;
1441     begin
1442     Result := OpenCursorAtStart(
1443     'Select count(*) From RDB$FUNCTIONS Where RDB$FUNCTION_NAME = ?',
1444     [aFunctionName])[0].AsInteger > 0;
1445     end;
1446    
1447     function TFBAttachment.HasProcedure(aProcName: AnsiString): boolean;
1448     begin
1449     Result := OpenCursorAtStart(
1450     'Select count(*) From RDB$PROCEDURES Where RDB$PROCEDURE_NAME = ?',
1451     [aProcName])[0].AsInteger > 0;
1452     end;
1453    
1454 tony 109 function TFBAttachment.HasDefaultCharSet: boolean;
1455     begin
1456 tony 375 NeedConnectionInfo;
1457 tony 109 Result := FHasDefaultCharSet
1458     end;
1459    
1460     function TFBAttachment.GetDefaultCharSetID: integer;
1461     begin
1462 tony 375 NeedConnectionInfo;
1463 tony 109 Result := FCharsetID;
1464     end;
1465    
1466 tony 60 function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
1467     var i: integer;
1468     begin
1469     Result := '';
1470     if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
1471     (CharSetMap[CharSetID].CharSetID = CharSetID) then
1472     begin
1473     Result := CharSetMap[CharSetID].CharSetName;
1474     Exit;
1475     end;
1476    
1477     for i := 0 to Length(FUserCharSetMap) - 1 do
1478     if FUserCharSetMap[i].CharSetID = CharSetID then
1479     begin
1480     Result := FUserCharSetMap[i].CharSetName;
1481     Exit;
1482     end;
1483     end;
1484    
1485     function TFBAttachment.CharSetID2CodePage(CharSetID: integer;
1486     var CodePage: TSystemCodePage): boolean;
1487     var i: integer;
1488     begin
1489     Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
1490     and (CharSetMap[CharSetID].CharSetID = CharSetID);
1491     if Result then
1492     begin
1493     CodePage := CharSetMap[CharSetID].CodePage;
1494     Result := true;
1495     Exit;
1496     end;
1497    
1498     for i := 0 to Length(FUserCharSetMap) - 1 do
1499     if FUserCharSetMap[i].CharSetID = CharSetID then
1500     begin
1501     CodePage := FUserCharSetMap[i].CodePage;
1502     Result := true;
1503     Exit;
1504     end;
1505     end;
1506    
1507     function TFBAttachment.CodePage2CharSetID(CodePage: TSystemCodePage;
1508     var CharSetID: integer): boolean;
1509     var i: integer;
1510     begin
1511     Result := false;
1512     for i := Low(CharSetMap) to High(CharSetMap) do
1513     if (CharSetMap[i].AllowReverseLookup) and (CharSetMap[i].CodePage = CodePage) then
1514     begin
1515     CharSetID := CharSetMap[i].CharSetID;
1516     Result := true;
1517     Exit;
1518     end;
1519    
1520     for i := 0 to Length(FUserCharSetMap) - 1 do
1521     if (FUserCharSetMap[i].AllowReverseLookup) and (FUserCharSetMap[i].CodePage = CodePage) then
1522     begin
1523     CharSetID := FUserCharSetMap[i].CharSetID;
1524     Result := true;
1525     Exit;
1526     end;
1527     end;
1528    
1529     function TFBAttachment.CharSetName2CharSetID(CharSetName: AnsiString;
1530     var CharSetID: integer): boolean;
1531     var i: integer;
1532     begin
1533     Result := false;
1534     for i := Low(CharSetMap) to High(CharSetMap) do
1535 tony 233 if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
1536 tony 60 begin
1537     CharSetID := CharSetMap[i].CharSetID;
1538     Result := true;
1539     Exit;
1540     end;
1541    
1542     for i := 0 to Length(FUserCharSetMap) - 1 do
1543 tony 233 if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
1544 tony 60 begin
1545     CharSetID := FUserCharSetMap[i].CharSetID;
1546     Result := true;
1547     Exit;
1548     end;
1549     end;
1550    
1551     function TFBAttachment.CharSetWidth(CharSetID: integer; var Width: integer
1552     ): boolean;
1553     var i: integer;
1554     begin
1555     Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
1556     and (CharSetMap[CharSetID].CharSetID = CharSetID);
1557     if Result then
1558     begin
1559     Width := CharSetMap[CharSetID].CharSetWidth;
1560     Result := true;
1561     Exit;
1562     end;
1563    
1564     for i := 0 to Length(FUserCharSetMap) - 1 do
1565     if FUserCharSetMap[i].CharSetID = CharSetID then
1566     begin
1567     Width := FUserCharSetMap[i].CharSetWidth;
1568     Result := true;
1569     Exit;
1570     end;
1571     end;
1572    
1573     const
1574     sqlLookupCharSet = 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER From RDB$CHARACTER_SETS '+
1575     'Where RDB$SYSTEM_FLAG = 0 and RDB$CHARACTER_SET_NAME = UPPER(?)';
1576    
1577     procedure TFBAttachment.RegisterCharSet(CharSetName: AnsiString;
1578     CodePage: TSystemCodePage; AllowReverseLookup: boolean; out CharSetID: integer
1579     );
1580     var CharSets: IResultSet;
1581     idx: integer;
1582     begin
1583     if CharSetName2CharSetID(CharSetName,CharSetID) then
1584     IBError(ibxeCharacterSetExists,[CharSetName]);
1585    
1586     CharSets := OpenCursorAtStart(sqlLookupCharSet,[CharSetName]);
1587     if CharSets.IsEof then
1588     IBError(ibxeUnknownUserCharSet,[CharSetName]);
1589    
1590     idx := Length(FUserCharSetMap);
1591     SetLength(FUserCharSetMap,idx+1);
1592     FUserCharSetMap[idx].AllowReverseLookup := AllowReverseLookup;
1593     FUserCharSetMap[idx].CharSetID := CharSets[0].AsInteger;
1594     FUserCharSetMap[idx].CharSetName := AnsiUpperCase(CharSetName);
1595     FUserCharSetMap[idx].CharSetWidth := CharSets[1].AsInteger;
1596     FUserCharSetMap[idx].CodePage := CodePage;
1597     CharSetID := CharSets[0].AsInteger;
1598     end;
1599    
1600 tony 315 function TFBAttachment.GetTimeZoneServices: ITimeZoneServices;
1601     begin
1602     IBError(ibxeNotSupported,[]);
1603     end;
1604    
1605     function TFBAttachment.HasTimeZoneSupport: boolean;
1606     begin
1607     Result := false;
1608     end;
1609    
1610     { TDPBItem }
1611    
1612     function TDPBItem.getParamTypeName: AnsiString;
1613     begin
1614     Result := DPBPrefix + DPBConstantNames[getParamType];
1615     end;
1616    
1617     { TDPB }
1618    
1619     constructor TDPB.Create(api: TFBClientAPI);
1620     begin
1621     inherited Create(api);
1622     FDataLength := 1;
1623     FBuffer^ := isc_dpb_version1;
1624     end;
1625    
1626 tony 345 function TDPB.GetParamTypeName(ParamType: byte): Ansistring;
1627 tony 315 begin
1628     if ParamType <= isc_dpb_last_dpb_constant then
1629     Result := DPBConstantNames[ParamType]
1630     else
1631     Result := '';
1632     end;
1633    
1634 tony 345 {$IFNDEF FPC}
1635     function TDPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
1636     begin
1637     Result := GetParamTypeName(ParamType);
1638     end;
1639     {$ENDIF}
1640    
1641 tony 315 function TDPB.LookupItemType(ParamTypeName: AnsiString): byte;
1642     var i: byte;
1643     begin
1644     Result := 0;
1645     ParamTypeName := LowerCase(ParamTypeName);
1646     if (Pos(DPBPrefix, ParamTypeName) = 1) then
1647     Delete(ParamTypeName, 1, Length(DPBPrefix));
1648    
1649     for i := 1 to isc_dpb_last_dpb_constant do
1650     if (ParamTypeName = DPBConstantNames[i]) then
1651     begin
1652     Result := i;
1653     break;
1654     end;
1655     end;
1656    
1657 tony 45 end.
1658    

Properties

Name Value
svn:eol-style native