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/branches/journaling/fbintf/client/FBAttachment.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
ibx/branches/udr/client/FBAttachment.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 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;
# Line 53 | 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 64 | Line 140 | type
140      FUserCharSetMap: array of TCharSetMap;
141      FSecDatabase: AnsiString;
142      FInlineBlobLimit: integer;
143 <  protected
68 <    FDatabaseName: AnsiString;
69 <    FRaiseExceptionOnConnectError: boolean;
143 >    FAttachmentID: integer;
144      FSQLDialect: integer;
145      FHasDefaultCharSet: boolean;
146      FCharSetID: integer;
147      FCodePage: TSystemCodePage;
148      FRemoteProtocol: AnsiString;
149      FAuthMethod: AnsiString;
150 +    FHasConnectionInfo: boolean;
151 +    procedure NeedDBInfo;
152 +    procedure NeedConnectionInfo;
153 +  protected
154 +    FDatabaseName: AnsiString;
155 +    FRaiseExceptionOnConnectError: boolean;
156      constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
157        RaiseExceptionOnConnectError: boolean);
158      procedure CheckHandle; virtual; abstract;
159 +    procedure ClearCachedInfo;
160      function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
80    procedure GetODSAndConnectionInfo;
161      function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
162      function IsConnected: boolean; virtual; abstract;
163      procedure EndAllTransactions;
164      procedure DPBFromCreateSQL(CreateSQL: AnsiString);
165      procedure SetParameters(SQLParams: ISQLParams; params: array of const);
166 +    procedure SetSQLDialect(aValue: integer);
167      procedure UseServerICUChanged; virtual;
168    public
169      destructor Destroy; override;
170 +    procedure Disconnect(Force: boolean); override;
171      function getFirebirdAPI: IFirebirdAPI;
172      function getDPB: IDPB;
173      function AllocateBPB: IBPB;
174      function AllocateDIRB: IDIRB;
175 <    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
176 <    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
177 <    procedure Disconnect(Force: boolean=false); virtual; abstract;
175 >    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      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;
# Line 140 | Line 224 | type
224      function GetEventHandler(Event: AnsiString): IEvents; overload;
225  
226      function GetSQLDialect: integer;
227 +    function GetAttachmentID: integer;
228      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      function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
# Line 150 | Line 235 | type
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 <    property SQLDialect: integer read FSQLDialect;
238 >    property SQLDialect: integer read GetSQLDialect;
239      property DPB: IDPB read FDPB;
240    public
241      function GetDBInformation(Requests: array of byte): IDBInformation; overload;
# Line 162 | Line 247 | type
247      function GetSecurityDatabase: AnsiString;
248      function GetODSMajorVersion: integer;
249      function GetODSMinorVersion: integer;
250 +    function GetCharSetID: integer;
251      function HasDecFloatSupport: boolean; virtual;
252      function GetInlineBlobLimit: integer;
253      procedure SetInlineBlobLimit(limit: integer);
254      function HasBatchMode: boolean; virtual;
255 +    function HasTable(aTableName: AnsiString): boolean;
256 +    function HasFunction(aFunctionName: AnsiString): boolean;
257 +    function HasProcedure(aProcName: AnsiString): boolean;
258  
259    public
260      {Character Sets}
# Line 180 | Line 269 | type
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 <    property CharSetID: integer read FCharSetID;
272 >    property CharSetID: integer read GetCharSetID;
273      property CodePage: TSystemCodePage read FCodePage;
274  
275    public
# Line 214 | Line 303 | type
303  
304   implementation
305  
306 < uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
306 > uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
307 >
308 > const
309 >  {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    CharSetMap: array [0..69] of TCharsetMap = (
# Line 391 | Line 504 | const
504      'decfloat_traps'
505      );
506  
507 + type
508 +
509 +  { TQueryProcessor }
510 +
511 +  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 +  if JournalingActive and (FJournalFilePath <> '') then
624 +  begin
625 +    FreeAndNil(FJournalFileStream);
626 +    if not (joNoServerTable in FOptions) and not RetainJournal then
627 +    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 +  if not (joNoServerTable in FOptions) then
652 +  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 +                                     GetAttachment.GetAttachmentID,
660 +                                     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 +        LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
680 +                                              GetAttachment.GetAttachmentID,
681 +                                              FSessionID,TransactionID]);
682 +        Result := true;
683 +      end;
684 +    TACommit:
685 +      begin
686 +        LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
687 +                                            GetAttachment.GetAttachmentID,
688 +                                            FSessionID,TransactionID]);
689 +        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 +                                  GetAttachment.GetAttachmentID,
704 +                                  FSessionID,Tr.GetTransactionID,OldTransactionID]);
705 +      TARollbackRetaining:
706 +          LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
707 +                                      GetAttachment.GetAttachmentID,
708 +                                      FSessionID,Tr.GetTransactionID,OldTransactionID]);
709 +    end;
710 +    if assigned(FJournalFileStream) then
711 +      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
712 +
713 +    FDoNotJournal := true;
714 +    if not (joNoServerTable in FOptions) then
715 +    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 +                                      GetAttachment.GetAttachmentID,
729 +                                      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 +  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 +  FOptions := Options;
765 +  if not (joNoServerTable in FOptions) then
766 +  with GetAttachment do
767 +  begin
768 +    if  not HasTable(sJournalTableName) then
769 +    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 +  FJournalFileStream := S;
776 +  Result := FSessionID;
777 + end;
778  
779 + procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
780 + begin
781 +  EndSession(RetainJournal);
782 + end;
783  
784   { TFBAttachment }
785  
786 < procedure TFBAttachment.GetODSAndConnectionInfo;
787 < var DBInfo: IDBInformation;
400 <    i: integer;
401 <    Stmt: IStatement;
786 > procedure TFBAttachment.NeedConnectionInfo;
787 > var Stmt: IStatement;
788      ResultSet: IResultSet;
789      Param: IDPBItem;
790   begin
791 <  if not IsConnected then Exit;
792 <  DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
407 <                               isc_info_db_SQL_Dialect]);
408 <  for i := 0 to DBInfo.GetCount - 1 do
409 <    with DBInfo[i] do
410 <      case getItemType of
411 <      isc_info_ods_minor_version:
412 <        FODSMinorVersion := getAsInteger;
413 <      isc_info_ods_version:
414 <        FODSMajorVersion := getAsInteger;
415 <      isc_info_db_SQL_Dialect:
416 <        FSQLDialect := getAsInteger;
417 <      end;
418 <
791 >  if not IsConnected or FHasConnectionInfo then Exit;
792 >  NeedDBInfo;
793    FCharSetID := 0;
794    FRemoteProtocol := '';
795    FAuthMethod := 'Legacy_Auth';
# Line 461 | Line 835 | begin
835      end;
836    end;
837    FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
838 +  FHasConnectionInfo := true;
839 + end;
840 +
841 + 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   constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
# Line 470 | Line 866 | begin
866    FFirebirdAPI := api.GetAPI; {Keep reference to interface}
867    FSQLDialect := 3;
868    FDatabaseName := DatabaseName;
473  FDPB := DPB;
869    SetLength(FUserCharSetMap,0);
870 +  ClearCachedInfo;
871 +  FInlineBlobLimit := DefaultMaxInlineBlobLimit;
872 +  FDPB := DPB;
873    FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
874 + end;
875 +
876 + procedure TFBAttachment.ClearCachedInfo;
877 + begin
878 +  FHasDefaultCharSet := false;
879 +  FAttachmentID := 0;
880    FODSMajorVersion := 0;
881    FODSMinorVersion := 0;
882 <  FInlineBlobLimit := DefaultMaxInlineBlobLimit;
882 >  FCodePage := CP_NONE;
883 >  FCharSetID := 0;
884 >  FRemoteProtocol := '';
885 >  FAuthMethod := '';
886 >  FSecDatabase := '';
887 >  FHasConnectionInfo := false;
888   end;
889  
890   function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
# Line 609 | Line 1018 | begin
1018    end;
1019   end;
1020  
1021 + procedure TFBAttachment.SetSQLDialect(aValue: integer);
1022 + begin
1023 +  FSQLDialect := aValue;
1024 + end;
1025 +
1026   procedure TFBAttachment.UseServerICUChanged;
1027   begin
1028    // Do nothing by default
# Line 620 | Line 1034 | begin
1034    inherited Destroy;
1035   end;
1036  
1037 + procedure TFBAttachment.Disconnect(Force: boolean);
1038 + begin
1039 +  inherited Disconnect(Force);
1040 +  ClearCachedInfo;
1041 + end;
1042 +
1043   function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
1044   begin
1045    Result := FFirebirdAPI;
# Line 817 | Line 1237 | end;
1237  
1238   function TFBAttachment.GetSQLDialect: integer;
1239   begin
1240 +  NeedDBInfo;
1241    Result := FSQLDialect;
1242   end;
1243  
1244 + function TFBAttachment.GetAttachmentID: integer;
1245 + begin
1246 +  NeedDBInfo;
1247 +  Result := FAttachmentID;
1248 + end;
1249 +
1250   function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1251    ColumnName: AnsiString; BPB: IBPB): IBlob;
1252   begin
# Line 896 | Line 1323 | end;
1323  
1324   function TFBAttachment.GetRemoteProtocol: AnsiString;
1325   begin
1326 +  NeedConnectionInfo;
1327    Result := FRemoteProtocol;
1328   end;
1329  
1330   function TFBAttachment.GetAuthenticationMethod: AnsiString;
1331   begin
1332 +  NeedConnectionInfo;
1333    Result := FAuthMethod;
1334   end;
1335  
1336   function TFBAttachment.GetSecurityDatabase: AnsiString;
1337   begin
1338 +  NeedConnectionInfo;
1339    Result := FSecDatabase;
1340   end;
1341  
1342   function TFBAttachment.GetODSMajorVersion: integer;
1343   begin
1344 +  NeedDBInfo;
1345    Result := FODSMajorVersion;
1346   end;
1347  
1348   function TFBAttachment.GetODSMinorVersion: integer;
1349   begin
1350 +  NeedDBInfo;
1351    Result := FODSMinorVersion;
1352   end;
1353  
1354 + function TFBAttachment.GetCharSetID: integer;
1355 + begin
1356 +  NeedConnectionInfo;
1357 +  Result := FCharSetID;
1358 + end;
1359 +
1360   function TFBAttachment.HasDecFloatSupport: boolean;
1361   begin
1362    Result := false;
# Line 942 | Line 1380 | begin
1380    Result := false;
1381   end;
1382  
1383 + 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 + 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   function TFBAttachment.HasDefaultCharSet: boolean;
1405   begin
1406 +  NeedConnectionInfo;
1407    Result := FHasDefaultCharSet
1408   end;
1409  
1410   function TFBAttachment.GetDefaultCharSetID: integer;
1411   begin
1412 +  NeedConnectionInfo;
1413    Result := FCharsetID;
1414   end;
1415  

Comparing:
ibx/branches/journaling/fbintf/client/FBAttachment.pas (property svn:eol-style), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC vs.
ibx/branches/udr/client/FBAttachment.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines