ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBAttachment.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/FBAttachment.pas (file contents), Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC vs.
ibx/branches/udr/client/FBAttachment.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC

# Line 16 | Line 16
16   *
17   *  The Initial Developer of the Original Code is Tony Whyman.
18   *
19 < *  The Original Code is (C) 2016 Tony Whyman, MWA Software
19 > *  The Original Code is (C) 2016-2021 Tony Whyman, MWA Software
20   *  (http://www.mwasoftware.co.uk).
21   *
22   *  All Rights Reserved.
# Line 39 | Line 39 | interface
39  
40   uses
41    Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42 <  FBActivityMonitor, FBClientAPI;
42 >  FBActivityMonitor, FBClientAPI, IBUtils;
43 >
44 > const
45 >  DefaultMaxInlineBlobLimit = 8192;
46  
47   type
48    TCharsetMap = record
# Line 50 | Line 53 | type
53      AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
54    end;
55  
56 +  { 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 +    *S:<date/time>,<attachmentid>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
73 +
74 +    Transaction Commit:
75 +    *C:<date/time>,<attachmentid>,<session id>,<transaction no.>
76 +
77 +    Transaction Commit retaining :
78 +    *c:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
79 +
80 +    Transaction Rollback:
81 +    *R:<date/time>,<attachmentid>,<session id>,<transaction no.>
82 +
83 +    Transaction Rollback retaining:
84 +    *r:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
85 +
86 +    Update/Insert/Delete
87 +    *Q:<date/time>,<attachmentid>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88 +
89 +  }
90 +
91 +  { TFBJournaling }
92 +
93 +  TFBJournaling = class(TActivityHandler, IJournallingHook)
94 +  private
95 +    {Logfile}
96 +    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 +  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 +    function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
129 +    procedure StopJournaling(RetainJournal: boolean);
130 +  end;
131 +
132    { TFBAttachment }
133  
134 <  TFBAttachment = class(TActivityHandler)
134 >  TFBAttachment = class(TFBJournaling)
135    private
136      FDPB: IDPB;
137      FFirebirdAPI: IFirebirdAPI;
# Line 60 | Line 139 | type
139      FODSMinorVersion: integer;
140      FUserCharSetMap: array of TCharSetMap;
141      FSecDatabase: AnsiString;
142 +    FInlineBlobLimit: integer;
143 +    FAttachmentID: integer;
144    protected
145      FDatabaseName: AnsiString;
146      FRaiseExceptionOnConnectError: boolean;
# Line 79 | Line 160 | type
160      procedure EndAllTransactions;
161      procedure DPBFromCreateSQL(CreateSQL: AnsiString);
162      procedure SetParameters(SQLParams: ISQLParams; params: array of const);
163 +    procedure UseServerICUChanged; virtual;
164    public
165      destructor Destroy; override;
166      function getFirebirdAPI: IFirebirdAPI;
167      function getDPB: IDPB;
168      function AllocateBPB: IBPB;
169      function AllocateDIRB: IDIRB;
170 <    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
171 <    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
172 <    procedure Disconnect(Force: boolean=false); virtual; abstract;
170 >    function StartTransaction(TPB: array of byte;
171 >      DefaultCompletion: TTransactionCompletion;
172 >      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
173 >    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
174 >      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
175      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
176      procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
177      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
# Line 96 | Line 180 | type
180      function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
181      function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
182      function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
183 <    function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
183 >    function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
184 >                             Scrollable: boolean=false): IResultSet; overload;
185      function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
186                               params: array of const): IResultSet; overload;
187 <    function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
187 >    function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
188      function OpenCursor(transaction: ITransaction; sql: AnsiString;
189                               params: array of const): IResultSet; overload;
190 <    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
190 >    function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
191 >                             params: array of const): IResultSet; overload;
192 >    function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
193 >                             params: array of const): IResultSet; overload;
194      function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
195 +                             Scrollable: boolean=false): IResultSet; overload;
196 +    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
197 +                             params: array of const): IResultSet; overload;
198 +    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
199                               params: array of const): IResultSet; overload;
200 <    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
200 >    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
201      function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
202                               params: array of const): IResultSet; overload;
203 <    function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
203 >    function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
204 >                             params: array of const): IResultSet; overload;
205 >    function OpenCursorAtStart(sql: AnsiString;Scrollable: boolean=false): IResultSet; overload;
206 >    function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
207 >                             params: array of const): IResultSet; overload;
208      function OpenCursorAtStart(sql: AnsiString;
209                               params: array of const): IResultSet; overload;
210 <    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
211 <    function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
210 >    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
211 >    function Prepare(transaction: ITransaction; sql: AnsiString; CursorName: AnsiString=''): IStatement; overload;
212      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
213                         aSQLDialect: integer; GenerateParamNames: boolean=false;
214 <                       CaseSensitiveParams: boolean = false): IStatement; overload; virtual; abstract;
214 >                       CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
215      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
216                         GenerateParamNames: boolean=false;
217 <                       CaseSensitiveParams: boolean = false): IStatement; overload;
217 >                       CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
218      function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
219      function GetEventHandler(Event: AnsiString): IEvents; overload;
220  
221      function GetSQLDialect: integer;
222 +    function GetAttachmentID: integer;
223      function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
224      function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
225      function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
# Line 135 | Line 232 | type
232      function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
233      property SQLDialect: integer read FSQLDialect;
234      property DPB: IDPB read FDPB;
235 < public
236 <  function GetDBInformation(Requests: array of byte): IDBInformation; overload;
237 <  function GetDBInformation(Request: byte): IDBInformation; overload;
238 <  function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
239 <  function GetConnectString: AnsiString;
240 <  function GetRemoteProtocol: AnsiString;
241 <  function GetAuthenticationMethod: AnsiString;
242 <  function GetSecurityDatabase: AnsiString;
243 <  function GetODSMajorVersion: integer;
244 <  function GetODSMinorVersion: integer;
245 <  {Character Sets}
246 <  function HasDefaultCharSet: boolean;
247 <  function GetDefaultCharSetID: integer;
248 <  function GetCharsetName(CharSetID: integer): AnsiString;
249 <  function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
250 <  function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
251 <  function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
252 <  function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
253 <  procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
254 <    AllowReverseLookup:boolean; out CharSetID: integer);
255 <  function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
256 <  function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
257 <  property CharSetID: integer read FCharSetID;
258 <  property CodePage: TSystemCodePage read FCodePage;
235 >  public
236 >    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
237 >    function GetDBInformation(Request: byte): IDBInformation; overload;
238 >    function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
239 >    function GetConnectString: AnsiString;
240 >    function GetRemoteProtocol: AnsiString;
241 >    function GetAuthenticationMethod: AnsiString;
242 >    function GetSecurityDatabase: AnsiString;
243 >    function GetODSMajorVersion: integer;
244 >    function GetODSMinorVersion: integer;
245 >    function GetCharSetID: integer;
246 >    function HasDecFloatSupport: boolean; virtual;
247 >    function GetInlineBlobLimit: integer;
248 >    procedure SetInlineBlobLimit(limit: integer);
249 >    function HasBatchMode: boolean; virtual;
250 >    function HasTable(aTableName: AnsiString): boolean;
251 >    function HasFunction(aFunctionName: AnsiString): boolean;
252 >    function HasProcedure(aProcName: AnsiString): boolean;
253 >
254 >  public
255 >    {Character Sets}
256 >    function HasDefaultCharSet: boolean;
257 >    function GetDefaultCharSetID: integer;
258 >    function GetCharsetName(CharSetID: integer): AnsiString;
259 >    function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
260 >    function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
261 >    function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
262 >    function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
263 >    procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
264 >      AllowReverseLookup:boolean; out CharSetID: integer);
265 >    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
266 >    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
267 >    property CharSetID: integer read FCharSetID;
268 >    property CodePage: TSystemCodePage read FCodePage;
269 >
270 >  public
271 >    {Time Zone Support}
272 >    function GetTimeZoneServices: ITimeZoneServices; virtual;
273 >    function HasTimeZoneSupport: boolean; virtual;
274 >
275 >  end;
276 >
277 >  { TDPBItem }
278 >
279 >  TDPBItem = class(TParamBlockItem,IDPBItem)
280 >  public
281 >   function getParamTypeName: AnsiString; override;
282 >  end;
283 >
284 >  { TDPB }
285 >
286 >  TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
287 >  protected
288 >   function LookupItemType(ParamTypeName: AnsiString): byte; override;
289 >  public
290 >    constructor Create(api: TFBClientAPI);
291 >    function GetParamTypeName(ParamType: byte): Ansistring;
292 >    {$IFDEF FPC}
293 >    function IDPB.GetDPBParamTypeName = GetParamTypeName;
294 >    {$ELSE}
295 >    function GetDPBParamTypeName(ParamType: byte): Ansistring;
296 >    {$ENDIF}
297    end;
298  
299   implementation
300  
301 < uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
301 > uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
302 >
303 > const
304 >  {Journaling}
305 >  sJournalTableName = 'IBX$JOURNALS';
306 >  sSequenceName = 'IBX$SESSIONS';
307 >
308 >  sqlCreateJournalTable =
309 >    'Create Table ' + sJournalTableName + '(' +
310 >    '  IBX$SessionID Integer not null, '+
311 >    '  IBX$TransactionID Integer not null, '+
312 >    '  IBX$OldTransactionID Integer, '+
313 >    '  IBX$USER VarChar(32) Default CURRENT_USER, '+
314 >    '  IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
315 >    '  Primary Key(IBX$SessionID,IBX$TransactionID)' +
316 >    ')';
317 >
318 >  sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
319 >
320 >  sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
321 >
322 >  sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
323 >                        'Values(?,?,?)';
324 >
325 >  sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
326  
327   const
328    CharSetMap: array [0..69] of TCharsetMap = (
# Line 239 | Line 398 | const
398    (CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
399   );
400  
401 + const
402 +  isc_dpb_last_dpb_constant = isc_dpb_decfloat_traps;
403 +
404 +  DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
405 +    'cdd_pathname',
406 +    'allocation',
407 +    'journal',
408 +    'page_size',
409 +    'num_buffers',
410 +    'buffer_length',
411 +    'debug',
412 +    'garbage_collect',
413 +    'verify',
414 +    'sweep',
415 +    'enable_journal',
416 +    'disable_journal',
417 +    'dbkey_scope',
418 +    'number_of_users',
419 +    'trace',
420 +    'no_garbage_collect',
421 +    'damaged',
422 +    'license',
423 +    'sys_user_name',
424 +    'encrypt_key',
425 +    'activate_shadow',
426 +    'sweep_interval',
427 +    'delete_shadow',
428 +    'force_write',
429 +    'begin_log',
430 +    'quit_log',
431 +    'no_reserve',
432 +    'user_name',
433 +    'password',
434 +    'password_enc',
435 +    'sys_user_name_enc',
436 +    'interp',
437 +    'online_dump',
438 +    'old_file_size',
439 +    'old_num_files',
440 +    'old_file',
441 +    'old_start_page',
442 +    'old_start_seqno',
443 +    'old_start_file',
444 +    'drop_walfile',
445 +    'old_dump_id',
446 +    'wal_backup_dir',
447 +    'wal_chkptlen',
448 +    'wal_numbufs',
449 +    'wal_bufsize',
450 +    'wal_grp_cmt_wait',
451 +    'lc_messages',
452 +    'lc_ctype',
453 +    'cache_manager',
454 +    'shutdown',
455 +    'online',
456 +    'shutdown_delay',
457 +    'reserved',
458 +    'overwrite',
459 +    'sec_attach',
460 +    'disable_wal',
461 +    'connect_timeout',
462 +    'dummy_packet_interval',
463 +    'gbak_attach',
464 +    'sql_role_name',
465 +    'set_page_buffers',
466 +    'working_directory',
467 +    'sql_dialect',
468 +    'set_db_readonly',
469 +    'set_db_sql_dialect',
470 +    'gfix_attach',
471 +    'gstat_attach',
472 +    'set_db_charset',
473 +    'gsec_attach',
474 +    'address_path' ,
475 +    'process_id',
476 +    'no_db_triggers',
477 +    'trusted_auth',
478 +    'process_name',
479 +    'trusted_role',
480 +    'org_filename',
481 +    'utf8_ilename',
482 +    'ext_call_depth',
483 +    'auth_block',
484 +    'client_version',
485 +    'remote_protocol',
486 +    'host_name',
487 +    'os_user',
488 +    'specific_auth_data',
489 +    'auth_plugin_list',
490 +    'auth_plugin_name',
491 +    'config',
492 +    'nolinger',
493 +    'reset_icu',
494 +    'map_attach',
495 +    'session_time_zone',
496 +    'set_db_replica',
497 +    'set_bind',
498 +    'decfloat_round',
499 +    'decfloat_traps'
500 +    );
501 +
502 + type
503 +
504 +  { TQueryProcessor }
505 +
506 +  TQueryProcessor=class(TSQLTokeniser)
507 +  private
508 +    FInString: AnsiString;
509 +    FIndex: integer;
510 +    FStmt: IStatement;
511 +    function DoExecute: AnsiString;
512 +    function GetParamValue(ParamIndex: integer): AnsiString;
513 +  protected
514 +    function GetChar: AnsiChar; override;
515 +  public
516 +    class function Execute(Stmt: IStatement): AnsiString;
517 +  end;
518 +
519 +  { TQueryProcessor }
520 +
521 + function TQueryProcessor.DoExecute: AnsiString;
522 + var token: TSQLTokens;
523 +    ParamIndex: integer;
524 + begin
525 +  Result := '';
526 +  ParamIndex := 0;
527 +
528 +  while not EOF do
529 +  begin
530 +    token := GetNextToken;
531 +    case token of
532 +    sqltPlaceHolder:
533 +      begin
534 +        Result := Result + GetParamValue(ParamIndex);
535 +        Inc(ParamIndex);
536 +      end;
537 +    else
538 +      Result := Result + TokenText;
539 +    end;
540 +  end;
541 + end;
542 +
543 + function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
544 + begin
545 +  with FStmt.SQLParams[ParamIndex] do
546 +  begin
547 +    if IsNull then
548 +      Result := 'NULL'
549 +    else
550 +    case GetSQLType of
551 +    SQL_BLOB:
552 +      if getSubType = 1 then {string}
553 +        Result := '''' + SQLSafeString(GetAsString) + ''''
554 +      else
555 +        Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
556 +
557 +    SQL_ARRAY:
558 +        Result := TSQLXMLReader.FormatArray(getAsArray);
559 +
560 +    SQL_VARYING,
561 +    SQL_TEXT,
562 +    SQL_TIMESTAMP,
563 +    SQL_TYPE_DATE,
564 +    SQL_TYPE_TIME,
565 +    SQL_TIMESTAMP_TZ_EX,
566 +    SQL_TIME_TZ_EX,
567 +    SQL_TIMESTAMP_TZ,
568 +    SQL_TIME_TZ:
569 +      Result := '''' + SQLSafeString(GetAsString) + '''';
570 +    else
571 +      Result := GetAsString;
572 +    end;
573 +  end;
574 + end;
575 +
576 + function TQueryProcessor.GetChar: AnsiChar;
577 + begin
578 +  if FIndex <= Length(FInString) then
579 +  begin
580 +    Result := FInString[FIndex];
581 +    Inc(FIndex);
582 +  end
583 +  else
584 +    Result := #0;
585 + end;
586 +
587 + class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
588 + begin
589 +  if not Stmt.IsPrepared then
590 +    IBError(ibxeSQLClosed,[]);
591 +  with self.Create do
592 +  try
593 +    FStmt := Stmt;
594 +    FInString := Stmt.GetProcessedSQLText;
595 +    FIndex := 1;
596 +    Result := Trim(DoExecute);
597 +  finally
598 +    Free;
599 +  end;
600 + end;
601 +
602 + { TFBJournaling }
603 +
604 + function TFBJournaling.GetDateTimeFmt: AnsiString;
605 + begin
606 +  {$IF declared(DefaultFormatSettings)}
607 +  with DefaultFormatSettings do
608 +  {$ELSE}
609 +  {$IF declared(FormatSettings)}
610 +  with FormatSettings do
611 +  {$IFEND}
612 +  {$IFEND}
613 +  Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
614 + end;
615 +
616 + procedure TFBJournaling.EndSession(RetainJournal: boolean);
617 + begin
618 +  if JournalingActive and (FJournalFilePath <> '') then
619 +  begin
620 +    FreeAndNil(FJournalFileStream);
621 +    if not (joNoServerTable in FOptions) and not RetainJournal then
622 +    try
623 +        GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
624 +             sqlCleanUpSession,[FSessionID]);
625 +        sysutils.DeleteFile(FJournalFilePath);
626 +    except On E: EIBInterBaseError do
627 +      if E.IBErrorCode <> isc_lost_db_connection then
628 +        raise;
629 +      {ignore - do not delete journal if database gone away}
630 +    end;
631 +    FSessionID := -1;
632 +  end;
633 + end;
634 +
635 + procedure TFBJournaling.Disconnect(Force: boolean);
636 + begin
637 +  if JournalingActive then
638 +    EndSession(Force);
639 + end;
640 +
641 + procedure TFBJournaling.TransactionStart(Tr: ITransaction);
642 + var LogEntry: AnsiString;
643 +    TPBText: AnsiString;
644 + begin
645 +  FDoNotJournal := true;
646 +  if not (joNoServerTable in FOptions) then
647 +  try
648 +    GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
649 +  finally
650 +    FDoNotJournal := false;
651 +  end;
652 +  TPBText := Tr.getTPB.AsText;
653 +  LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
654 +                                     GetAttachment.GetAttachmentID,
655 +                                     FSessionID,
656 +                                     Tr.GetTransactionID,
657 +                                     Length(Tr.TransactionName),
658 +                                     Tr.TransactionName,
659 +                                     Length(TPBText),TPBText,
660 +                                     ord(tr.GetDefaultCompletion)]);
661 +  if assigned(FJournalFileStream) then
662 +    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
663 + end;
664 +
665 + function TFBJournaling.TransactionEnd(TransactionID: integer;
666 +  Action: TTransactionAction): boolean;
667 +
668 + var LogEntry: AnsiString;
669 + begin
670 +  Result := false;
671 +    case Action of
672 +    TARollback:
673 +      begin
674 +        LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
675 +                                              GetAttachment.GetAttachmentID,
676 +                                              FSessionID,TransactionID]);
677 +        Result := true;
678 +      end;
679 +    TACommit:
680 +      begin
681 +        LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
682 +                                            GetAttachment.GetAttachmentID,
683 +                                            FSessionID,TransactionID]);
684 +        Result := true;
685 +      end;
686 +    end;
687 +    if assigned(FJournalFileStream) then
688 +      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
689 + end;
690 +
691 + procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
692 +  OldTransactionID: integer; Action: TTransactionAction);
693 + var LogEntry: AnsiString;
694 + begin
695 +    case Action of
696 +      TACommitRetaining:
697 +          LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
698 +                                  GetAttachment.GetAttachmentID,
699 +                                  FSessionID,Tr.GetTransactionID,OldTransactionID]);
700 +      TARollbackRetaining:
701 +          LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
702 +                                      GetAttachment.GetAttachmentID,
703 +                                      FSessionID,Tr.GetTransactionID,OldTransactionID]);
704 +    end;
705 +    if assigned(FJournalFileStream) then
706 +      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
707 +
708 +    FDoNotJournal := true;
709 +    if not (joNoServerTable in FOptions) then
710 +    try
711 +      GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
712 +    finally
713 +      FDoNotJournal := false;
714 +   end;
715 + end;
716 +
717 + procedure TFBJournaling.ExecQuery(Stmt: IStatement);
718 + var SQL: AnsiString;
719 +    LogEntry: AnsiString;
720 + begin
721 +  SQL := TQueryProcessor.Execute(Stmt);
722 +  LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
723 +                                      GetAttachment.GetAttachmentID,
724 +                                      FSessionID,
725 +                                      Stmt.GetTransaction.GetTransactionID,
726 +                                      Length(SQL),SQL]);
727 +  if assigned(FJournalFileStream) then
728 +    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
729 + end;
730 +
731 + function TFBJournaling.JournalingActive: boolean;
732 + begin
733 +  Result := (FJournalFileStream <> nil) and not FDoNotJournal;
734 + end;
735 +
736 + function TFBJournaling.GetJournalOptions: TJournalOptions;
737 + begin
738 +  Result := FOptions;
739 + end;
740 +
741 + function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
742 + begin
743 +  Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
744 + end;
745 +
746 + function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
747 +  Options: TJournalOptions): integer;
748 + begin
749 +  try
750 +    StartJournaling(TFileStream.Create(aJournalLogFile,fmCreate),Options);
751 +  finally
752 +    FJournalFilePath := aJournalLogFile;
753 +  end;
754 + end;
755 +
756 + function TFBJournaling.StartJournaling(S: TStream; Options: TJournalOptions
757 +  ): integer;
758 + begin
759 +  FOptions := Options;
760 +  if not (joNoServerTable in FOptions) then
761 +  with GetAttachment do
762 +  begin
763 +    if  not HasTable(sJournalTableName) then
764 +    begin
765 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
766 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
767 +    end;
768 +    FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
769 +  end;
770 +  FJournalFileStream := S;
771 +  Result := FSessionID;
772 + end;
773 +
774 + procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
775 + begin
776 +  EndSession(RetainJournal);
777 + end;
778 +
779  
780  
781  
# Line 253 | Line 790 | var DBInfo: IDBInformation;
790   begin
791    if not IsConnected then Exit;
792    DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
793 <                               isc_info_db_SQL_Dialect]);
793 >                               isc_info_db_SQL_Dialect, isc_info_attachment_id]);
794    for i := 0 to DBInfo.GetCount - 1 do
795      with DBInfo[i] do
796        case getItemType of
# Line 263 | Line 800 | begin
800          FODSMajorVersion := getAsInteger;
801        isc_info_db_SQL_Dialect:
802          FSQLDialect := getAsInteger;
803 +      isc_info_attachment_id:
804 +        FAttachmentID := getAsInteger;
805        end;
806  
807    FCharSetID := 0;
# Line 273 | Line 812 | begin
812    begin
813      Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
814                      'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
815 <                    'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
815 >                    'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION ');
816      ResultSet := Stmt.OpenCursor;
817      if ResultSet.FetchNext then
818      begin
# Line 319 | Line 858 | begin
858    FFirebirdAPI := api.GetAPI; {Keep reference to interface}
859    FSQLDialect := 3;
860    FDatabaseName := DatabaseName;
322 –  FDPB := DPB;
861    SetLength(FUserCharSetMap,0);
324 –  FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
862    FODSMajorVersion := 0;
863    FODSMinorVersion := 0;
864 +  FInlineBlobLimit := DefaultMaxInlineBlobLimit;
865 +  FDPB := DPB;
866 +  FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
867   end;
868  
869   function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
# Line 457 | Line 997 | begin
997    end;
998   end;
999  
1000 + procedure TFBAttachment.UseServerICUChanged;
1001 + begin
1002 +  // Do nothing by default
1003 + end;
1004 +
1005   destructor TFBAttachment.Destroy;
1006   begin
1007    Disconnect(true);
# Line 532 | Line 1077 | begin
1077   end;
1078  
1079   function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1080 <  aSQLDialect: integer): IResultSet;
1080 >  aSQLDialect: integer; Scrollable: boolean): IResultSet;
1081   begin
1082 <  Result := OpenCursor(transaction,sql,aSQLDialect,[]);
1082 >  Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1083   end;
1084  
1085   function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1086    aSQLDialect: integer; params: array of const): IResultSet;
1087 < var Statement: IStatement;
1087 >
1088   begin
1089 <  CheckHandle;
545 <  Statement := Prepare(transaction,sql,aSQLDialect);
546 <  SetParameters(Statement.SQLParams,params);
547 <  Result := Statement.OpenCursor;
1089 >  Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1090   end;
1091  
1092 < function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
1093 <  ): IResultSet;
1092 > function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1093 >  Scrollable: boolean): IResultSet;
1094   begin
1095 <  Result := OpenCursor(transaction,sql,FSQLDialect,[]);
1095 >  Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,[]);
1096   end;
1097  
1098   function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1099    params: array of const): IResultSet;
1100   begin
1101 <  Result := OpenCursor(transaction,sql,FSQLDialect,params);
1101 >  Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1102 > end;
1103 >
1104 > function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1105 >  Scrollable: boolean; params: array of const): IResultSet;
1106 > begin
1107 >  Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,params);
1108 > end;
1109 >
1110 > function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1111 >  aSQLDialect: integer; Scrollable: boolean;
1112 >  params: array of const): IResultSet;
1113 > var Statement: IStatement;
1114 > begin
1115 >  CheckHandle;
1116 >  Statement := Prepare(transaction,sql,aSQLDialect);
1117 >  SetParameters(Statement.SQLParams,params);
1118 >  Result := Statement.OpenCursor(Scrollable);
1119   end;
1120  
1121   function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1122 <  sql: AnsiString; aSQLDialect: integer): IResultSet;
1122 >  sql: AnsiString; aSQLDialect: integer; Scrollable: boolean): IResultSet;
1123   begin
1124 <  Result := OpenCursor(transaction,sql,aSQLDialect,[]);
1124 >  Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1125    Result.FetchNext;
1126   end;
1127  
# Line 573 | Line 1132 | begin
1132    Result.FetchNext;
1133   end;
1134  
1135 < function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
1136 <  ): IResultSet;
1135 > function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1136 >  sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
1137 >  params: array of const): IResultSet;
1138   begin
1139 <  Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
1139 >  Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,params);
1140 >  Result.FetchNext;
1141 > end;
1142 >
1143 > function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1144 >  sql: AnsiString; Scrollable: boolean): IResultSet;
1145 > begin
1146 >  Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,[]);
1147   end;
1148  
1149   function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
# Line 585 | Line 1152 | begin
1152    Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
1153   end;
1154  
1155 < function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
1155 > function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1156 >  sql: AnsiString; Scrollable: boolean; params: array of const): IResultSet;
1157   begin
1158 <  Result := OpenCursorAtStart(sql,[]);
1158 >  Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,params);
1159 > end;
1160 >
1161 > function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean
1162 >  ): IResultSet;
1163 > begin
1164 >  Result := OpenCursorAtStart(sql,Scrollable,[]);
1165 > end;
1166 >
1167 > function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
1168 >  params: array of const): IResultSet;
1169 > begin
1170 >  Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
1171 >                   Scrollable,params);
1172   end;
1173  
1174   function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
1175    params: array of const): IResultSet;
1176   begin
1177 <  Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
1177 >  Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
1178 >                   false,params);
1179   end;
1180  
1181 < function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
1182 <  ): IStatement;
1181 > function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString;
1182 >  CursorName: AnsiString): IStatement;
1183   begin
1184 <  Result := Prepare(transaction,sql,FSQLDialect);
1184 >  Result := Prepare(transaction,sql,FSQLDialect,CursorName);
1185   end;
1186  
1187   function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
1188 <  sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean): IStatement;
1188 >  sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean;
1189 >  CursorName: AnsiString): IStatement;
1190   begin
1191 <  Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams);
1191 >  Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams,CursorName);
1192   end;
1193  
1194   function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
# Line 625 | Line 1208 | begin
1208    Result := FSQLDialect;
1209   end;
1210  
1211 + function TFBAttachment.GetAttachmentID: integer;
1212 + begin
1213 +  Result := FAttachmentID;
1214 + end;
1215 +
1216   function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1217    ColumnName: AnsiString; BPB: IBPB): IBlob;
1218   begin
# Line 724 | Line 1312 | begin
1312    Result := FODSMinorVersion;
1313   end;
1314  
1315 + function TFBAttachment.GetCharSetID: integer;
1316 + begin
1317 +  Result := FCharSetID;
1318 + end;
1319 +
1320 + function TFBAttachment.HasDecFloatSupport: boolean;
1321 + begin
1322 +  Result := false;
1323 + end;
1324 +
1325 + function TFBAttachment.GetInlineBlobLimit: integer;
1326 + begin
1327 +  Result := FInlineBlobLimit;
1328 + end;
1329 +
1330 + procedure TFBAttachment.SetInlineBlobLimit(limit: integer);
1331 + begin
1332 +  if limit > 32*1024 then
1333 +     FInlineBlobLimit := 32*1024
1334 +  else
1335 +    FInlineBlobLimit := limit;
1336 + end;
1337 +
1338 + function TFBAttachment.HasBatchMode: boolean;
1339 + begin
1340 +  Result := false;
1341 + end;
1342 +
1343 + function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
1344 + begin
1345 +  Result := OpenCursorAtStart(
1346 +       'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
1347 +          [aTableName])[0].AsInteger > 0;
1348 + end;
1349 +
1350 + function TFBAttachment.HasFunction(aFunctionName: AnsiString): boolean;
1351 + begin
1352 +  Result := OpenCursorAtStart(
1353 +       'Select count(*) From RDB$FUNCTIONS Where RDB$FUNCTION_NAME = ?',
1354 +          [aFunctionName])[0].AsInteger > 0;
1355 + end;
1356 +
1357 + function TFBAttachment.HasProcedure(aProcName: AnsiString): boolean;
1358 + begin
1359 +  Result := OpenCursorAtStart(
1360 +       'Select count(*) From RDB$PROCEDURES Where RDB$PROCEDURE_NAME = ?',
1361 +          [aProcName])[0].AsInteger > 0;
1362 + end;
1363 +
1364   function TFBAttachment.HasDefaultCharSet: boolean;
1365   begin
1366    Result := FHasDefaultCharSet
# Line 868 | Line 1505 | begin
1505    CharSetID := CharSets[0].AsInteger;
1506   end;
1507  
1508 + function TFBAttachment.GetTimeZoneServices: ITimeZoneServices;
1509 + begin
1510 +  IBError(ibxeNotSupported,[]);
1511 + end;
1512 +
1513 + function TFBAttachment.HasTimeZoneSupport: boolean;
1514 + begin
1515 +  Result := false;
1516 + end;
1517 +
1518 + { TDPBItem }
1519 +
1520 + function TDPBItem.getParamTypeName: AnsiString;
1521 + begin
1522 +  Result := DPBPrefix + DPBConstantNames[getParamType];
1523 + end;
1524 +
1525 + { TDPB }
1526 +
1527 + constructor TDPB.Create(api: TFBClientAPI);
1528 + begin
1529 +  inherited Create(api);
1530 +  FDataLength := 1;
1531 +  FBuffer^ := isc_dpb_version1;
1532 + end;
1533 +
1534 + function TDPB.GetParamTypeName(ParamType: byte): Ansistring;
1535 + begin
1536 +  if ParamType <= isc_dpb_last_dpb_constant then
1537 +    Result := DPBConstantNames[ParamType]
1538 +  else
1539 +    Result := '';
1540 + end;
1541 +
1542 + {$IFNDEF FPC}
1543 + function TDPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
1544 + begin
1545 +  Result := GetParamTypeName(ParamType);
1546 + end;
1547 + {$ENDIF}
1548 +
1549 + function TDPB.LookupItemType(ParamTypeName: AnsiString): byte;
1550 + var i: byte;
1551 + begin
1552 +  Result := 0;
1553 +  ParamTypeName := LowerCase(ParamTypeName);
1554 +  if (Pos(DPBPrefix, ParamTypeName) = 1) then
1555 +    Delete(ParamTypeName, 1, Length(DPBPrefix));
1556 +
1557 +  for i := 1 to isc_dpb_last_dpb_constant do
1558 +    if (ParamTypeName = DPBConstantNames[i]) then
1559 +    begin
1560 +      Result := i;
1561 +      break;
1562 +    end;
1563 + end;
1564 +
1565   end.
1566  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines