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 35 by tony, Tue Jan 26 14:38:47 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 + {$codepage UTF8}
39 +
40   interface
41  
42   uses
# Line 43 | Line 45 | uses
45   {$ELSE}
46    unix,
47   {$ENDIF}
48 <  SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
47 <  IB, CustApp;
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49  
50   const
51    DPBPrefix = 'isc_dpb_';
# Line 115 | 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 139 | 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 155 | 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;
167    FCanTimeout: Boolean;
184      FSQLObjects: TList;
185      FTransactions: TList;
186      FDBName: TIBFileName;
187      FDBParams: TStrings;
188      FDBParamsChanged: Boolean;
173    FDPB: PChar;
174    FDPBLength: Short;
175    FHandle: TISC_DB_HANDLE;
176    FHandleIsShared: Boolean;
189      FOnIdleTimer: TNotifyEvent;
190      FDefaultTransaction: TIBTransaction;
191      FInternalTransaction: TIBTransaction;
180    FStreamedConnected: Boolean;
192      FTimer: TFPTimer;
193      FUserNames: TStringList;
194      FDataSets: TList;
195      FLoginCalled: boolean;
196 <    FCharSetSizes: array of integer;
186 <    FCharSetNames: array of string;
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 193 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
196    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
212 <    function Login: Boolean;
201 <    procedure LoadCharSetInfo;
212 >    function Login(var aDatabaseName: string): Boolean;
213      procedure SetDatabaseName(const Value: TIBFileName);
214      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215      procedure SetDBParams(Value: TStrings);
# Line 229 | 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 237 | Line 249 | type
249      function IndexOfDBConst(st: String): Integer;
250      function TestConnected: Boolean;
251      procedure CheckDatabaseName;
240    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;
246    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;
250    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
251                                                      write SetDBParamByDPB;
261      property SQLObjectCount: Integer read GetSQLObjectCount;
262      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
254    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: 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 268 | 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;
271    property DBSQLDialect : Integer read FDBSQLDialect;
283      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284 +    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285 +                                               write FUseDefaultSystemCodePage;
286      property AfterConnect;
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 292 | Line 307 | type
307      FAfterPost: TNotifyEvent;
308      FAfterTransactionEnd: TNotifyEvent;
309      FBeforeTransactionEnd: TNotifyEvent;
295    FIBLoaded: Boolean;
296    FCanTimeout         : Boolean;
310      FDatabases          : TList;
311      FOnStartTransaction: TNotifyEvent;
312      FSQLObjects         : TList;
313      FDefaultDatabase    : TIBDatabase;
301    FHandle             : TISC_TR_HANDLE;
302    FHandleIsShared     : Boolean;
314      FOnIdleTimer          : TNotifyEvent;
315      FStreamedActive     : Boolean;
316 <    FTPB                : PChar;
306 <    FTPBLength          : Short;
316 >    FTPB                : ITPB;
317      FTimer              : TFPTimer;
318 <    FDefaultAction      : TTransactionAction;
318 >    FDefaultAction      : TDefaultEndAction;
319      FTRParams           : TStrings;
320      FTRParamsChanged    : Boolean;
321      FInEndTransaction   : boolean;
# Line 328 | Line 338 | type
338      function GetIdleTimer: Integer;
339      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340      procedure SetActive(Value: Boolean);
331    procedure SetDefaultAction(Value: TTransactionAction);
341      procedure SetDefaultDatabase(Value: TIBDatabase);
342      procedure SetIdleTimer(Value: Integer);
343      procedure SetTRParams(Value: TStrings);
# Line 341 | Line 350 | type
350  
351    protected
352      procedure Loaded; override;
344    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;
350    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358      procedure Commit;
359      procedure CommitRetaining;
360      procedure Rollback;
# Line 368 | 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;
371    property Handle: TISC_TR_HANDLE read FHandle;
372    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 429 | Line 434 | type
434      procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435      procedure DoAfterTransactionEnd; virtual;
436      procedure DoTransactionFree; virtual;
432    function GetDBHandle: PISC_DB_HANDLE; virtual;
433    function GetTRHandle: PISC_TR_HANDLE; virtual;
437      procedure SetDatabase(Value: TIBDatabase); virtual;
438      procedure SetTransaction(Value: TIBTransaction); virtual;
439    public
# Line 443 | Line 446 | type
446      procedure DoAfterDelete(Sender: TObject); virtual;
447      procedure DoAfterInsert(Sender: TObject); virtual;
448      procedure DoAfterPost(Sender: TObject); virtual;
446    function GetCharSetSize(CharSetID: integer): integer;
447    function GetDefaultCharSetSize: integer;
448    function GetCharSetName(CharSetID: integer): string;
449    function GetDefaultCharSetName: string;
449      procedure HandleException(Sender: TObject);
450      procedure SetCursor;
451      procedure RestoreCursor;
# Line 465 | Line 464 | type
464      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465      property Database: TIBDatabase read FDatabase
466                                      write SetDatabase;
468    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467      property Owner: TObject read FOwner;
470    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;
478 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 >     typInfo, FBMessages, IBErrorCodes;
480  
481   { TIBDatabase }
482  
483 < constructor TIBDataBase.Create(AOwner: TComponent);
487 < {$ifdef WINDOWS}
488 < var acp: uint;
489 < {$endif}
483 > constructor TIBDataBase.Create(AOwner: TComponent);
484   begin
485    inherited Create(AOwner);
492  FIBLoaded := False;
493  CheckIBLoaded;
494  FIBLoaded := True;
486    LoginPrompt := True;
487    FSQLObjects := TList.Create;
488    FTransactions := TList.Create;
# Line 502 | Line 493 | begin
493       (AOwner is TCustomApplication) and
494       TCustomApplication(AOWner).ConsoleApplication then
495      LoginPrompt := false;
505  {$ifdef UNIX}
506  if csDesigning in ComponentState then
507    FDBParams.Add('lc_ctype=UTF8');
508  {$else}
509  {$ifdef WINDOWS}
510  if csDesigning in ComponentState then
511  begin
512    acp := GetACP;
513    if (acp >= 1250) and (acp <= 1254) then
514      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515  end;
516  {$endif}
517  {$endif}
496    FDBParamsChanged := True;
497    TStringList(FDBParams).OnChange := DBParamsChange;
498    TStringList(FDBParams).OnChanging := DBParamsChanging;
499    FDPB := nil;
522  FHandle := nil;
500    FUserNames := nil;
501    FInternalTransaction := TIBTransaction.Create(self);
502    FInternalTransaction.DefaultDatabase := Self;
# Line 534 | 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;
555 <    FSQLObjects.Free;
556 <    FUserNames.Free;
557 <    FTransactions.Free;
558 <  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  
563 function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
564   ): ISC_STATUS;
565 begin
566  result := ErrCode;
567  FCanTimeout := False;
568  if RaiseError and (ErrCode > 0) then
569    IBDataBaseError;
570 end;
571
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 581 | 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  
559   procedure TIBDataBase.CheckDatabaseName;
560   begin
561 <  if (FDBName = '') then
561 >  if (Trim(FDBName) = '') then
562      IBError(ibxeDatabaseNameMissing, [nil]);
563   end;
564  
# Line 633 | Line 597 | begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
636  SetLength(FCharSetSizes,0);
637  SetLength(FCharSetNames,0);
600   end;
601  
602 < procedure TIBDataBase.CreateDatabase;
641 < var
642 <  tr_handle: TISC_TR_HANDLE;
602 >  procedure TIBDataBase.CreateDatabase;
603   begin
604    CheckInactive;
605 <  tr_handle := nil;
606 <  Call(
607 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
608 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
609 <                               Params.Text), SQLDialect, nil),
610 <    True);
605 >  CheckDatabaseName;
606 >  FCreateDatabase := true;
607 >  Connected := true;
608 > end;
609 >
610 > procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
611 > begin
612 >  CheckInactive;
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 680 | 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 706 | 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 723 | Line 690 | begin
690      Inc(result);
691   end;
692  
693 < function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
727 < var
728 <  ConstIdx, EqualsIdx: Integer;
729 < begin
730 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
731 <  begin
732 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
733 <    if ConstIdx = -1 then
734 <      result := ''
735 <    else
736 <    begin
737 <      result := Params[ConstIdx];
738 <      EqualsIdx := Pos('=', result); {mbcs ok}
739 <      if EqualsIdx = 0 then
740 <        result := ''
741 <      else
742 <        result := Copy(result, EqualsIdx + 1, Length(result));
743 <    end;
744 <  end
745 <  else
746 <    result := '';
747 < end;
748 <
749 < function TIBDataBase.GetIdleTimer: Integer;
693 > function TIBDataBase.GetIdleTimer: Integer;
694   begin
695    result := FTimer.Interval;
696   end;
# Line 811 | Line 755 | begin
755      end;
756    end;
757  
758 <  if (not HandleIsShared) and
759 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
816 <     (not Force) then
817 <    IBDataBaseError
818 <  else
819 <  begin
820 <    FHandle := nil;
821 <    FHandleIsShared := False;
822 <  end;
758 >  FAttachment.Disconnect(Force);
759 >  FAttachment := nil;
760  
761    if not (csDesigning in ComponentState) then
762      MonitorHook.DBDisconnect(Self);
# Line 829 | Line 766 | begin
766        SQLObjects[i].DoAfterDatabaseDisconnect;
767   end;
768  
832 procedure TIBDataBase.LoadCharSetInfo;
833 var Query: TIBSQL;
834    i: integer;
835 begin
836  if not FInternalTransaction.Active then
837    FInternalTransaction.StartTransaction;
838  Query := TIBSQL.Create(self);
839  try
840    Query.Database := Self;
841    Query.Transaction := FInternalTransaction;
842    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
843                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
844    Query.Prepare;
845    Query.ExecQuery;
846    if not Query.EOF then
847    begin
848      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
849      SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
850      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
851      repeat
852        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
853                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
854        FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
855                 Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
856        Query.Next;
857      until Query.EOF;
858    end;
859  finally
860    Query.free;
861    FInternalTransaction.Commit;
862  end;
863 end;
864
769   procedure TIBDataBase.CheckStreamConnect;
770   var
771    i: integer;
# Line 884 | 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 925 | Line 829 | begin
829    end;
830   end;
831  
832 < function TIBDataBase.Login: Boolean;
832 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
833   var
834    IndexOfUser, IndexOfPassword: Integer;
835    Username, Password, OldPassword: String;
# Line 961 | Line 865 | begin
865        LoginParams.Assign(Params);
866        FOnLogin(Self, LoginParams);
867        Params.Assign (LoginParams);
868 +      aDatabaseName := FDBName;
869        HidePassword;
870      finally
871        LoginParams.Free;
# Line 982 | Line 887 | begin
887                                           Length(Params[IndexOfPassword]));
888        OldPassword := password;
889      end;
890 <    result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
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 1010 | Line 922 | end;
922  
923   procedure TIBDataBase.DoConnect;
924   var
1013  DPB: String;
925    TempDBParams: TStrings;
926    I: integer;
927    aDBName: string;
928 +  Status: IStatus;
929 +  CharSetID: integer;
930 +  CharSetName: AnsiString;
931   begin
932    CheckInactive;
933    CheckDatabaseName;
# Line 1023 | Line 937 | begin
937      FDBParamsChanged := True;
938    end;
939    { Use builtin login prompt if requested }
940 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
940 >  aDBName := FDBName;
941 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
942      IBError(ibxeOperationCancelled, [nil]);
943  
944    TempDBParams := TStringList.Create;
945    try
946     TempDBParams.Assign(FDBParams);
947 <   aDBName := FDBName;
947 >   {$ifdef UNIX}
948 >   {See below for WINDOWS UseDefaultSystemCodePage}
949 >   if UseDefaultSystemCodePage then
950 >     TempDBParams.Values['lc_ctype'] :='UTF8';
951 >   {$endif}
952     {Opportunity to override defaults}
953     for i := 0 to FSQLObjects.Count - 1 do
954     begin
# Line 1037 | Line 956 | begin
956           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
957     end;
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 <  if Call(isc_attach_database(StatusVector, Length(aDBName),
1058 <                         PChar(aDBName), @FHandle,
1059 <                         FDPBLength, FDPB), False) > 0 then
1060 <  begin
1061 <    FHandle := nil;
1062 <    IBDataBaseError;
1063 <  end;
1035 >
1036    if not (csDesigning in ComponentState) then
1037      FDBName := aDBName; {Synchronise at run time}
1038    FDBSQLDialect := GetDBSQLDialect;
# Line 1072 | Line 1044 | begin
1044    end;
1045    if not (csDesigning in ComponentState) then
1046      MonitorHook.DBConnect(Self);
1075  LoadCharSetInfo;
1047   end;
1048  
1049   procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
# Line 1175 | Line 1146 | begin
1146    FDefaultTransaction := Value;
1147   end;
1148  
1178 procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1179 begin
1180  if HandleIsShared then
1181    Close
1182  else
1183    CheckInactive;
1184  FHandle := Value;
1185  FHandleIsShared := (Value <> nil);
1186 end;
1187
1149   procedure TIBDataBase.SetIdleTimer(Value: Integer);
1150   begin
1151    if Value < 0 then
# Line 1229 | 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
1238    else
1239      FCanTimeout := True;
1199    end;
1200   end;
1201  
# Line 1267 | 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 1283 | 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 1373 | 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) +
1380 <      ''' ' +
1381 <      '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 1386 | 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 1426 | 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 1444 | Line 1425 | end;
1425   constructor TIBTransaction.Create(AOwner: TComponent);
1426   begin
1427    inherited Create(AOwner);
1447  FIBLoaded := False;
1448  CheckIBLoaded;
1449  FIBLoaded := True;
1450  CheckIBLoaded;
1428    FDatabases := TList.Create;
1429    FSQLObjects := TList.Create;
1453  FHandle := nil;
1430    FTPB := nil;
1455  FTPBLength := 0;
1431    FTRParams := TStringList.Create;
1432    FTRParamsChanged := True;
1433    TStringList(FTRParams).OnChange := TRParamsChange;
# Line 1468 | 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;
1482 <    FTRParams.Free;
1483 <    FSQLObjects.Free;
1484 <    FDatabases.Free;
1485 <  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  
1489 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1490  RaiseError: Boolean): ISC_STATUS;
1491 var
1492  i: Integer;
1493 begin
1494  result := ErrCode;
1495  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1496    Databases[i].FCanTimeout := False;
1497  FCanTimeout := False;
1498  if RaiseError and (result > 0) then
1499    IBDataBaseError;
1500 end;
1501
1460   procedure TIBTransaction.CheckDatabasesInList;
1461   begin
1462    if GetDatabaseCount = 0 then
# Line 1509 | 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 1565 | 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 1581 | 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 1631 | Line 1593 | end;
1593   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1594    Force: Boolean);
1595   var
1634  status: ISC_STATUS;
1596    i: Integer;
1597   begin
1598    CheckInTransaction;
# Line 1642 | 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
1656 <          FHandle := nil;
1657 <          FHandleIsShared := False;
1658 <          status := 0;
1659 <        end
1660 <        else
1661 <          if (Action = TARollback) then
1662 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1663 <          else
1664 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1665 <        if ((Force) and (status > 0)) then
1666 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1667 <        if Force then
1668 <          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 1729 | 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 1785 | 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 1793 | 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 1805 | 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 1851 | Line 1844 | begin
1844          Rollback;
1845   end;
1846  
1854 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1855 begin
1856 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1857    IBError(ibxeIB60feature, [nil]);*)
1858  FDefaultAction := Value;
1859 end;
1860
1847   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1848   var
1849    i: integer;
# Line 1880 | Line 1866 | begin
1866    FDefaultDatabase := Value;
1867   end;
1868  
1883 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1884 begin
1885  if (HandleIsShared) then
1886    EndTransaction(DefaultAction, True)
1887  else
1888    CheckNotInTransaction;
1889  FHandle := Value;
1890  FHandleIsShared := (Value <> nil);
1891 end;
1892
1869   procedure TIBTransaction.Notification( AComponent: TComponent;
1870                                          Operation: TOperation);
1871   var
# Line 1931 | Line 1907 | end;
1907  
1908   procedure TIBTransaction.StartTransaction;
1909   var
1934  pteb: PISC_TEB_ARRAY;
1935  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 1953 | Line 1935 | begin
1935    if FTRParamsChanged then
1936    begin
1937      FTRParamsChanged := False;
1938 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1957 <    if FTPBLength > 0 then
1958 <    begin
1959 <      IBAlloc(FTPB, 0, FTPBLength);
1960 <      Move(TPB[1], FTPB[0], FTPBLength);
1961 <    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;
1978 <    end;
1979 <    if not (csDesigning in ComponentState) then
1980 <      MonitorHook.TRStart(Self);
1981 <  finally
1982 <    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 1988 | 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
1997    else
1998      FCanTimeout := True;
1972    end;
1973   end;
1974  
# Line 2008 | Line 1981 | procedure TIBTransaction.TRParamsChangin
1981   begin
1982    EnsureNotInTransaction;
1983    CheckNotInTransaction;
1984 +  FTransactionIntf := nil;
1985   end;
1986  
1987   { TIBBase }
# Line 2023 | Line 1997 | begin
1997    inherited Destroy;
1998   end;
1999  
2026 function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2027 begin
2028  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2029    Result := Database.FCharSetSizes[CharSetID]
2030  else
2031    Result := 1; {Unknown character set}
2032 end;
2033
2034 function TIBBase.GetDefaultCharSetSize: integer;
2035 var DefaultCharSetName: string;
2036    i: integer;
2037 begin
2038  DefaultCharSetName := GetDefaultCharSetName;
2039  Result := 4; {worse case}
2040  for i := 0 to Length(Database.FCharSetSizes) - 1 do
2041    if Database.FCharSetNames[i] = DefaultCharSetName then
2042    begin
2043      Result := Database.FCharSetSizes[i];
2044      break;
2045    end;
2046 end;
2047
2048 function TIBBase.GetCharSetName(CharSetID: integer): string;
2049 begin
2050  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2051    Result := Database.FCharSetNames[CharSetID]
2052  else
2053    Result := ''; {Unknown character set}
2054 end;
2055
2056 function TIBBase.GetDefaultCharSetName: string;
2057 begin
2058  Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2059 end;
2060
2000   procedure TIBBase.HandleException(Sender: TObject);
2001   begin
2002    if assigned(Database) then
# Line 2096 | Line 2035 | begin
2035    FTransaction.CheckInTransaction;
2036   end;
2037  
2099 function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2100 begin
2101  CheckDatabase;
2102  result := @FDatabase.Handle;
2103 end;
2104
2105 function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2106 begin
2107  CheckTransaction;
2108  result := @FTransaction.Handle;
2109 end;
2110
2038   procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2039    );
2040   begin
# Line 2222 | 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
2232 <    the DPB version must be the first byte of the string. }
2233 <  DPBLength := 1;
2234 <  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 2270 | Line 2194 | begin
2194        begin
2195          if DPBVal = isc_dpb_sql_dialect then
2196            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2197 <        DPB := DPB +
2274 <               Char(DPBVal) +
2275 <               Char(Length(ParamValue)) +
2276 <               ParamValue;
2277 <        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 +
2283 <               Char(DPBVal) +
2284 <               #1 +
2285 <               Char(StrToInt(ParamValue));
2286 <        Inc(DPBLength, 3);
2287 <      end;
2202 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2203 >
2204        isc_dpb_sweep:
2205 <      begin
2206 <        DPB := DPB +
2291 <               Char(DPBVal) +
2292 <               #1 +
2293 <               Char(isc_dpb_records);
2294 <        Inc(DPBLength, 3);
2295 <      end;
2205 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2206 >
2207        isc_dpb_sweep_interval:
2208 <      begin
2209 <        pval := StrToInt(ParamValue);
2299 <        DPB := DPB +
2300 <               Char(DPBVal) +
2301 <               #4 +
2302 <               PChar(@pval)[0] +
2303 <               PChar(@pval)[1] +
2304 <               PChar(@pval)[2] +
2305 <               PChar(@pval)[3];
2306 <        Inc(DPBLength, 6);
2307 <      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
2311 <        DPB := DPB +
2312 <               Char(DPBVal) +
2313 <               #1 + #0;
2314 <        Inc(DPBLength, 3);
2315 <      end;
2212 >        Result.Add(DPBVal).SetAsByte(0);
2213        else
2214        begin
2215          if (DPBVal > 0) and
# Line 2330 | 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 := '';
2339 <  if (sl.Count = 0) then
2340 <    TPBLength := 0
2341 <  else
2342 <  begin
2343 <    TPBLength := sl.Count + 1;
2344 <    TPB := TPB + Char(isc_tpb_version3);
2345 <  end;
2235 >  Result := FirebirdAPI.AllocateTPB;
2236    for i := 0 to sl.Count - 1 do
2237    begin
2238      if (Trim(sl[i]) =  '') then
2349    begin
2350      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 2373 | 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);
2380 <        { Now set the string parameter }
2381 <        ParamLength := Length(ParamValue);
2382 <        Inc(TPBLength, ParamLength + 1);
2383 <        TPB := TPB + Char(ParamLength) + ParamValue;
2384 <      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