ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBAttachment.pas
Revision: 375
Committed: Sun Jan 9 23:42:58 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 56652 byte(s)
Log Message: 
Fixes

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