ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

# Line 35 | Line 35 | unit IBDatabase;
35  
36   {$Mode Delphi}
37  
38 {$IF FPC_FULLVERSION >= 20700 }
38   {$codepage UTF8}
40 {$DEFINE HAS_ANSISTRING_CODEPAGE}
41 {$ENDIF}
39  
40   interface
41  
# Line 48 | Line 45 | uses
45   {$ELSE}
46    unix,
47   {$ENDIF}
48 <  SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
52 <  IB, CustApp;
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49  
50   const
51    DPBPrefix = 'isc_dpb_';
# Line 120 | Line 116 | const
116      'set_db_readonly',
117      'set_db_sql_dialect',
118      'gfix_attach',
119 <    'gstat_attach'
119 >    'gstat_attach',
120 >    'set_db_charset',
121 >    'gsec_attach',
122 >    'address_path' ,
123 >    'process_id',
124 >    'no_db_triggers',
125 >    'trusted_auth',
126 >    'process_name',
127 >    'trusted_role',
128 >    'org_filename',
129 >    'utf8_ilename',
130 >    'ext_call_depth'
131    );
132  
133    TPBPrefix = 'isc_tpb_';
# Line 144 | Line 151 | const
151      'rec_version',
152      'no_rec_version',
153      'restart_requests',
154 <    'no_auto_undo'
154 >    'no_auto_undo',
155 >    'lock_timeout'
156    );
157  
158   type
# Line 160 | Line 168 | type
168    { TIBDatabase }
169    TIBDataBase = class(TCustomConnection)
170    private
171 +    FAttachment: IAttachment;
172 +    FCreateDatabase: boolean;
173 +    FCreateIfNotExists: boolean;
174 +    FDPB: IDPB;
175      FAllowStreamedConnected: boolean;
176      FHiddenPassword: string;
177 <    FIBLoaded: Boolean;
177 >    FOnCreateDatabase: TNotifyEvent;
178      FOnLogin: TIBDatabaseLoginEvent;
179      FSQLHourGlass: Boolean;
180      FTraceFlags: TTraceFlags;
181      FDBSQLDialect: Integer;
182      FSQLDialect: Integer;
183      FOnDialectDowngradeWarning: TNotifyEvent;
172    FCanTimeout: Boolean;
184      FSQLObjects: TList;
185      FTransactions: TList;
186      FDBName: TIBFileName;
187      FDBParams: TStrings;
188      FDBParamsChanged: Boolean;
178    FDPB: PChar;
179    FDPBLength: Short;
180    FHandle: TISC_DB_HANDLE;
181    FHandleIsShared: Boolean;
189      FOnIdleTimer: TNotifyEvent;
190      FDefaultTransaction: TIBTransaction;
191      FInternalTransaction: TIBTransaction;
185    FStreamedConnected: Boolean;
192      FTimer: TFPTimer;
193      FUserNames: TStringList;
194      FDataSets: TList;
195      FLoginCalled: boolean;
190    FCharSetSizes: array of integer;
191    FCharSetNames: array of RawByteString;
192    FDefaultCharSetName: RawByteString;
193    {$IFDEF HAS_ANSISTRING_CODEPAGE}
194    FCodePages: array of TSystemCodePage;
195    FDefaultCodePage: TSystemCodePage;
196    {$ENDIF}
196      FUseDefaultSystemCodePage: boolean;
197      procedure EnsureInactive;
198      function GetDBSQLDialect: Integer;
199 +    function GetDefaultCharSetID: integer;
200 +    function GetDefaultCharSetName: AnsiString;
201 +    function GetDefaultCodePage: TSystemCodePage;
202      function GetSQLDialect: Integer;
203      procedure SetSQLDialect(const Value: Integer);
204      procedure ValidateClientSQLDialect;
# Line 204 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
207    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
212      function Login(var aDatabaseName: string): Boolean;
212    procedure LoadCharSetInfo;
213      procedure SetDatabaseName(const Value: TIBFileName);
214      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215      procedure SetDBParams(Value: TStrings);
# Line 240 | Line 240 | type
240      procedure CloseDataSets;
241      procedure CheckActive;
242      procedure CheckInactive;
243 <    procedure CreateDatabase;
243 >    procedure CreateDatabase; overload;
244 >    procedure CreateDatabase(createDatabaseSQL: string); overload;
245      procedure DropDatabase;
246      procedure ForceClose;
247      procedure GetFieldNames(const TableName: string; List: TStrings);
# Line 248 | Line 249 | type
249      function IndexOfDBConst(st: String): Integer;
250      function TestConnected: Boolean;
251      procedure CheckDatabaseName;
251    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
252      function AddTransaction(TR: TIBTransaction): Integer;
253      function FindTransaction(TR: TIBTransaction): Integer;
254      function FindDefaultTransaction(): TIBTransaction;
255      procedure RemoveTransaction(Idx: Integer);
256      procedure RemoveTransactions;
257    procedure SetHandle(Value: TISC_DB_HANDLE);
257  
258 <    property Handle: TISC_DB_HANDLE read FHandle;
258 >    property Attachment: IAttachment read FAttachment;
259 >    property DBSQLDialect : Integer read FDBSQLDialect;
260      property IsReadOnly: Boolean read GetIsReadOnly;
261    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
262                                                      write SetDBParamByDPB;
261      property SQLObjectCount: Integer read GetSQLObjectCount;
262      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
265    property HandleIsShared: Boolean read FHandleIsShared;
263      property TransactionCount: Integer read GetTransactionCount;
264      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265      property InternalTransaction: TIBTransaction read FInternalTransaction;
266 <    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267 <    {$IFDEF HAS_ANSISTRING_CODEPAGE}
268 <    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
272 <    {$ENDIF}
266 >    property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
267 >    property DefaultCharSetID: integer read GetDefaultCharSetID;
268 >    property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
269  
270    published
271      property Connected;
272 +    property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
273      property AllowStreamedConnected: boolean read FAllowStreamedConnected
274               write FAllowStreamedConnected;
275      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
# Line 283 | Line 280 | type
280      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282      property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
286    property DBSQLDialect : Integer read FDBSQLDialect;
283      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284      property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285                                                 write FUseDefaultSystemCodePage;
# Line 291 | Line 287 | type
287      property AfterDisconnect;
288      property BeforeConnect;
289      property BeforeDisconnect;
290 +    property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
291      property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
292      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
293      property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
294    end;
295  
296 <  { TIBTransaction }
296 >  TDefaultEndAction = TARollback..TACommit;
297  
298 <  TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
298 >  { TIBTransaction }
299  
300    TIBTransaction = class(TComponent)
301    private
302 +    FTransactionIntf: ITransaction;
303      FAfterDelete: TNotifyEvent;
304      FAfterEdit: TNotifyEvent;
305      FAfterExecQuery: TNotifyEvent;
# Line 309 | Line 307 | type
307      FAfterPost: TNotifyEvent;
308      FAfterTransactionEnd: TNotifyEvent;
309      FBeforeTransactionEnd: TNotifyEvent;
312    FIBLoaded: Boolean;
313    FCanTimeout         : Boolean;
310      FDatabases          : TList;
311      FOnStartTransaction: TNotifyEvent;
312      FSQLObjects         : TList;
313      FDefaultDatabase    : TIBDatabase;
318    FHandle             : TISC_TR_HANDLE;
319    FHandleIsShared     : Boolean;
314      FOnIdleTimer          : TNotifyEvent;
315      FStreamedActive     : Boolean;
316 <    FTPB                : PChar;
323 <    FTPBLength          : Short;
316 >    FTPB                : ITPB;
317      FTimer              : TFPTimer;
318 <    FDefaultAction      : TTransactionAction;
318 >    FDefaultAction      : TDefaultEndAction;
319      FTRParams           : TStrings;
320      FTRParamsChanged    : Boolean;
321      FInEndTransaction   : boolean;
# Line 345 | Line 338 | type
338      function GetIdleTimer: Integer;
339      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340      procedure SetActive(Value: Boolean);
348    procedure SetDefaultAction(Value: TTransactionAction);
341      procedure SetDefaultDatabase(Value: TIBDatabase);
342      procedure SetIdleTimer(Value: Integer);
343      procedure SetTRParams(Value: TStrings);
# Line 358 | Line 350 | type
350  
351    protected
352      procedure Loaded; override;
361    procedure SetHandle(Value: TISC_TR_HANDLE);
353      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
354  
355    public
356      constructor Create(AOwner: TComponent); override;
357      destructor Destroy; override;
367    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358      procedure Commit;
359      procedure CommitRetaining;
360      procedure Rollback;
# Line 385 | Line 375 | type
375      property Databases[Index: Integer]: TIBDatabase read GetDatabase;
376      property SQLObjectCount: Integer read GetSQLObjectCount;
377      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
388    property Handle: TISC_TR_HANDLE read FHandle;
389    property HandleIsShared: Boolean read FHandleIsShared;
378      property InTransaction: Boolean read GetInTransaction;
379 <    property TPB: PChar read FTPB;
380 <    property TPBLength: Short read FTPBLength;
379 >    property TransactionIntf: ITransaction read FTransactionIntf;
380 >    property TPB: ITPB read FTPB;
381    published
382      property Active: Boolean read GetInTransaction write SetActive;
383      property DefaultDatabase: TIBDatabase read FDefaultDatabase
384                                             write SetDefaultDatabase;
385      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
386 <    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
386 >    property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
387      property Params: TStrings read FTRParams write SetTRParams;
388      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
389      property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
# Line 446 | Line 434 | type
434      procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435      procedure DoAfterTransactionEnd; virtual;
436      procedure DoTransactionFree; virtual;
449    function GetDBHandle: PISC_DB_HANDLE; virtual;
450    function GetTRHandle: PISC_TR_HANDLE; virtual;
437      procedure SetDatabase(Value: TIBDatabase); virtual;
438      procedure SetTransaction(Value: TIBTransaction); virtual;
439    public
# Line 460 | Line 446 | type
446      procedure DoAfterDelete(Sender: TObject); virtual;
447      procedure DoAfterInsert(Sender: TObject); virtual;
448      procedure DoAfterPost(Sender: TObject); virtual;
463    function GetCharSetSize(CharSetID: integer): integer;
464    function GetDefaultCharSetSize: integer;
465    function GetCharSetName(CharSetID: integer): string;
466    function GetDefaultCharSetName: RawByteString;
467    {$IFDEF HAS_ANSISTRING_CODEPAGE}
468    function GetCodePage(CharSetID: integer): TSystemCodePage;
469    function GetDefaultCodePage: TSystemCodePage;
470    {$ENDIF}
449      procedure HandleException(Sender: TObject);
450      procedure SetCursor;
451      procedure RestoreCursor;
# Line 486 | Line 464 | type
464      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465      property Database: TIBDatabase read FDatabase
466                                      write SetDatabase;
489    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467      property Owner: TObject read FOwner;
491    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468      property Transaction: TIBTransaction read FTransaction
469                                            write SetTransaction;
470    end;
471  
472 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
473 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
472 > function GenerateDPB(sl: TStrings): IDPB;
473 > function GenerateTPB(sl: TStrings): ITPB;
474  
475  
476   implementation
477  
478 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 <     typInfo, IBCodePage;
478 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 >     typInfo, FBMessages, IBErrorCodes;
480  
481   { TIBDatabase }
482  
483   constructor TIBDataBase.Create(AOwner: TComponent);
484   begin
485    inherited Create(AOwner);
510  FIBLoaded := False;
511  CheckIBLoaded;
512  FIBLoaded := True;
486    LoginPrompt := True;
487    FSQLObjects := TList.Create;
488    FTransactions := TList.Create;
# Line 520 | Line 493 | begin
493       (AOwner is TCustomApplication) and
494       TCustomApplication(AOWner).ConsoleApplication then
495      LoginPrompt := false;
523  {$IFDEF HAS_ANSISTRING_CODEPAGE}
524  FDefaultCodePage := CP_NONE;
525  {$ENDIF}
496    FDBParamsChanged := True;
497    TStringList(FDBParams).OnChange := DBParamsChange;
498    TStringList(FDBParams).OnChanging := DBParamsChanging;
499    FDPB := nil;
530  FHandle := nil;
500    FUserNames := nil;
501    FInternalTransaction := TIBTransaction.Create(self);
502    FInternalTransaction.DefaultDatabase := Self;
# Line 542 | Line 511 | begin
511    CheckStreamConnect;
512   end;
513  
514 < destructor TIBDataBase.Destroy;
514 > destructor TIBDataBase.Destroy;
515   var
516    i: Integer;
517   begin
518 <  if FIBLoaded then
519 <  begin
520 <    IdleTimer := 0;
521 <    if FHandle <> nil then
522 <      ForceClose;
523 <    for i := 0 to FSQLObjects.Count - 1 do
524 <      if FSQLObjects[i] <> nil then
525 <        SQLObjects[i].DoDatabaseFree;
526 <    RemoveSQLObjects;
527 <    RemoveTransactions;
528 <    FInternalTransaction.Free;
529 <    FreeMem(FDPB);
530 <    FDPB := nil;
531 <    FDBParams.Free;
563 <    FSQLObjects.Free;
564 <    FUserNames.Free;
565 <    FTransactions.Free;
566 <  end;
518 >  IdleTimer := 0;
519 >  if FAttachment <> nil then
520 >    ForceClose;
521 >  for i := 0 to FSQLObjects.Count - 1 do
522 >    if FSQLObjects[i] <> nil then
523 >      SQLObjects[i].DoDatabaseFree;
524 >  RemoveSQLObjects;
525 >  RemoveTransactions;
526 >  FInternalTransaction.Free;
527 >  FDPB := nil;
528 >  FDBParams.Free;
529 >  FSQLObjects.Free;
530 >  FUserNames.Free;
531 >  FTransactions.Free;
532    FDataSets.Free;
533    inherited Destroy;
534   end;
535  
571 function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
572   ): ISC_STATUS;
573 begin
574  result := ErrCode;
575  FCanTimeout := False;
576  if RaiseError and (ErrCode > 0) then
577    IBDataBaseError;
578 end;
579
536   procedure TIBDataBase.CheckActive;
537   begin
538    if StreamedConnected and (not Connected) then
539      Loaded;
540 <  if FHandle = nil then
540 >  if FAttachment = nil then
541      IBError(ibxeDatabaseClosed, [nil]);
542   end;
543  
# Line 589 | Line 545 | end;
545   begin
546    if csDesigning in ComponentState then
547    begin
548 <    if FHandle <> nil then
548 >    if FAttachment <> nil then
549        Close;
550    end
551   end;
552  
553   procedure TIBDataBase.CheckInactive;
554   begin
555 <  if FHandle <> nil then
555 >  if FAttachment <> nil then
556      IBError(ibxeDatabaseOpen, [nil]);
557   end;
558  
# Line 641 | Line 597 | begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
644  SetLength(FCharSetSizes,0);
645  SetLength(FCharSetNames,0);
646  FDefaultCharSetName := '';
647  {$IFDEF HAS_ANSISTRING_CODEPAGE}
648  SetLength(FCodePages,0);
649  FDefaultCodePage := CP_NONE;
650  {$ENDIF}
600   end;
601  
602 < procedure TIBDataBase.CreateDatabase;
603 < var
604 <  tr_handle: TISC_TR_HANDLE;
602 >  procedure TIBDataBase.CreateDatabase;
603 > begin
604 >  CheckInactive;
605 >  CheckDatabaseName;
606 >  FCreateDatabase := true;
607 >  Connected := true;
608 > end;
609 >
610 > procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
611   begin
612    CheckInactive;
613 <  tr_handle := nil;
614 <  Call(
615 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
616 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
662 <                               Params.Text), SQLDialect, nil),
663 <    True);
613 >  FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
614 >  FDBName := Attachment.GetConnectString;
615 >  if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
616 >    OnCreateDatabase(self);
617   end;
618  
619   procedure TIBDataBase.DropDatabase;
620   begin
621    CheckActive;
622 <  Call(isc_drop_database(StatusVector, @FHandle), True);
622 >  FAttachment.DropDatabase;
623 >  FAttachment := nil;
624   end;
625  
626   procedure TIBDataBase.DBParamsChange(Sender: TObject);
# Line 693 | Line 647 | begin
647      end;
648   end;
649  
650 < function TIBDataBase.FindDefaultTransaction: TIBTransaction;
650 >  function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
651   var
652    i: Integer;
653   begin
# Line 719 | Line 673 | end;
673  
674   function TIBDataBase.GetConnected: Boolean;
675   begin
676 <  result := FHandle <> nil;
676 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
677   end;
678  
679   function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
# Line 736 | Line 690 | begin
690      Inc(result);
691   end;
692  
693 < function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
740 < var
741 <  ConstIdx, EqualsIdx: Integer;
742 < begin
743 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
744 <  begin
745 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
746 <    if ConstIdx = -1 then
747 <      result := ''
748 <    else
749 <    begin
750 <      result := Params[ConstIdx];
751 <      EqualsIdx := Pos('=', result); {mbcs ok}
752 <      if EqualsIdx = 0 then
753 <        result := ''
754 <      else
755 <        result := Copy(result, EqualsIdx + 1, Length(result));
756 <    end;
757 <  end
758 <  else
759 <    result := '';
760 < end;
761 <
762 < function TIBDataBase.GetIdleTimer: Integer;
693 > function TIBDataBase.GetIdleTimer: Integer;
694   begin
695    result := FTimer.Interval;
696   end;
# Line 824 | Line 755 | begin
755      end;
756    end;
757  
758 <  if (not HandleIsShared) and
759 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
829 <     (not Force) then
830 <    IBDataBaseError
831 <  else
832 <  begin
833 <    FHandle := nil;
834 <    FHandleIsShared := False;
835 <  end;
758 >  FAttachment.Disconnect(Force);
759 >  FAttachment := nil;
760  
761    if not (csDesigning in ComponentState) then
762      MonitorHook.DBDisconnect(Self);
# Line 842 | Line 766 | begin
766        SQLObjects[i].DoAfterDatabaseDisconnect;
767   end;
768  
845 procedure TIBDataBase.LoadCharSetInfo;
846 var Query: TIBSQL;
847    i: integer;
848 begin
849  if not FInternalTransaction.Active then
850    FInternalTransaction.StartTransaction;
851  Query := TIBSQL.Create(self);
852  try
853    Query.Database := Self;
854    Query.Transaction := FInternalTransaction;
855    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
856                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
857    Query.Prepare;
858    Query.ExecQuery;
859    if not Query.EOF then
860    begin
861      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
862      SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
863      {$IFDEF HAS_ANSISTRING_CODEPAGE}
864      SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
865      {$ENDIF}
866      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
867      repeat
868        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
869                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
870        FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
871                 Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
872        {$IFDEF HAS_ANSISTRING_CODEPAGE}
873        FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
874          IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
875        {$ENDIF}
876        Query.Next;
877      until Query.EOF;
878    end;
879  finally
880    Query.free;
881    FInternalTransaction.Commit;
882  end;
883 end;
884
769   procedure TIBDataBase.CheckStreamConnect;
770   var
771    i: integer;
# Line 904 | Line 788 | begin
788           (FDefaultTransaction.FStreamedActive) and
789           (not FDefaultTransaction.InTransaction) then
790          FDefaultTransaction.StartTransaction;
791 <      FStreamedConnected := False;
791 >      StreamedConnected := False;
792      end;
793    except
794      if csDesigning in ComponentState then
# Line 945 | Line 829 | begin
829    end;
830   end;
831  
832 <  function TIBDataBase.Login(var aDatabaseName: string): Boolean;
832 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
833   var
834    IndexOfUser, IndexOfPassword: Integer;
835    Username, Password, OldPassword: String;
# Line 1003 | Line 887 | begin
887                                           Length(Params[IndexOfPassword]));
888        OldPassword := password;
889      end;
890 +
891      result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
892      if result then
893      begin
894 <      if IndexOfUser = -1 then
895 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
896 <      else
897 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
894 >      if Username <> '' then
895 >      begin
896 >        if IndexOfUser = -1 then
897 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
898 >        else
899 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
900                                   '=' + Username;
901 +      end
902 +      else
903 +      if IndexOfUser <> -1 then
904 +        Params.Delete(IndexOfUser);
905        if (Password = OldPassword) then
906          FHiddenPassword := ''
907        else
# Line 1031 | Line 922 | end;
922  
923   procedure TIBDataBase.DoConnect;
924   var
1034  DPB: String;
925    TempDBParams: TStrings;
926    I: integer;
927    aDBName: string;
928 <
929 <  {Call error analysis}
930 <  sqlcode: Long;
1041 <  IBErrorCode: Long;
1042 <  status_vector: PISC_STATUS;
1043 <  {$ifdef WINDOWS}
1044 <  acp: uint;
1045 <  {$endif}
928 >  Status: IStatus;
929 >  CharSetID: integer;
930 >  CharSetName: AnsiString;
931   begin
932    CheckInactive;
933    CheckDatabaseName;
# Line 1059 | Line 944 | begin
944    TempDBParams := TStringList.Create;
945    try
946     TempDBParams.Assign(FDBParams);
947 +   {$ifdef UNIX}
948 +   {See below for WINDOWS UseDefaultSystemCodePage}
949     if UseDefaultSystemCodePage then
1063   begin
1064     {$ifdef WINDOWS}
1065     acp := GetACP;
1066     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1067     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1068     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1069     {$ELSE}
1070     if (acp >= 1250) and (acp <= 1258) then
1071       TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1072     else
1073       TempDBParams.Values['lc_ctype'] :='UTF8';
1074     {$ENDIF}
1075     {$else}
1076     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1077     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1078     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079     {$ELSE}
950       TempDBParams.Values['lc_ctype'] :='UTF8';
951 <     {$ENDIF}
1082 <     {$endif}
1083 <   end;
951 >   {$endif}
952     {Opportunity to override defaults}
953     for i := 0 to FSQLObjects.Count - 1 do
954     begin
955         if FSQLObjects[i] <> nil then
956           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
957     end;
1090   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
958  
959 <   { Generate a new DPB if necessary }
960 <   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
961 <   begin
962 <     FDBParamsChanged := False;
963 <     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
964 <       GenerateDPB(TempDBParams, DPB, FDPBLength)
959 >   repeat
960 >     { Generate a new DPB if necessary }
961 >     if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
962 >     begin
963 >       FDBParamsChanged := False;
964 >       if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
965 >         FDPB := GenerateDPB(TempDBParams)
966 >       else
967 >       begin
968 >          TempDBParams.Values['password'] := FHiddenPassword;
969 >          FDPB := GenerateDPB(TempDBParams);
970 >       end;
971 >     end;
972 >
973 >     if FCreateDatabase then
974 >     begin
975 >       FCreateDatabase := false;
976 >       FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
977 >       if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
978 >         OnCreateDatabase(self);
979 >     end
980       else
981 +       FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
982 +
983 +     if FAttachment = nil then
984       begin
985 <        TempDBParams.Add('password=' + FHiddenPassword);
986 <        GenerateDPB(TempDBParams, DPB, FDPBLength);
985 >       Status := FirebirdAPI.GetStatus;
986 >       {$IFDEF UNIX}
987 >       if Pos(':',aDBName) = 0 then
988 >       begin
989 >           if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
990 >              or
991 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
992 >              or
993 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
994 >              or
995 >              ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
996 >              then
997 >              begin
998 >                aDBName := 'localhost:' + aDBName;
999 >                Continue;
1000 >             end
1001 >       end;
1002 >       {$ENDIF}
1003 >       if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1004 >                        and CreateIfNotExists and not (csDesigning in ComponentState) then
1005 >         FCreateDatabase := true
1006 >       else
1007 >         raise EIBInterBaseError.Create(Status);
1008       end;
1009 <     IBAlloc(FDPB, 0, FDPBLength);
1010 <     Move(DPB[1], FDPB[0], FDPBLength);
1011 <   end;
1009 >
1010 >     if UseDefaultSystemCodePage and (FAttachment <> nil) then
1011 >     {Only now can we check the codepage in use by the Attachment.
1012 >      If not that required then re-open with required LCLType.}
1013 >     begin
1014 >       {$ifdef WINDOWS}
1015 >       if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1016 >       {$else}
1017 >       if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1018 >       {$endif}
1019 >       begin
1020 >         CharSetName := Attachment.GetCharsetName(CharSetID);
1021 >         if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1022 >         begin
1023 >           TempDBParams.Values['lc_ctype'] := CharSetName;
1024 >           FDBParamsChanged := True;
1025 >           FAttachment := nil;
1026 >         end
1027 >       end
1028 >     end;
1029 >
1030 >   until FAttachment <> nil;
1031 >
1032    finally
1033     TempDBParams.Free;
1034    end;
1035 <  repeat
1110 <    if Call(isc_attach_database(StatusVector, Length(aDBName),
1111 <                         PChar(aDBName), @FHandle,
1112 <                         FDPBLength, FDPB), False) > 0 then
1113 <    begin
1114 <      {$IFDEF UNIX}
1115 <      if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1116 <      begin
1117 <        status_vector := StatusVector;
1118 <        IBErrorCode := StatusVectorArray[1];
1119 <        sqlcode := isc_sqlcode(StatusVector);
1120 <
1121 <        if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1122 <           or
1123 <           ((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1124 <           then
1125 <           begin
1126 <             aDBName := 'localhost:' + aDBName;
1127 <             Continue;
1128 <           end;
1129 <      end;
1130 <      {$ENDIF}
1131 <      FHandle := nil;
1132 <      IBDataBaseError;
1133 <    end;
1134 <  until FHandle <> nil;
1035 >
1036    if not (csDesigning in ComponentState) then
1037      FDBName := aDBName; {Synchronise at run time}
1038    FDBSQLDialect := GetDBSQLDialect;
# Line 1143 | Line 1044 | begin
1044    end;
1045    if not (csDesigning in ComponentState) then
1046      MonitorHook.DBConnect(Self);
1146  LoadCharSetInfo;
1047   end;
1048  
1049   procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
# Line 1246 | Line 1146 | begin
1146    FDefaultTransaction := Value;
1147   end;
1148  
1249 procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1250 begin
1251  if HandleIsShared then
1252    Close
1253  else
1254    CheckInactive;
1255  FHandle := Value;
1256  FHandleIsShared := (Value <> nil);
1257 end;
1258
1149   procedure TIBDataBase.SetIdleTimer(Value: Integer);
1150   begin
1151    if Value < 0 then
# Line 1300 | Line 1190 | end;
1190   begin
1191    if Connected then
1192    begin
1193 <    if FCanTimeout then
1193 >    if not FAttachment.HasActivity then
1194      begin
1195        ForceClose;
1196        if Assigned(FOnIdleTimer) then
1197          FOnIdleTimer(Self);
1198      end
1309    else
1310      FCanTimeout := True;
1199    end;
1200   end;
1201  
# Line 1338 | Line 1226 | end;
1226   procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1227   begin
1228    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1229 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1229 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1230      FSQLDialect := Value
1231    else
1232      IBError(ibxeSQLDialectInvalid, [nil]);
# Line 1354 | Line 1242 | begin
1242    DatabaseInfo.Free;
1243   end;
1244  
1245 + function TIBDataBase.GetDefaultCharSetID: integer;
1246 + begin
1247 +  if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1248 +    Result := Attachment.GetDefaultCharSetID
1249 +  else
1250 +    Result := 0;
1251 + end;
1252 +
1253 + function TIBDataBase.GetDefaultCharSetName: AnsiString;
1254 + begin
1255 +  if Attachment <> nil then
1256 +    Result := Attachment.GetCharsetName(DefaultCharSetID)
1257 +  else
1258 +    Result := '';
1259 + end;
1260 +
1261 + function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1262 + begin
1263 +  if Attachment <> nil then
1264 +    Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1265 +  else
1266 +    Result := CP_NONE;
1267 + end;
1268 +
1269   procedure TIBDataBase.ValidateClientSQLDialect;
1270   begin
1271    if (FDBSQLDialect < FSQLDialect) then
# Line 1444 | Line 1356 | begin
1356      Query.Database := Self;
1357      Query.Transaction := FInternalTransaction;
1358      Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1359 <      'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1359 >      'from RDB$RELATION_FIELDS R ' + {do not localize}
1360        'where R.RDB$RELATION_NAME = ' + {do not localize}
1361 <      '''' +
1362 <      FormatIdentifierValue(SQLDialect, TableName) +
1451 <      ''' ' +
1452 <      'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1361 >      '''' + ExtractIdentifier(SQLDialect, TableName) +
1362 >      ''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1363      Query.Prepare;
1364      Query.ExecQuery;
1365      with List do
# Line 1457 | Line 1367 | begin
1367        BeginUpdate;
1368        try
1369          Clear;
1370 <        while (not Query.EOF) and (Query.Next <> nil) do
1371 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1370 >        while (not Query.EOF) and Query.Next  do
1371 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1372        finally
1373          EndUpdate;
1374        end;
# Line 1497 | Line 1407 | begin
1407          BeginUpdate;
1408          try
1409            Clear;
1410 <          while (not Query.EOF) and (Query.Next <> nil) do
1411 <            List.Add(TrimRight(Query.Current[0].AsString));
1410 >          while (not Query.EOF) and Query.Next  do
1411 >            List.Add(TrimRight(Query.Fields[0].AsString));
1412          finally
1413            EndUpdate;
1414          end;
# Line 1515 | Line 1425 | end;
1425   constructor TIBTransaction.Create(AOwner: TComponent);
1426   begin
1427    inherited Create(AOwner);
1518  FIBLoaded := False;
1519  CheckIBLoaded;
1520  FIBLoaded := True;
1521  CheckIBLoaded;
1428    FDatabases := TList.Create;
1429    FSQLObjects := TList.Create;
1524  FHandle := nil;
1430    FTPB := nil;
1526  FTPBLength := 0;
1431    FTRParams := TStringList.Create;
1432    FTRParamsChanged := True;
1433    TStringList(FTRParams).OnChange := TRParamsChange;
# Line 1539 | Line 1443 | destructor TIBTransaction.Destroy;
1443   var
1444    i: Integer;
1445   begin
1446 <  if FIBLoaded then
1447 <  begin
1448 <    if InTransaction then
1449 <      EndTransaction(FDefaultAction, True);
1450 <    for i := 0 to FSQLObjects.Count - 1 do
1451 <      if FSQLObjects[i] <> nil then
1452 <        SQLObjects[i].DoTransactionFree;
1453 <    RemoveSQLObjects;
1454 <    RemoveDatabases;
1455 <    FreeMem(FTPB);
1456 <    FTPB := nil;
1553 <    FTRParams.Free;
1554 <    FSQLObjects.Free;
1555 <    FDatabases.Free;
1556 <  end;
1446 >  if InTransaction then
1447 >    EndTransaction(FDefaultAction, True);
1448 >  for i := 0 to FSQLObjects.Count - 1 do
1449 >    if FSQLObjects[i] <> nil then
1450 >      SQLObjects[i].DoTransactionFree;
1451 >  RemoveSQLObjects;
1452 >  RemoveDatabases;
1453 >  FTPB := nil;
1454 >  FTRParams.Free;
1455 >  FSQLObjects.Free;
1456 >  FDatabases.Free;
1457    inherited Destroy;
1458   end;
1459  
1560 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1561  RaiseError: Boolean): ISC_STATUS;
1562 var
1563  i: Integer;
1564 begin
1565  result := ErrCode;
1566  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1567    Databases[i].FCanTimeout := False;
1568  FCanTimeout := False;
1569  if RaiseError and (result > 0) then
1570    IBDataBaseError;
1571 end;
1572
1460   procedure TIBTransaction.CheckDatabasesInList;
1461   begin
1462    if GetDatabaseCount = 0 then
# Line 1580 | Line 1467 | procedure TIBTransaction.CheckInTransact
1467   begin
1468    if FStreamedActive and (not InTransaction) then
1469      Loaded;
1470 <  if (FHandle = nil) then
1470 >  if (TransactionIntf = nil) then
1471      IBError(ibxeNotInTransaction, [nil]);
1472   end;
1473  
# Line 1636 | Line 1523 | procedure TIBTransaction.EnsureNotInTran
1523   begin
1524    if csDesigning in ComponentState then
1525    begin
1526 <    if FHandle <> nil then
1526 >    if TransactionIntf <> nil then
1527        Rollback;
1528    end;
1529   end;
1530  
1531   procedure TIBTransaction.CheckNotInTransaction;
1532   begin
1533 <  if (FHandle <> nil) then
1533 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1534      IBError(ibxeInTransaction, [nil]);
1535   end;
1536  
# Line 1652 | Line 1539 | var
1539    i: Integer;
1540    NilFound: Boolean;
1541   begin
1542 +  EnsureNotInTransaction;
1543 +  CheckNotInTransaction;
1544 +  FTransactionIntf := nil;
1545 +
1546    i := FindDatabase(db);
1547    if i <> -1 then
1548    begin
# Line 1702 | Line 1593 | end;
1593   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1594    Force: Boolean);
1595   var
1705  status: ISC_STATUS;
1596    i: Integer;
1597   begin
1598    CheckInTransaction;
# Line 1713 | Line 1603 | begin
1603    case Action of
1604      TARollback, TACommit:
1605      begin
1606 <      if (HandleIsShared) and
1607 <         (Action <> FDefaultAction) and
1608 <         (not Force) then
1609 <        IBError(ibxeCantEndSharedTransaction, [nil]);
1610 <      DoBeforeTransactionEnd;
1606 >      try
1607 >        DoBeforeTransactionEnd;
1608 >      except on E: EIBInterBaseError do
1609 >        begin
1610 >          if not Force then
1611 >            raise;
1612 >        end;
1613 >      end;
1614 >
1615        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1616 +      try
1617          SQLObjects[i].DoBeforeTransactionEnd(Action);
1618 +      except on E: EIBInterBaseError do
1619 +        begin
1620 +          if not Force then
1621 +              raise;
1622 +          end;
1623 +      end;
1624 +
1625        if InTransaction then
1626        begin
1627 <        if HandleIsShared then
1628 <        begin
1727 <          FHandle := nil;
1728 <          FHandleIsShared := False;
1729 <          status := 0;
1730 <        end
1731 <        else
1732 <          if (Action = TARollback) then
1733 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1734 <          else
1735 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1736 <        if ((Force) and (status > 0)) then
1737 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1738 <        if Force then
1739 <          FHandle := nil
1627 >        if (Action = TARollback) then
1628 >            FTransactionIntf.Rollback(Force)
1629          else
1630 <          if (status > 0) then
1631 <            IBDataBaseError;
1632 <        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1633 <          SQLObjects[i].DoAfterTransactionEnd;
1634 <        DoAfterTransactionEnd;
1630 >        try
1631 >          FTransactionIntf.Commit;
1632 >        except on E: EIBInterBaseError do
1633 >          begin
1634 >            if Force then
1635 >              FTransactionIntf.Rollback(Force)
1636 >            else
1637 >              raise;
1638 >          end;
1639 >        end;
1640 >
1641 >          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642 >          try
1643 >            SQLObjects[i].DoAfterTransactionEnd;
1644 >          except on E: EIBInterBaseError do
1645 >            begin
1646 >              if not Force then
1647 >                raise;
1648 >            end;
1649 >          end;
1650 >        try
1651 >          DoAfterTransactionEnd;
1652 >        except on E: EIBInterBaseError do
1653 >          begin
1654 >            if not Force then
1655 >              raise;
1656 >          end;
1657 >        end;
1658        end;
1659      end;
1660      TACommitRetaining:
1661 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1661 >      FTransactionIntf.CommitRetaining;
1662 >
1663      TARollbackRetaining:
1664 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1664 >      FTransactionIntf.RollbackRetaining;
1665    end;
1666    if not (csDesigning in ComponentState) then
1667    begin
# Line 1800 | Line 1713 | end;
1713  
1714   function TIBTransaction.GetInTransaction: Boolean;
1715   begin
1716 <  result := (FHandle <> nil);
1716 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1717   end;
1718  
1719   function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
# Line 1856 | Line 1769 | procedure TIBTransaction.BeforeDatabaseD
1769   begin
1770    if InTransaction then
1771      EndTransaction(FDefaultAction, True);
1772 +  FTransactionIntf := nil;
1773   end;
1774  
1775   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
# Line 1864 | Line 1778 | var
1778   begin
1779    if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1780    begin
1781 +    EnsureNotInTransaction;
1782 +    CheckNotInTransaction;
1783 +    FTransactionIntf := nil;
1784 +
1785      DB := Databases[Idx];
1786      FDatabases[Idx] := nil;
1787      DB.RemoveTransaction(DB.FindTransaction(Self));
# Line 1876 | Line 1794 | procedure TIBTransaction.RemoveDatabases
1794   var
1795    i: Integer;
1796   begin
1797 +  EnsureNotInTransaction;
1798 +  CheckNotInTransaction;
1799 +  FTransactionIntf := nil;
1800 +
1801    for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1802      RemoveDatabase(i);
1803   end;
# Line 1922 | Line 1844 | begin
1844          Rollback;
1845   end;
1846  
1925 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1926 begin
1927 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1928    IBError(ibxeIB60feature, [nil]);*)
1929  FDefaultAction := Value;
1930 end;
1931
1847   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1848   var
1849    i: integer;
# Line 1951 | Line 1866 | begin
1866    FDefaultDatabase := Value;
1867   end;
1868  
1954 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1955 begin
1956  if (HandleIsShared) then
1957    EndTransaction(DefaultAction, True)
1958  else
1959    CheckNotInTransaction;
1960  FHandle := Value;
1961  FHandleIsShared := (Value <> nil);
1962 end;
1963
1869   procedure TIBTransaction.Notification( AComponent: TComponent;
1870                                          Operation: TOperation);
1871   var
# Line 2002 | Line 1907 | end;
1907  
1908   procedure TIBTransaction.StartTransaction;
1909   var
2005  pteb: PISC_TEB_ARRAY;
2006  TPB: String;
1910    i: Integer;
1911 +  Attachments: array of IAttachment;
1912 +  ValidDatabaseCount: integer;
1913   begin
1914    CheckNotInTransaction;
1915    CheckDatabasesInList;
1916 +  if TransactionIntf <> nil then
1917 +  begin
1918 +    TransactionIntf.Start(DefaultAction);
1919 +    Exit;
1920 +  end;
1921 +
1922    for i := 0 to FDatabases.Count - 1 do
1923     if  FDatabases[i] <> nil then
1924     begin
1925       with TIBDatabase(FDatabases[i]) do
1926       if not Connected then
1927 <       if FStreamedConnected then
1927 >       if StreamedConnected then
1928         begin
1929           Open;
1930 <         FStreamedConnected := False;
1930 >         StreamedConnected := False;
1931         end
1932         else
1933           IBError(ibxeDatabaseClosed, [nil]);
# Line 2024 | Line 1935 | begin
1935    if FTRParamsChanged then
1936    begin
1937      FTRParamsChanged := False;
1938 <    GenerateTPB(FTRParams, TPB, FTPBLength);
2028 <    if FTPBLength > 0 then
2029 <    begin
2030 <      IBAlloc(FTPB, 0, FTPBLength);
2031 <      Move(TPB[1], FTPB[0], FTPBLength);
2032 <    end;
1938 >    FTPB :=  GenerateTPB(FTRParams);
1939    end;
1940  
1941 <  pteb := nil;
1942 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1943 <  try
1944 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1945 <    begin
1946 <      pteb^[i].db_handle := @(Databases[i].Handle);
1947 <      pteb^[i].tpb_length := FTPBLength;
1948 <      pteb^[i].tpb_address := FTPB;
1949 <    end;
1950 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1951 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1952 <    begin
1953 <      FHandle := nil;
1954 <      IBDataBaseError;
2049 <    end;
2050 <    if not (csDesigning in ComponentState) then
2051 <      MonitorHook.TRStart(Self);
2052 <  finally
2053 <    FreeMem(pteb);
1941 >  ValidDatabaseCount := 0;
1942 >  for i := 0 to DatabaseCount - 1 do
1943 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1944 >
1945 >  if ValidDatabaseCount = 1 then
1946 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1947 >  else
1948 >  begin
1949 >    SetLength(Attachments,ValidDatabaseCount);
1950 >    for i := 0 to DatabaseCount - 1 do
1951 >      if Databases[i] <> nil then
1952 >        Attachments[i] := Databases[i].Attachment;
1953 >
1954 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1955    end;
1956 +
1957 +  if not (csDesigning in ComponentState) then
1958 +      MonitorHook.TRStart(Self);
1959    DoOnStartTransaction;
1960   end;
1961  
# Line 2059 | Line 1963 | procedure TIBTransaction.TimeoutTransact
1963   begin
1964    if InTransaction then
1965    begin
1966 <    if FCanTimeout then
1966 >    if not TransactionIntf.HasActivity then
1967      begin
1968        EndTransaction(FDefaultAction, True);
1969        if Assigned(FOnIdleTimer) then
1970          FOnIdleTimer(Self);
1971      end
2068    else
2069      FCanTimeout := True;
1972    end;
1973   end;
1974  
# Line 2079 | Line 1981 | procedure TIBTransaction.TRParamsChangin
1981   begin
1982    EnsureNotInTransaction;
1983    CheckNotInTransaction;
1984 +  FTransactionIntf := nil;
1985   end;
1986  
1987   { TIBBase }
# Line 2094 | Line 1997 | begin
1997    inherited Destroy;
1998   end;
1999  
2097 function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2098 begin
2099  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2100    Result := Database.FCharSetSizes[CharSetID]
2101  else
2102    Result := 1; {Unknown character set}
2103 end;
2104
2105 function TIBBase.GetDefaultCharSetSize: integer;
2106 var DefaultCharSetName: string;
2107    i: integer;
2108 begin
2109  DefaultCharSetName := GetDefaultCharSetName;
2110  Result := 4; {worse case}
2111  for i := 0 to Length(Database.FCharSetSizes) - 1 do
2112    if Database.FCharSetNames[i] = DefaultCharSetName then
2113    begin
2114      Result := Database.FCharSetSizes[i];
2115      break;
2116    end;
2117 end;
2118
2119 function TIBBase.GetCharSetName(CharSetID: integer): string;
2120 begin
2121  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2122    Result := Database.FCharSetNames[CharSetID]
2123  else
2124    Result := ''; {Unknown character set}
2125 end;
2126
2127 function TIBBase.GetDefaultCharSetName: RawByteString;
2128 begin
2129  Result := Database.FDefaultCharSetName;
2130 end;
2131
2132 {$IFDEF HAS_ANSISTRING_CODEPAGE}
2133 function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134 begin
2135  if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
2136    Result := Database.FCodePages[CharSetID]
2137  else
2138    Result := CP_NONE; {Unknown character set}
2139 end;
2140
2141 function TIBBase.GetDefaultCodePage: TSystemCodePage;
2142 begin
2143  Result := Database.FDefaultCodePage;
2144 end;
2145
2146 {$ENDIF}
2147
2000   procedure TIBBase.HandleException(Sender: TObject);
2001   begin
2002    if assigned(Database) then
# Line 2183 | Line 2035 | begin
2035    FTransaction.CheckInTransaction;
2036   end;
2037  
2186 function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2187 begin
2188  CheckDatabase;
2189  result := @FDatabase.Handle;
2190 end;
2191
2192 function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2193 begin
2194  CheckTransaction;
2195  result := @FTransaction.Handle;
2196 end;
2197
2038   procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2039    );
2040   begin
# Line 2309 | Line 2149 | end;
2149    parameter buffer, and return it and its length
2150    in DPB and DPBLength, respectively. }
2151  
2152 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2152 > function GenerateDPB(sl: TStrings): IDPB;
2153   var
2154 <  i, j, pval: Integer;
2154 >  i, j: Integer;
2155    DPBVal: UShort;
2156    ParamName, ParamValue: string;
2157   begin
2158 <  { The DPB is initially empty, with the exception that
2319 <    the DPB version must be the first byte of the string. }
2320 <  DPBLength := 1;
2321 <  DPB := Char(isc_dpb_version1);
2158 >  Result := FirebirdAPI.AllocateDPB;
2159  
2160    {Iterate through the textual database parameters, constructing
2161     a DPB on-the-fly }
# Line 2357 | Line 2194 | begin
2194        begin
2195          if DPBVal = isc_dpb_sql_dialect then
2196            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2197 <        DPB := DPB +
2361 <               Char(DPBVal) +
2362 <               Char(Length(ParamValue)) +
2363 <               ParamValue;
2364 <        Inc(DPBLength, 2 + Length(ParamValue));
2197 >        Result.Add(DPBVal).SetAsString(ParamValue);
2198        end;
2199 +
2200        isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2201        isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2202 <      begin
2203 <        DPB := DPB +
2370 <               Char(DPBVal) +
2371 <               #1 +
2372 <               Char(StrToInt(ParamValue));
2373 <        Inc(DPBLength, 3);
2374 <      end;
2202 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2203 >
2204        isc_dpb_sweep:
2205 <      begin
2206 <        DPB := DPB +
2378 <               Char(DPBVal) +
2379 <               #1 +
2380 <               Char(isc_dpb_records);
2381 <        Inc(DPBLength, 3);
2382 <      end;
2205 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2206 >
2207        isc_dpb_sweep_interval:
2208 <      begin
2209 <        pval := StrToInt(ParamValue);
2386 <        DPB := DPB +
2387 <               Char(DPBVal) +
2388 <               #4 +
2389 <               PChar(@pval)[0] +
2390 <               PChar(@pval)[1] +
2391 <               PChar(@pval)[2] +
2392 <               PChar(@pval)[3];
2393 <        Inc(DPBLength, 6);
2394 <      end;
2208 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2209 >
2210        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2211        isc_dpb_quit_log:
2212 <      begin
2398 <        DPB := DPB +
2399 <               Char(DPBVal) +
2400 <               #1 + #0;
2401 <        Inc(DPBLength, 3);
2402 <      end;
2212 >        Result.Add(DPBVal).SetAsByte(0);
2213        else
2214        begin
2215          if (DPBVal > 0) and
# Line 2417 | Line 2227 | end;
2227    of the transaction parameters, generate a transaction
2228    parameter buffer, and return it and its length in
2229    TPB and TPBLength, respectively. }
2230 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2230 > function GenerateTPB(sl: TStrings): ITPB;
2231   var
2232 <  i, j, TPBVal, ParamLength: Integer;
2232 >  i, j, TPBVal: Integer;
2233    ParamName, ParamValue: string;
2234   begin
2235 <  TPB := '';
2426 <  if (sl.Count = 0) then
2427 <    TPBLength := 0
2428 <  else
2429 <  begin
2430 <    TPBLength := sl.Count + 1;
2431 <    TPB := TPB + Char(isc_tpb_version3);
2432 <  end;
2235 >  Result := FirebirdAPI.AllocateTPB;
2236    for i := 0 to sl.Count - 1 do
2237    begin
2238      if (Trim(sl[i]) =  '') then
2436    begin
2437      Dec(TPBLength);
2239        Continue;
2240 <    end;
2240 >
2241      if (Pos('=', sl[i]) = 0) then {mbcs ok}
2242        ParamName := LowerCase(sl[i]) {mbcs ok}
2243      else
# Line 2460 | Line 2261 | begin
2261        isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2262        isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2263        isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2264 <        TPB := TPB + Char(TPBVal);
2264 >        Result.Add(TPBVal);
2265 >
2266        isc_tpb_lock_read, isc_tpb_lock_write:
2267 <      begin
2268 <        TPB := TPB + Char(TPBVal);
2467 <        { Now set the string parameter }
2468 <        ParamLength := Length(ParamValue);
2469 <        Inc(TPBLength, ParamLength + 1);
2470 <        TPB := TPB + Char(ParamLength) + ParamValue;
2471 <      end;
2267 >        Result.Add(TPBVal).SetAsString(ParamValue);
2268 >
2269        else
2270        begin
2271          if (TPBVal > 0) and

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines