[ViewVC] Diff of: public/ibx/branches/udr/client/FBAttachment.pas

Comparing:
ibx/trunk/fbintf/client/FBAttachment.pas (file contents), Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs.
ibx/branches/journaling/fbintf/client/FBAttachment.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

+uses
+  Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
-<
+  FBActivityMonitor, FBClientAPI;
->
+  FBActivityMonitor, FBClientAPI, IBUtils;
+const
+  DefaultMaxInlineBlobLimit = 8192;
+    AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
+  end;
-+
+  { Database Journalling.
-+
-+
+    This class is intended to support a client side journal of all database
-+
+    updates, inserts and deletes made by the client during a session. It also records
-+
+    the transaction each update was made under.
-+
-+
+    The database schema is required to include a control table "IBX$JOURNALS" and
-+
+    an SQL Sequence IBX$SESSIONS. These are created by the class when the
-+
+    database is opened, if they are not already present. However, it is recommended
-+
+    that they are created as an orginal part of the database schema in order to
-+
+    unnecessarily avoid each user being given sufficient priviledge to create tables
-+
+    and Sequences.
-+
-+
+    Syntax:
-+
-+
+    Transaction Start:
-+
+    *S:<date/time>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
-+
-+
+    Transaction Commit:
-+
+    *C:<date/time>,<session id>,<transaction no.>
-+
-+
+    Transaction Commit retaining :
-+
+    *c:<date/time>,<session id>,<transaction no.><old transaction no.>
-+
-+
+    Transaction Rollback:
-+
+    *R:<date/time>,<session id>,<transaction no.>
-+
-+
+    Transaction Rollback retaining:
-+
+    *r:<date/time>,<session id>,<transaction no.><old transaction no.>
-+
-+
+    Update/Insert/Delete
-+
+    *Q:<date/time>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
-+
-+
+  }
-+
-+
+  { TFBJournaling }
-+
-+
+  TFBJournaling = class(TActivityHandler, IJournallingHook)
-+
+  private
-+
+    {Logfile}
-+
+    const sQueryJournal          = '*Q:''%s'',%d,%d,%d:%s' + LineEnding;
-+
+    const sTransStartJnl         = '*S:''%s'',%d,%d,%d:%s,%d:%s,%d' + LineEnding;
-+
+    const sTransCommitJnl        = '*C:''%s'',%d,%d' + LineEnding;
-+
+    const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d' + LineEnding;
-+
+    const sTransRollBackJnl      = '*R:''%s'',%d,%d' + LineEnding;
-+
+    const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d' + LineEnding;
-+
+  private
-+
+    FOptions: TJournalOptions;
-+
+    FJournalFilePath: string;
-+
+    FJournalFileStream: TStream;
-+
+    FSessionID: integer;
-+
+    FDoNotJournal: boolean;
-+
+    function GetDateTimeFmt: AnsiString;
-+
+  protected
-+
+    procedure EndSession(RetainJournal: boolean);
-+
+    function GetAttachment: IAttachment; virtual; abstract;
-+
+  public
-+
+    {IAttachment}
-+
+    procedure Disconnect(Force: boolean=false); virtual;
-+
+  public
-+
+    {IJournallingHook}
-+
+    procedure TransactionStart(Tr: ITransaction);
-+
+    function TransactionEnd( TransactionID: integer; Action: TTransactionAction): boolean;
-+
+    procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer;
-+
+      Action: TTransactionAction);
-+
+    procedure ExecQuery(Stmt: IStatement);
-+
+  public
-+
+    {Client side Journaling}
-+
+    function JournalingActive: boolean;
-+
+    function GetJournalOptions: TJournalOptions;
-+
+    function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
-+
+    function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
-+
+    procedure StopJournaling(RetainJournal: boolean);
-+
+  end;
-+
+  { TFBAttachment }
-<
+  TFBAttachment = class(TActivityHandler)
->
+  TFBAttachment = class(TFBJournaling)
+  private
+    FDPB: IDPB;
+    FFirebirdAPI: IFirebirdAPI;
+    function getDPB: IDPB;
+    function AllocateBPB: IBPB;
+    function AllocateDIRB: IDIRB;
-<
+    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
-<
+    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
-<
+    procedure Disconnect(Force: boolean=false); virtual; abstract;
->
+    function StartTransaction(TPB: array of byte;
->
+      DefaultCompletion: TTransactionCompletion;
->
+      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
->
+    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
->
+      aName: AnsiString=''): ITransaction; overload; virtual; abstract;
+    procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
+    procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
+    procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
+    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
+    function GetDBInformation(Request: byte): IDBInformation; overload;
+    function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
-+
+    function GetAttachmentID: integer;
+    function GetConnectString: AnsiString;
+    function GetRemoteProtocol: AnsiString;
+    function GetAuthenticationMethod: AnsiString;
+    function GetInlineBlobLimit: integer;
+    procedure SetInlineBlobLimit(limit: integer);
+    function HasBatchMode: boolean; virtual;
-+
+    function HasTable(aTableName: AnsiString): boolean;
+  public
+    {Character Sets}
+implementation
-<
+uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
->
+uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
->
->
+const
->
+  {Journaling}
->
+  sJournalTableName = 'IBX$JOURNALS';
->
+  sSequenceName = 'IBX$SESSIONS';
->
->
+  sqlCreateJournalTable =
->
+    'Create Table ' + sJournalTableName + '(' +
->
+    '  IBX$SessionID Integer not null, '+
->
+    '  IBX$TransactionID Integer not null, '+
->
+    '  IBX$OldTransactionID Integer, '+
->
+    '  IBX$USER VarChar(32) Default CURRENT_USER, '+
->
+    '  IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
->
+    '  Primary Key(IBX$SessionID,IBX$TransactionID)' +
->
+    ')';
->
->
+  sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
->
->
+  sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
->
->
+  sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
->
+                        'Values(?,?,?)';
->
->
+  sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
+const
+  CharSetMap: array [0..69] of TCharsetMap = (
+    'decfloat_traps'
+    );
-+
+type
-+
-+
+  { TQueryProcessor }
-+
-+
+  TQueryProcessor=class(TSQLTokeniser)
-+
+  private
-+
+    FInString: AnsiString;
-+
+    FIndex: integer;
-+
+    FStmt: IStatement;
-+
+    function DoExecute: AnsiString;
-+
+    function GetParamValue(ParamIndex: integer): AnsiString;
-+
+  protected
-+
+    function GetChar: AnsiChar; override;
-+
+  public
-+
+    class function Execute(Stmt: IStatement): AnsiString;
-+
+  end;
-+
-+
+  { TQueryProcessor }
-+
-+
+function TQueryProcessor.DoExecute: AnsiString;
-+
+var token: TSQLTokens;
-+
+    ParamIndex: integer;
-+
+begin
-+
+  Result := '';
-+
+  ParamIndex := 0;
-+
-+
+  while not EOF do
-+
+  begin
-+
+    token := GetNextToken;
-+
+    case token of
-+
+    sqltPlaceHolder:
-+
+      begin
-+
+        Result := Result + GetParamValue(ParamIndex);
-+
+        Inc(ParamIndex);
-+
+      end;
-+
+    else
-+
+      Result := Result + TokenText;
-+
+    end;
-+
+  end;
-+
+end;
-+
-+
+function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
-+
+begin
-+
+  with FStmt.SQLParams[ParamIndex] do
-+
+  begin
-+
+    if IsNull then
-+
+      Result := 'NULL'
-+
+    else
-+
+    case GetSQLType of
-+
+    SQL_BLOB:
-+
+      if getSubType = 1 then {string}
-+
+        Result := '''' + SQLSafeString(GetAsString) + ''''
-+
+      else
-+
+        Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
-+
-+
+    SQL_ARRAY:
-+
+        Result := TSQLXMLReader.FormatArray(getAsArray);
-+
-+
+    SQL_VARYING,
-+
+    SQL_TEXT,
-+
+    SQL_TIMESTAMP,
-+
+    SQL_TYPE_DATE,
-+
+    SQL_TYPE_TIME,
-+
+    SQL_TIMESTAMP_TZ_EX,
-+
+    SQL_TIME_TZ_EX,
-+
+    SQL_TIMESTAMP_TZ,
-+
+    SQL_TIME_TZ:
-+
+      Result := '''' + SQLSafeString(GetAsString) + '''';
-+
+    else
-+
+      Result := GetAsString;
-+
+    end;
-+
+  end;
-+
+end;
-+
-+
+function TQueryProcessor.GetChar: AnsiChar;
-+
+begin
-+
+  if FIndex <= Length(FInString) then
-+
+  begin
-+
+    Result := FInString[FIndex];
-+
+    Inc(FIndex);
-+
+  end
-+
+  else
-+
+    Result := #0;
-+
+end;
-+
-+
+class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
-+
+begin
-+
+  if not Stmt.IsPrepared then
-+
+    IBError(ibxeSQLClosed,[]);
-+
+  with self.Create do
-+
+  try
-+
+    FStmt := Stmt;
-+
+    FInString := Stmt.GetProcessedSQLText;
-+
+    FIndex := 1;
-+
+    Result := Trim(DoExecute);
-+
+  finally
-+
+    Free;
-+
+  end;
-+
+end;
-+
-+
+{ TFBJournaling }
-+
-+
+function TFBJournaling.GetDateTimeFmt: AnsiString;
-+
+begin
-+
+  {$IF declared(DefaultFormatSettings)}
-+
+  with DefaultFormatSettings do
-+
+  {$ELSE}
-+
+  {$IF declared(FormatSettings)}
-+
+  with FormatSettings do
-+
+  {$IFEND}
-+
+  {$IFEND}
-+
+  Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
-+
+end;
-+
-+
+procedure TFBJournaling.EndSession(RetainJournal: boolean);
-+
+begin
-+
+  if JournalingActive then
-+
+  begin
-+
+    FreeAndNil(FJournalFileStream);
-+
+    if not RetainJournal then
-+
+    try
-+
+        GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
-+
+             sqlCleanUpSession,[FSessionID]);
-+
+        sysutils.DeleteFile(FJournalFilePath);
-+
+    except On E: EIBInterBaseError do
-+
+      if E.IBErrorCode <> isc_lost_db_connection then
-+
+        raise;
-+
+      {ignore - do not delete journal if database gone away}
-+
+    end;
-+
+    FSessionID := -1;
-+
+  end;
-+
+end;
-+
-+
+procedure TFBJournaling.Disconnect(Force: boolean);
-+
+begin
-+
+  if JournalingActive then
-+
+    EndSession(Force);
-+
+end;
-+
-+
+procedure TFBJournaling.TransactionStart(Tr: ITransaction);
-+
+var LogEntry: AnsiString;
-+
+    TPBText: AnsiString;
-+
+begin
-+
+  FDoNotJournal := true;
-+
+  try
-+
+    GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
-+
+  finally
-+
+    FDoNotJournal := false;
-+
+  end;
-+
+  TPBText := Tr.getTPB.AsText;
-+
+  LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
-+
+                                     FSessionID,
-+
+                                     Tr.GetTransactionID,
-+
+                                     Length(Tr.TransactionName),
-+
+                                     Tr.TransactionName,
-+
+                                     Length(TPBText),TPBText,
-+
+                                     ord(tr.GetDefaultCompletion)]);
-+
+  if assigned(FJournalFileStream) then
-+
+    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
-+
+end;
-+
-+
+function TFBJournaling.TransactionEnd(TransactionID: integer;
-+
+  Action: TTransactionAction): boolean;
-+
-+
+var LogEntry: AnsiString;
-+
+begin
-+
+  Result := false;
-+
+    case Action of
-+
+    TARollback:
-+
+      begin
-+
+        LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
-+
+        Result := true;
-+
+      end;
-+
+    TACommit:
-+
+      begin
-+
+        LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
-+
+        Result := true;
-+
+      end;
-+
+    end;
-+
+    if assigned(FJournalFileStream) then
-+
+      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
-+
+end;
-+
-+
+procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
-+
+  OldTransactionID: integer; Action: TTransactionAction);
-+
+var LogEntry: AnsiString;
-+
+begin
-+
+    case Action of
-+
+      TACommitRetaining:
-+
+          LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
-+
+                                  FSessionID,Tr.GetTransactionID,OldTransactionID]);
-+
+      TARollbackRetaining:
-+
+          LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
-+
+                                      FSessionID,Tr.GetTransactionID,OldTransactionID]);
-+
+    end;
-+
+    if assigned(FJournalFileStream) then
-+
+      FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
-+
-+
+    FDoNotJournal := true;
-+
+    try
-+
+      GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
-+
+    finally
-+
+      FDoNotJournal := false;
-+
+   end;
-+
+end;
-+
-+
+procedure TFBJournaling.ExecQuery(Stmt: IStatement);
-+
+var SQL: AnsiString;
-+
+    LogEntry: AnsiString;
-+
+begin
-+
+  SQL := TQueryProcessor.Execute(Stmt);
-+
+  LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
-+
+                                      FSessionID,
-+
+                                      Stmt.GetTransaction.GetTransactionID,
-+
+                                      Length(SQL),SQL]);
-+
+  if assigned(FJournalFileStream) then
-+
+    FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
-+
+end;
-+
-+
+function TFBJournaling.JournalingActive: boolean;
-+
+begin
-+
+  Result := (FJournalFileStream <> nil) and not FDoNotJournal;
-+
+end;
-+
-+
+function TFBJournaling.GetJournalOptions: TJournalOptions;
-+
+begin
-+
+  Result := FOptions;
-+
+end;
-+
-+
+function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
-+
+begin
-+
+  Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
-+
+end;
-+
-+
+function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
-+
+  Options: TJournalOptions): integer;
-+
+begin
-+
+  FOptions := Options;
-+
+  with GetAttachment do
-+
+  begin
-+
+    if not HasTable(sJournalTableName) then
-+
+    begin
-+
+      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
-+
+      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
-+
+    end;
-+
+    FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
-+
+  end;
-+
+  FJournalFilePath := aJournalLogFile;
-+
+  FJournalFileStream := TFileStream.Create(FJournalFilePath,fmCreate);
-+
+  Result := FSessionID;
-+
+end;
-+
-+
+procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
-+
+begin
-+
+  EndSession(RetainJournal);
-+
+end;
-+
-+
+{ TFBAttachment }
+    Result := GetDBInfo(getBuffer,getDataLength);
+end;
-+
+function TFBAttachment.GetAttachmentID: integer;
-+
+var Info: IDBInformation;
-+
+begin
-+
+  Info := GetDBInformation(isc_info_attachment_id);
-+
+  if (Info.Count > 0) and (Info[0].getItemType = isc_info_attachment_id) then
-+
+    Result := Info[0].getAsInteger
-+
+  else
-+
+    Result := -1;
-+
+end;
-+
+function TFBAttachment.GetConnectString: AnsiString;
+begin
+  Result := FDatabaseName;
+  Result := false;
+end;
-+
+function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
-+
+begin
-+
+  Result := OpenCursorAtStart(
-+
+       'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
-+
+          [aTableName])[0].AsInteger > 0;
-+
+end;
-+
+function TFBAttachment.HasDefaultCharSet: boolean;
+begin
+  Result := FHasDefaultCharSet

Diff Legend

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

Comparing: ibx/trunk/fbintf/client/FBAttachment.pas (file contents), Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs. ibx/branches/journaling/fbintf/client/FBAttachment.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

Diff Legend

Comparing:
ibx/trunk/fbintf/client/FBAttachment.pas (file contents), Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs.
ibx/branches/journaling/fbintf/client/FBAttachment.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC