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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21:02 2017 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 <  Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47 <  IB, DBLoginDlg;
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 +    FDefaultCharSetID: integer;
175 +    FDefaultCharSetName: RawByteString;
176 +    FDefaultCodePage: TSystemCodePage;
177 +    FDPB: IDPB;
178      FAllowStreamedConnected: boolean;
179      FHiddenPassword: string;
180 <    FIBLoaded: Boolean;
180 >    FOnCreateDatabase: TNotifyEvent;
181      FOnLogin: TIBDatabaseLoginEvent;
182 +    FSQLHourGlass: Boolean;
183      FTraceFlags: TTraceFlags;
184      FDBSQLDialect: Integer;
185      FSQLDialect: Integer;
186      FOnDialectDowngradeWarning: TNotifyEvent;
166    FCanTimeout: Boolean;
187      FSQLObjects: TList;
188      FTransactions: TList;
189      FDBName: TIBFileName;
190      FDBParams: TStrings;
191      FDBParamsChanged: Boolean;
172    FDPB: PChar;
173    FDPBLength: Short;
174    FHandle: TISC_DB_HANDLE;
175    FHandleIsShared: Boolean;
192      FOnIdleTimer: TNotifyEvent;
193      FDefaultTransaction: TIBTransaction;
194      FInternalTransaction: TIBTransaction;
195 <    FStreamedConnected: Boolean;
180 <    FTimer: TTimer;
195 >    FTimer: TFPTimer;
196      FUserNames: TStringList;
197      FDataSets: TList;
198      FLoginCalled: boolean;
199 +    FUseDefaultSystemCodePage: boolean;
200      procedure EnsureInactive;
201      function GetDBSQLDialect: Integer;
202      function GetSQLDialect: Integer;
# Line 190 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
193    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
212 <    function Login: Boolean;
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 212 | Line 227 | type
227      procedure DoDisconnect; override;
228      function GetConnected: Boolean; override;
229      procedure CheckStreamConnect;
230 +    procedure HandleException(Sender: TObject);
231      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
232      function GetDataset(Index : longint) : TDataset; override;
233      function GetDataSetCount : Longint; override;
234 +    procedure ReadState(Reader: TReader); override;
235      procedure SetConnected (Value : boolean); override;
236    public
237      constructor Create(AOwner: TComponent); override;
# Line 223 | 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 231 | Line 249 | type
249      function IndexOfDBConst(st: String): Integer;
250      function TestConnected: Boolean;
251      procedure CheckDatabaseName;
234    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;
240    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;
244    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
245                                                      write SetDBParamByDPB;
261      property SQLObjectCount: Integer read GetSQLObjectCount;
262      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
248    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 +    property DefaultCharSetID: integer read FDefaultCharSetID;
268 +    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
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 261 | Line 279 | type
279                                                   write SetDefaultTransaction;
280      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282 <    property DBSQLDialect : Integer read FDBSQLDialect;
282 >    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
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 <    FIBLoaded: Boolean;
303 <    FCanTimeout         : Boolean;
302 >    FTransactionIntf: ITransaction;
303 >    FAfterDelete: TNotifyEvent;
304 >    FAfterEdit: TNotifyEvent;
305 >    FAfterExecQuery: TNotifyEvent;
306 >    FAfterInsert: TNotifyEvent;
307 >    FAfterPost: TNotifyEvent;
308 >    FAfterTransactionEnd: TNotifyEvent;
309 >    FBeforeTransactionEnd: TNotifyEvent;
310      FDatabases          : TList;
311 +    FOnStartTransaction: TNotifyEvent;
312      FSQLObjects         : TList;
313      FDefaultDatabase    : TIBDatabase;
286    FHandle             : TISC_TR_HANDLE;
287    FHandleIsShared     : Boolean;
314      FOnIdleTimer          : TNotifyEvent;
315      FStreamedActive     : Boolean;
316 <    FTPB                : PChar;
317 <    FTPBLength          : Short;
318 <    FTimer              : TTimer;
293 <    FDefaultAction      : TTransactionAction;
316 >    FTPB                : ITPB;
317 >    FTimer              : TFPTimer;
318 >    FDefaultAction      : TDefaultEndAction;
319      FTRParams           : TStrings;
320      FTRParamsChanged    : Boolean;
321      FInEndTransaction   : boolean;
322 +    FEndAction          : TTransactionAction;
323 +    procedure DoBeforeTransactionEnd;
324 +    procedure DoAfterTransactionEnd;
325 +    procedure DoOnStartTransaction;
326 +    procedure DoAfterExecQuery(Sender: TObject);
327 +    procedure DoAfterEdit(Sender: TObject);
328 +    procedure DoAfterDelete(Sender: TObject);
329 +    procedure DoAfterInsert(Sender: TObject);
330 +    procedure DoAfterPost(Sender: TObject);
331      procedure EnsureNotInTransaction;
332      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
333      function GetDatabase(Index: Integer): TIBDatabase;
# Line 304 | Line 338 | type
338      function GetIdleTimer: Integer;
339      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340      procedure SetActive(Value: Boolean);
307    procedure SetDefaultAction(Value: TTransactionAction);
341      procedure SetDefaultDatabase(Value: TIBDatabase);
342      procedure SetIdleTimer(Value: Integer);
343      procedure SetTRParams(Value: TStrings);
# Line 317 | Line 350 | type
350  
351    protected
352      procedure Loaded; override;
320    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;
326    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358      procedure Commit;
359      procedure CommitRetaining;
360      procedure Rollback;
# Line 335 | Line 366 | type
366      function AddDatabase(db: TIBDatabase): Integer;
367      function FindDatabase(db: TIBDatabase): Integer;
368      function FindDefaultDatabase: TIBDatabase;
369 +    function GetEndAction: TTransactionAction;
370      procedure RemoveDatabase(Idx: Integer);
371      procedure RemoveDatabases;
372      procedure CheckDatabasesInList;
# Line 343 | 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;
346    property Handle: TISC_TR_HANDLE read FHandle;
347    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 <  end;
389 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
390 >                                             write FBeforeTransactionEnd;
391 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
392 >                                            write FAfterTransactionEnd;
393 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
394 >                                              write FOnStartTransaction;
395 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
396 >                                              write FAfterExecQuery;
397 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
398 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
399 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
400 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
401 >  end;
402 >
403 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
404 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
405 >                              var DBName: string) of object;
406  
407    { TIBBase }
408  
# Line 365 | Line 411 | type
411      connections. }
412    TIBBase = class(TObject)
413    protected
414 +    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
415      FDatabase: TIBDatabase;
416      FIndexInDatabase: Integer;
417      FTransaction: TIBTransaction;
# Line 374 | Line 421 | type
421      FAfterDatabaseDisconnect: TNotifyEvent;
422      FAfterDatabaseConnect: TNotifyEvent;
423      FOnDatabaseFree: TNotifyEvent;
424 <    FBeforeTransactionEnd: TNotifyEvent;
424 >    FBeforeTransactionEnd: TTransactionEndEvent;
425      FAfterTransactionEnd: TNotifyEvent;
426      FOnTransactionFree: TNotifyEvent;
427  
428 +    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
429 +                              var DBName: string); virtual;
430      procedure DoAfterDatabaseConnect; virtual;
431      procedure DoBeforeDatabaseDisconnect; virtual;
432      procedure DoAfterDatabaseDisconnect; virtual;
433      procedure DoDatabaseFree; virtual;
434 <    procedure DoBeforeTransactionEnd; virtual;
434 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435      procedure DoAfterTransactionEnd; virtual;
436      procedure DoTransactionFree; virtual;
388    function GetDBHandle: PISC_DB_HANDLE; virtual;
389    function GetTRHandle: PISC_TR_HANDLE; virtual;
437      procedure SetDatabase(Value: TIBDatabase); virtual;
438      procedure SetTransaction(Value: TIBTransaction); virtual;
439    public
# Line 394 | Line 441 | type
441      destructor Destroy; override;
442      procedure CheckDatabase; virtual;
443      procedure CheckTransaction; virtual;
444 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
445 +    procedure DoAfterEdit(Sender: TObject); virtual;
446 +    procedure DoAfterDelete(Sender: TObject); virtual;
447 +    procedure DoAfterInsert(Sender: TObject); virtual;
448 +    procedure DoAfterPost(Sender: TObject); virtual;
449 +    procedure HandleException(Sender: TObject);
450 +    procedure SetCursor;
451 +    procedure RestoreCursor;
452    public
453 +    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
454 +                                                 write FBeforeDatabaseConnect;
455      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
456                                                  write FAfterDatabaseConnect;
457      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
# Line 402 | Line 459 | type
459      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
460                                                    write FAfterDatabaseDisconnect;
461      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
462 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
464      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465      property Database: TIBDatabase read FDatabase
466                                      write SetDatabase;
410    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467      property Owner: TObject read FOwner;
412    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, typInfo;
478 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 >     typInfo, FBMessages, IBErrorCodes, RegExpr;
480  
481   { TIBDatabase }
482  
483 < constructor TIBDatabase.Create(AOwner: TComponent);
483 > constructor TIBDataBase.Create(AOwner: TComponent);
484   begin
485    inherited Create(AOwner);
430  FIBLoaded := False;
431  CheckIBLoaded;
432  FIBLoaded := True;
486    LoginPrompt := True;
487    FSQLObjects := TList.Create;
488    FTransactions := TList.Create;
489    FDBName := '';
490    FDBParams := TStringList.Create;
491 +  FSQLHourGlass := true;
492 +  if (AOwner <> nil) and
493 +     (AOwner is TCustomApplication) and
494 +     TCustomApplication(AOWner).ConsoleApplication then
495 +    LoginPrompt := false;
496    FDBParamsChanged := True;
497    TStringList(FDBParams).OnChange := DBParamsChange;
498    TStringList(FDBParams).OnChanging := DBParamsChanging;
499    FDPB := nil;
442  FHandle := nil;
500    FUserNames := nil;
501    FInternalTransaction := TIBTransaction.Create(self);
502    FInternalTransaction.DefaultDatabase := Self;
503 <  FTimer := TTimer.Create(Self);
503 >  FTimer := TFPTimer.Create(Self);
504    FTimer.Enabled := False;
505    FTimer.Interval := 0;
506    FTimer.OnTimer := TimeoutConnection;
# Line 454 | 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;
475 <    FSQLObjects.Free;
476 <    FUserNames.Free;
477 <    FTransactions.Free;
478 <  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  
536 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
484 <  RaiseError: Boolean): ISC_STATUS;
485 < begin
486 <  result := ErrCode;
487 <  FCanTimeout := False;
488 <  if RaiseError and (ErrCode > 0) then
489 <    IBDataBaseError;
490 < end;
491 <
492 < procedure TIBDatabase.CheckActive;
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  
544 < procedure TIBDatabase.EnsureInactive;
544 > procedure TIBDataBase.EnsureInactive;
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;
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;
559 > procedure TIBDataBase.CheckDatabaseName;
560   begin
561 <  if (FDBName = '') then
561 >  if (Trim(FDBName) = '') then
562      IBError(ibxeDatabaseNameMissing, [nil]);
563   end;
564  
565 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
565 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
566   begin
567    result := 0;
568    if (ds.Owner is TIBCustomDataSet) then
# Line 531 | Line 575 | begin
575      FSQLObjects[result] := ds;
576   end;
577  
578 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
578 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
579   begin
580    result := FindTransaction(TR);
581    if result <> -1 then
# Line 548 | Line 592 | begin
592      FTransactions[result] := TR;
593   end;
594  
595 < procedure TIBDatabase.DoDisconnect;
595 > procedure TIBDataBase.DoDisconnect;
596   begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
600 +  FDefaultCharSetName := '';
601 +  FDefaultCharSetID := 0;
602 +  FDefaultCodePage := CP_NONE;
603   end;
604  
605 < procedure TIBDatabase.CreateDatabase;
606 < var
607 <  tr_handle: TISC_TR_HANDLE;
605 >  procedure TIBDataBase.CreateDatabase;
606 > begin
607 >  CheckInactive;
608 >  CheckDatabaseName;
609 >  FCreateDatabase := true;
610 >  Connected := true;
611 > end;
612 >
613 > procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614 > var RegexObj: TRegExpr;
615   begin
616    CheckInactive;
617 <  tr_handle := nil;
618 <  Call(
619 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
620 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
621 <                               Params.Text), SQLDialect, nil),
622 <    True);
617 >  FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
618 >  RegexObj := TRegExpr.Create;
619 >  try
620 >    {extact database file spec}
621 >    RegexObj.ModifierG := false; {turn off greedy matches}
622 >    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
623 >    if RegexObj.Exec(AnsiUpperCase(createDatabaseSQL)) then
624 >      FDBName := system.copy(createDatabaseSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
625 >  finally
626 >    RegexObj.Free;
627 >  end;
628 >  if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
629 >    OnCreateDatabase(self);
630   end;
631  
632 < procedure TIBDatabase.DropDatabase;
632 > procedure TIBDataBase.DropDatabase;
633   begin
634    CheckActive;
635 <  Call(isc_drop_database(StatusVector, @FHandle), True);
635 >  FAttachment.DropDatabase;
636 >  FAttachment := nil;
637   end;
638  
639 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
639 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
640   begin
641    FDBParamsChanged := True;
642   end;
643  
644 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
644 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
645   begin
646    EnsureInactive;
647    CheckInactive;
648   end;
649  
650 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
650 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
651   var
652    i: Integer;
653   begin
# Line 598 | Line 660 | begin
660      end;
661   end;
662  
663 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
663 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
664   var
665    i: Integer;
666   begin
# Line 616 | Line 678 | begin
678    end;
679   end;
680  
681 < procedure TIBDatabase.ForceClose;
681 > procedure TIBDataBase.ForceClose;
682   begin
683    if Connected then
684      InternalClose(True);
685   end;
686  
687 < function TIBDatabase.GetConnected: Boolean;
687 > function TIBDataBase.GetConnected: Boolean;
688   begin
689 <  result := FHandle <> nil;
689 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
690   end;
691  
692 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
692 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
693   begin
694    result := FSQLObjects[Index];
695   end;
696  
697 < function TIBDatabase.GetSQLObjectCount: Integer;
697 > function TIBDataBase.GetSQLObjectCount: Integer;
698   var
699    i: Integer;
700   begin
# Line 641 | Line 703 | begin
703      Inc(result);
704   end;
705  
706 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
645 < var
646 <  ConstIdx, EqualsIdx: Integer;
647 < begin
648 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
649 <  begin
650 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
651 <    if ConstIdx = -1 then
652 <      result := ''
653 <    else
654 <    begin
655 <      result := Params[ConstIdx];
656 <      EqualsIdx := Pos('=', result); {mbcs ok}
657 <      if EqualsIdx = 0 then
658 <        result := ''
659 <      else
660 <        result := Copy(result, EqualsIdx + 1, Length(result));
661 <    end;
662 <  end
663 <  else
664 <    result := '';
665 < end;
666 <
667 < function TIBDatabase.GetIdleTimer: Integer;
706 > function TIBDataBase.GetIdleTimer: Integer;
707   begin
708    result := FTimer.Interval;
709   end;
710  
711 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
711 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
712   begin
713    result := FTransactions[Index];
714   end;
715  
716 < function TIBDatabase.GetTransactionCount: Integer;
716 > function TIBDataBase.GetTransactionCount: Integer;
717   var
718    i: Integer;
719   begin
# Line 684 | Line 723 | begin
723        Inc(result);
724   end;
725  
726 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
726 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
727   var
728    i, pos_of_str: Integer;
729   begin
# Line 700 | Line 739 | begin
739    end;
740   end;
741  
742 < procedure TIBDatabase.InternalClose(Force: Boolean);
742 > procedure TIBDataBase.InternalClose(Force: Boolean);
743   var
744    i: Integer;
745   begin
# Line 729 | Line 768 | begin
768      end;
769    end;
770  
771 <  if (not HandleIsShared) and
772 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
734 <     (not Force) then
735 <    IBDataBaseError
736 <  else
737 <  begin
738 <    FHandle := nil;
739 <    FHandleIsShared := False;
740 <  end;
771 >  FAttachment.Disconnect(Force);
772 >  FAttachment := nil;
773  
774    if not (csDesigning in ComponentState) then
775      MonitorHook.DBDisconnect(Self);
# Line 769 | Line 801 | begin
801           (FDefaultTransaction.FStreamedActive) and
802           (not FDefaultTransaction.InTransaction) then
803          FDefaultTransaction.StartTransaction;
804 <      FStreamedConnected := False;
804 >      StreamedConnected := False;
805      end;
806    except
807      if csDesigning in ComponentState then
808 <      Application.HandleException(Self)
808 >      HandleException(Self)
809      else
810        raise;
811    end;
812   end;
813  
814 < procedure TIBDatabase.Notification( AComponent: TComponent;
815 <                                        Operation: TOperation);
814 > procedure TIBDataBase.HandleException(Sender: TObject);
815 > var aParent: TComponent;
816 > begin
817 >  aParent := Owner;
818 >  while aParent <> nil do
819 >  begin
820 >    if aParent is TCustomApplication then
821 >    begin
822 >      TCustomApplication(aParent).HandleException(Sender);
823 >      Exit;
824 >    end;
825 >    aParent := aParent.Owner;
826 >  end;
827 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
828 > end;
829 >
830 > procedure TIBDataBase.Notification(AComponent: TComponent;
831 >   Operation: TOperation);
832   var
833    i: Integer;
834   begin
# Line 794 | Line 842 | begin
842    end;
843   end;
844  
845 < function TIBDatabase.Login: Boolean;
845 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
846   var
847    IndexOfUser, IndexOfPassword: Integer;
848    Username, Password, OldPassword: String;
# Line 830 | Line 878 | begin
878        LoginParams.Assign(Params);
879        FOnLogin(Self, LoginParams);
880        Params.Assign (LoginParams);
881 +      aDatabaseName := FDBName;
882        HidePassword;
883      finally
884        LoginParams.Free;
885      end;
886    end
887    else
888 +  if assigned(IBGUIInterface) then
889    begin
890      IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
891      if IndexOfUser <> -1 then
# Line 850 | Line 900 | begin
900                                           Length(Params[IndexOfPassword]));
901        OldPassword := password;
902      end;
903 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
903 >
904 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
905      if result then
906      begin
907 <      if IndexOfUser = -1 then
908 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
909 <      else
910 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
907 >      if Username <> '' then
908 >      begin
909 >        if IndexOfUser = -1 then
910 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
911 >        else
912 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
913                                   '=' + Username;
914 +      end
915 +      else
916 +      if IndexOfUser <> -1 then
917 +        Params.Delete(IndexOfUser);
918        if (Password = OldPassword) then
919          FHiddenPassword := ''
920        else
# Line 867 | Line 924 | begin
924            HidePassword;
925        end;
926      end;
927 <  end;
927 >  end
928 >  else
929 >  if LoginPrompt then
930 >     IBError(ibxeNoLoginDialog,[]);
931    finally
932      FLoginCalled := false
933    end;
934   end;
935  
936 < procedure TIBDatabase.DoConnect;
936 > procedure TIBDataBase.DoConnect;
937   var
878  DPB: String;
938    TempDBParams: TStrings;
939    I: integer;
940 <
940 >  aDBName: string;
941 >  Status: IStatus;
942 >  CharSetID: integer;
943   begin
944    CheckInactive;
945    CheckDatabaseName;
# Line 888 | Line 949 | begin
949      FDBParamsChanged := True;
950    end;
951    { Use builtin login prompt if requested }
952 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
952 >  aDBName := FDBName;
953 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
954      IBError(ibxeOperationCancelled, [nil]);
955 <  { Generate a new DPB if necessary }
956 <  if (FDBParamsChanged) then
957 <  begin
958 <    FDBParamsChanged := False;
959 <    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
960 <      GenerateDPB(FDBParams, DPB, FDPBLength)
955 >
956 >  TempDBParams := TStringList.Create;
957 >  try
958 >   TempDBParams.Assign(FDBParams);
959 >   if UseDefaultSystemCodePage then
960 >   begin
961 >     {$ifdef WINDOWS}
962 >     if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
963 >       TempDBParams.Values['lc_ctype'] := Attachment.GetCharsetName(CharSetID)
964 >     {$else}
965 >     if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
966 >       TempDBParams.Values['lc_ctype'] := Attachment.GetCharsetName(CharSetID)
967 >     {$endif}
968 >     else
969 >       TempDBParams.Values['lc_ctype'] :='UTF8';
970 >   end;
971 >   {Opportunity to override defaults}
972 >   for i := 0 to FSQLObjects.Count - 1 do
973 >   begin
974 >       if FSQLObjects[i] <> nil then
975 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
976 >   end;
977 >
978 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
979 >   { Generate a new DPB if necessary }
980 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
981 >   begin
982 >     FDBParamsChanged := False;
983 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
984 >       FDPB := GenerateDPB(TempDBParams)
985 >     else
986 >     begin
987 >        TempDBParams.Add('password=' + FHiddenPassword);
988 >        FDPB := GenerateDPB(TempDBParams);
989 >     end;
990 >   end;
991 >  finally
992 >   TempDBParams.Free;
993 >  end;
994 >
995 >  repeat
996 >    if FCreateDatabase then
997 >    begin
998 >      FCreateDatabase := false;
999 >      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1000 >      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1001 >        OnCreateDatabase(self);
1002 >    end
1003      else
1004 +      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1005 +    if FAttachment = nil then
1006      begin
1007 <      TempDBParams := TStringList.Create;
1008 <      try
1009 <       TempDBParams.Assign(FDBParams);
1010 <       TempDBParams.Add('password=' + FHiddenPassword);
1011 <       GenerateDPB(TempDBParams, DPB, FDPBLength);
1012 <      finally
1013 <       TempDBParams.Free;
1007 >      Status := FirebirdAPI.GetStatus;
1008 >      {$IFDEF UNIX}
1009 >      if Pos(':',aDBName) = 0 then
1010 >      begin
1011 >          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1012 >             or
1013 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1014 >             or
1015 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1016 >             or
1017 >             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1018 >             then
1019 >             begin
1020 >               aDBName := 'localhost:' + aDBName;
1021 >               Continue;
1022 >            end
1023        end;
1024 +      {$ENDIF}
1025 +      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1026 +                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1027 +        FCreateDatabase := true
1028 +      else
1029 +        raise EIBInterBaseError.Create(Status);
1030      end;
1031 <    IBAlloc(FDPB, 0, FDPBLength);
1032 <    Move(DPB[1], FDPB[0], FDPBLength);
1033 <  end;
1034 <  if Call(isc_attach_database(StatusVector, Length(FDBName),
1035 <                         PChar(FDBName), @FHandle,
1036 <                         FDPBLength, FDPB), False) > 0 then
1037 <  begin
1038 <    FHandle := nil;
918 <    IBDataBaseError;
919 <  end;
1031 >  until FAttachment <> nil;
1032 >
1033 >  if FDefaultCharSetName <> '' then
1034 >    Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1035 >  Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036 >
1037 >  if not (csDesigning in ComponentState) then
1038 >    FDBName := aDBName; {Synchronise at run time}
1039    FDBSQLDialect := GetDBSQLDialect;
1040    ValidateClientSQLDialect;
1041    for i := 0 to FSQLObjects.Count - 1 do
# Line 928 | Line 1047 | begin
1047      MonitorHook.DBConnect(Self);
1048   end;
1049  
1050 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1050 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1051   var
1052    ds: TIBBase;
1053   begin
# Line 942 | Line 1061 | begin
1061    end;
1062   end;
1063  
1064 < procedure TIBDatabase.RemoveSQLObjects;
1064 > procedure TIBDataBase.RemoveSQLObjects;
1065   var
1066    i: Integer;
1067   begin
# Line 954 | Line 1073 | begin
1073    end;
1074   end;
1075  
1076 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1076 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1077   var
1078    TR: TIBTransaction;
1079   begin
# Line 968 | Line 1087 | begin
1087    end;
1088   end;
1089  
1090 < procedure TIBDatabase.RemoveTransactions;
1090 > procedure TIBDataBase.RemoveTransactions;
1091   var
1092    i: Integer;
1093   begin
# Line 976 | Line 1095 | begin
1095      RemoveTransaction(i);
1096   end;
1097  
1098 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1098 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1099   begin
1100    if FDBName <> Value then
1101    begin
# Line 986 | Line 1105 | begin
1105    end;
1106   end;
1107  
1108 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1108 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1109   var
1110    ConstIdx: Integer;
1111   begin
# Line 1005 | Line 1124 | begin
1124    end;
1125   end;
1126  
1127 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1127 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1128   begin
1129    FDBParams.Assign(Value);
1130   end;
1131  
1132 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1132 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1133   var
1134    i: Integer;
1135   begin
# Line 1028 | Line 1147 | begin
1147    FDefaultTransaction := Value;
1148   end;
1149  
1150 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1032 < begin
1033 <  if HandleIsShared then
1034 <    Close
1035 <  else
1036 <    CheckInactive;
1037 <  FHandle := Value;
1038 <  FHandleIsShared := (Value <> nil);
1039 < end;
1040 <
1041 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1150 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1151   begin
1152    if Value < 0 then
1153      IBError(ibxeTimeoutNegative, [nil])
# Line 1057 | Line 1166 | begin
1166        end;
1167   end;
1168  
1169 < function TIBDatabase.TestConnected: Boolean;
1169 > function TIBDataBase.TestConnected: Boolean;
1170   var
1171    DatabaseInfo: TIBDatabaseInfo;
1172   begin
# Line 1078 | Line 1187 | begin
1187    end;
1188   end;
1189  
1190 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1190 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1191   begin
1192    if Connected then
1193    begin
1194 <    if FCanTimeout then
1194 >    if not FAttachment.HasActivity then
1195      begin
1196        ForceClose;
1197        if Assigned(FOnIdleTimer) then
1198          FOnIdleTimer(Self);
1199      end
1091    else
1092      FCanTimeout := True;
1200    end;
1201   end;
1202  
1203 < function TIBDatabase.GetIsReadOnly: Boolean;
1203 > function TIBDataBase.GetIsReadOnly: Boolean;
1204   var
1205    DatabaseInfo: TIBDatabaseInfo;
1206   begin
# Line 1111 | Line 1218 | begin
1218    DatabaseInfo.Free;
1219   end;
1220  
1221 < function TIBDatabase.GetSQLDialect: Integer;
1221 > function TIBDataBase.GetSQLDialect: Integer;
1222   begin
1223    Result := FSQLDialect;
1224   end;
1225  
1226  
1227 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1227 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1228   begin
1229    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1230 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1230 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1231      FSQLDialect := Value
1232    else
1233      IBError(ibxeSQLDialectInvalid, [nil]);
1234   end;
1235  
1236 < function TIBDatabase.GetDBSQLDialect: Integer;
1236 > function TIBDataBase.GetDBSQLDialect: Integer;
1237   var
1238    DatabaseInfo: TIBDatabaseInfo;
1239   begin
# Line 1136 | Line 1243 | begin
1243    DatabaseInfo.Free;
1244   end;
1245  
1246 < procedure TIBDatabase.ValidateClientSQLDialect;
1246 > procedure TIBDataBase.ValidateClientSQLDialect;
1247   begin
1248    if (FDBSQLDialect < FSQLDialect) then
1249    begin
# Line 1146 | Line 1253 | begin
1253    end;
1254   end;
1255  
1256 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1256 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1257   var
1258    I: Integer;
1259    DS: TIBCustomDataSet;
# Line 1172 | Line 1279 | begin
1279    TR.CommitRetaining;
1280   end;
1281  
1282 < procedure TIBDatabase.CloseDataSets;
1282 > procedure TIBDataBase.CloseDataSets;
1283   var
1284    i: Integer;
1285   begin
# Line 1181 | Line 1288 | begin
1288        DataSets[i].close;
1289   end;
1290  
1291 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1291 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1292   begin
1293    if (Index >= 0) and (Index < FDataSets.Count) then
1294      Result := TDataSet(FDataSets[Index])
# Line 1189 | Line 1296 | begin
1296      raise Exception.Create('Invalid Index to DataSets');
1297   end;
1298  
1299 < function TIBDatabase.GetDataSetCount : Longint;
1299 > function TIBDataBase.GetDataSetCount: Longint;
1300   begin
1301    Result := FDataSets.Count;
1302   end;
1303  
1304 + procedure TIBDataBase.ReadState(Reader: TReader);
1305 + begin
1306 +  FDBParams.Clear;
1307 +  inherited ReadState(Reader);
1308 + end;
1309 +
1310   procedure TIBDataBase.SetConnected(Value: boolean);
1311   begin
1312    if StreamedConnected and not AllowStreamedConnected then
# Line 1204 | Line 1317 | begin
1317    inherited SetConnected(Value);
1318   end;
1319  
1320 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1320 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1321   var
1322    Query: TIBSQL;
1323   begin
# Line 1233 | Line 1346 | begin
1346        BeginUpdate;
1347        try
1348          Clear;
1349 <        while (not Query.EOF) and (Query.Next <> nil) do
1350 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1349 >        while (not Query.EOF) and Query.Next  do
1350 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1351        finally
1352          EndUpdate;
1353        end;
# Line 1245 | Line 1358 | begin
1358    end;
1359   end;
1360  
1361 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1361 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1362   var
1363    Query : TIBSQL;
1364   begin
# Line 1273 | Line 1386 | begin
1386          BeginUpdate;
1387          try
1388            Clear;
1389 <          while (not Query.EOF) and (Query.Next <> nil) do
1390 <            List.Add(TrimRight(Query.Current[0].AsString));
1389 >          while (not Query.EOF) and Query.Next  do
1390 >            List.Add(TrimRight(Query.Fields[0].AsString));
1391          finally
1392            EndUpdate;
1393          end;
# Line 1291 | Line 1404 | end;
1404   constructor TIBTransaction.Create(AOwner: TComponent);
1405   begin
1406    inherited Create(AOwner);
1294  FIBLoaded := False;
1295  CheckIBLoaded;
1296  FIBLoaded := True;
1297  CheckIBLoaded;
1407    FDatabases := TList.Create;
1408    FSQLObjects := TList.Create;
1300  FHandle := nil;
1409    FTPB := nil;
1302  FTPBLength := 0;
1410    FTRParams := TStringList.Create;
1411    FTRParamsChanged := True;
1412    TStringList(FTRParams).OnChange := TRParamsChange;
1413    TStringList(FTRParams).OnChanging := TRParamsChanging;
1414 <  FTimer := TTimer.Create(Self);
1414 >  FTimer := TFPTimer.Create(Self);
1415    FTimer.Enabled := False;
1416    FTimer.Interval := 0;
1417    FTimer.OnTimer := TimeoutTransaction;
# Line 1315 | Line 1422 | destructor TIBTransaction.Destroy;
1422   var
1423    i: Integer;
1424   begin
1425 <  if FIBLoaded then
1426 <  begin
1427 <    if InTransaction then
1428 <      EndTransaction(FDefaultAction, True);
1429 <    for i := 0 to FSQLObjects.Count - 1 do
1430 <      if FSQLObjects[i] <> nil then
1431 <        SQLObjects[i].DoTransactionFree;
1432 <    RemoveSQLObjects;
1433 <    RemoveDatabases;
1434 <    FreeMem(FTPB);
1435 <    FTPB := nil;
1329 <    FTRParams.Free;
1330 <    FSQLObjects.Free;
1331 <    FDatabases.Free;
1332 <  end;
1425 >  if InTransaction then
1426 >    EndTransaction(FDefaultAction, True);
1427 >  for i := 0 to FSQLObjects.Count - 1 do
1428 >    if FSQLObjects[i] <> nil then
1429 >      SQLObjects[i].DoTransactionFree;
1430 >  RemoveSQLObjects;
1431 >  RemoveDatabases;
1432 >  FTPB := nil;
1433 >  FTRParams.Free;
1434 >  FSQLObjects.Free;
1435 >  FDatabases.Free;
1436    inherited Destroy;
1437   end;
1438  
1336 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1337  RaiseError: Boolean): ISC_STATUS;
1338 var
1339  i: Integer;
1340 begin
1341  result := ErrCode;
1342  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1343    Databases[i].FCanTimeout := False;
1344  FCanTimeout := False;
1345  if RaiseError and (result > 0) then
1346    IBDataBaseError;
1347 end;
1348
1439   procedure TIBTransaction.CheckDatabasesInList;
1440   begin
1441    if GetDatabaseCount = 0 then
# Line 1356 | Line 1446 | procedure TIBTransaction.CheckInTransact
1446   begin
1447    if FStreamedActive and (not InTransaction) then
1448      Loaded;
1449 <  if (FHandle = nil) then
1449 >  if (TransactionIntf = nil) then
1450      IBError(ibxeNotInTransaction, [nil]);
1451   end;
1452  
1453 + procedure TIBTransaction.DoBeforeTransactionEnd;
1454 + begin
1455 +  if Assigned(FBeforeTransactionEnd) then
1456 +    FBeforeTransactionEnd(self);
1457 + end;
1458 +
1459 + procedure TIBTransaction.DoAfterTransactionEnd;
1460 + begin
1461 +  if Assigned(FAfterTransactionEnd) then
1462 +    FAfterTransactionEnd(self);
1463 + end;
1464 +
1465 + procedure TIBTransaction.DoOnStartTransaction;
1466 + begin
1467 +  if assigned(FOnStartTransaction) then
1468 +    OnStartTransaction(self);
1469 + end;
1470 +
1471 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1472 + begin
1473 +  if assigned(FAfterExecQuery) then
1474 +    AfterExecQuery(Sender);
1475 + end;
1476 +
1477 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1478 + begin
1479 +  if assigned(FAfterEdit) then
1480 +    AfterEdit(Sender);
1481 + end;
1482 +
1483 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1484 + begin
1485 +  if assigned(FAfterDelete) then
1486 +    AfterDelete(Sender);
1487 + end;
1488 +
1489 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1490 + begin
1491 +  if assigned(FAfterInsert) then
1492 +    AfterInsert(Sender);
1493 + end;
1494 +
1495 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1496 + begin
1497 +  if assigned(FAfterPost) then
1498 +    AfterPost(Sender);
1499 + end;
1500 +
1501   procedure TIBTransaction.EnsureNotInTransaction;
1502   begin
1503    if csDesigning in ComponentState then
1504    begin
1505 <    if FHandle <> nil then
1505 >    if TransactionIntf <> nil then
1506        Rollback;
1507    end;
1508   end;
1509  
1510   procedure TIBTransaction.CheckNotInTransaction;
1511   begin
1512 <  if (FHandle <> nil) then
1512 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1513      IBError(ibxeInTransaction, [nil]);
1514   end;
1515  
# Line 1380 | Line 1518 | var
1518    i: Integer;
1519    NilFound: Boolean;
1520   begin
1521 +  EnsureNotInTransaction;
1522 +  CheckNotInTransaction;
1523 +  FTransactionIntf := nil;
1524 +
1525    i := FindDatabase(db);
1526    if i <> -1 then
1527    begin
# Line 1430 | Line 1572 | end;
1572   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1573    Force: Boolean);
1574   var
1433  status: ISC_STATUS;
1575    i: Integer;
1576   begin
1577    CheckInTransaction;
1578    if FInEndTransaction then Exit;
1579    FInEndTransaction := true;
1580 +  FEndAction := Action;
1581    try
1582    case Action of
1583      TARollback, TACommit:
1584      begin
1585 <      if (HandleIsShared) and
1444 <         (Action <> FDefaultAction) and
1445 <         (not Force) then
1446 <        IBError(ibxeCantEndSharedTransaction, [nil]);
1585 >      DoBeforeTransactionEnd;
1586        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1587 <        SQLObjects[i].DoBeforeTransactionEnd;
1587 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1588        if InTransaction then
1589        begin
1590 <        if HandleIsShared then
1591 <        begin
1453 <          FHandle := nil;
1454 <          FHandleIsShared := False;
1455 <          status := 0;
1456 <        end
1590 >        if (Action = TARollback) then
1591 >            FTransactionIntf.Rollback(Force)
1592          else
1593 <          if (Action = TARollback) then
1594 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1595 <          else
1596 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1597 <        if ((Force) and (status > 0)) then
1598 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1599 <        if Force then
1600 <          FHandle := nil
1601 <        else
1602 <          if (status > 0) then
1603 <            IBDataBaseError;
1593 >        try
1594 >          FTransactionIntf.Commit;
1595 >        except on E: EIBInterBaseError do
1596 >          begin
1597 >            if Force then
1598 >              FTransactionIntf.Rollback(Force)
1599 >            else
1600 >              raise;
1601 >          end;
1602 >        end;
1603 >
1604          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1605            SQLObjects[i].DoAfterTransactionEnd;
1606 +        DoAfterTransactionEnd;
1607        end;
1608      end;
1609      TACommitRetaining:
1610 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1610 >      FTransactionIntf.CommitRetaining;
1611 >
1612      TARollbackRetaining:
1613 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1613 >      FTransactionIntf.RollbackRetaining;
1614    end;
1615    if not (csDesigning in ComponentState) then
1616    begin
# Line 1525 | Line 1662 | end;
1662  
1663   function TIBTransaction.GetInTransaction: Boolean;
1664   begin
1665 <  result := (FHandle <> nil);
1665 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1666   end;
1667  
1668   function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
# Line 1558 | Line 1695 | begin
1695    end;
1696   end;
1697  
1698 + function TIBTransaction.GetEndAction: TTransactionAction;
1699 + begin
1700 +  if FInEndTransaction then
1701 +     Result := FEndAction
1702 +  else
1703 +     IBError(ibxeIB60feature, [nil])
1704 + end;
1705 +
1706  
1707   function TIBTransaction.GetIdleTimer: Integer;
1708   begin
# Line 1573 | Line 1718 | procedure TIBTransaction.BeforeDatabaseD
1718   begin
1719    if InTransaction then
1720      EndTransaction(FDefaultAction, True);
1721 +  FTransactionIntf := nil;
1722   end;
1723  
1724   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
# Line 1581 | Line 1727 | var
1727   begin
1728    if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1729    begin
1730 +    EnsureNotInTransaction;
1731 +    CheckNotInTransaction;
1732 +    FTransactionIntf := nil;
1733 +
1734      DB := Databases[Idx];
1735      FDatabases[Idx] := nil;
1736      DB.RemoveTransaction(DB.FindTransaction(Self));
# Line 1593 | Line 1743 | procedure TIBTransaction.RemoveDatabases
1743   var
1744    i: Integer;
1745   begin
1746 +  EnsureNotInTransaction;
1747 +  CheckNotInTransaction;
1748 +  FTransactionIntf := nil;
1749 +
1750    for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1751      RemoveDatabase(i);
1752   end;
# Line 1639 | Line 1793 | begin
1793          Rollback;
1794   end;
1795  
1642 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1643 begin
1644 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1645    IBError(ibxeIB60feature, [nil]);*)
1646  FDefaultAction := Value;
1647 end;
1648
1796   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1797   var
1798    i: integer;
# Line 1663 | Line 1810 | begin
1810      for i := 0 to FSQLObjects.Count - 1 do
1811        if (FSQLObjects[i] <> nil) and
1812           (TIBBase(FSQLObjects[i]).Database = nil) then
1813 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1813 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1814    end;
1815    FDefaultDatabase := Value;
1816   end;
1817  
1671 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1672 begin
1673  if (HandleIsShared) then
1674    EndTransaction(DefaultAction, True)
1675  else
1676    CheckNotInTransaction;
1677  FHandle := Value;
1678  FHandleIsShared := (Value <> nil);
1679 end;
1680
1818   procedure TIBTransaction.Notification( AComponent: TComponent;
1819                                          Operation: TOperation);
1820   var
# Line 1719 | Line 1856 | end;
1856  
1857   procedure TIBTransaction.StartTransaction;
1858   var
1722  pteb: PISC_TEB_ARRAY;
1723  TPB: String;
1859    i: Integer;
1860 +  Attachments: array of IAttachment;
1861 +  ValidDatabaseCount: integer;
1862   begin
1863    CheckNotInTransaction;
1864    CheckDatabasesInList;
1865 +  if TransactionIntf <> nil then
1866 +  begin
1867 +    TransactionIntf.Start(DefaultAction);
1868 +    Exit;
1869 +  end;
1870 +
1871    for i := 0 to FDatabases.Count - 1 do
1872     if  FDatabases[i] <> nil then
1873     begin
1874       with TIBDatabase(FDatabases[i]) do
1875       if not Connected then
1876 <       if FStreamedConnected then
1876 >       if StreamedConnected then
1877         begin
1878           Open;
1879 <         FStreamedConnected := False;
1879 >         StreamedConnected := False;
1880         end
1881         else
1882           IBError(ibxeDatabaseClosed, [nil]);
# Line 1741 | Line 1884 | begin
1884    if FTRParamsChanged then
1885    begin
1886      FTRParamsChanged := False;
1887 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1745 <    if FTPBLength > 0 then
1746 <    begin
1747 <      IBAlloc(FTPB, 0, FTPBLength);
1748 <      Move(TPB[1], FTPB[0], FTPBLength);
1749 <    end;
1887 >    FTPB :=  GenerateTPB(FTRParams);
1888    end;
1889  
1890 <  pteb := nil;
1891 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1892 <  try
1893 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1894 <    begin
1895 <      pteb^[i].db_handle := @(Databases[i].Handle);
1896 <      pteb^[i].tpb_length := FTPBLength;
1897 <      pteb^[i].tpb_address := FTPB;
1898 <    end;
1899 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1900 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1901 <    begin
1902 <      FHandle := nil;
1903 <      IBDataBaseError;
1766 <    end;
1767 <    if not (csDesigning in ComponentState) then
1768 <      MonitorHook.TRStart(Self);
1769 <  finally
1770 <    FreeMem(pteb);
1890 >  ValidDatabaseCount := 0;
1891 >  for i := 0 to DatabaseCount - 1 do
1892 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1893 >
1894 >  if ValidDatabaseCount = 1 then
1895 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1896 >  else
1897 >  begin
1898 >    SetLength(Attachments,ValidDatabaseCount);
1899 >    for i := 0 to DatabaseCount - 1 do
1900 >      if Databases[i] <> nil then
1901 >        Attachments[i] := Databases[i].Attachment;
1902 >
1903 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1904    end;
1905 +
1906 +  if not (csDesigning in ComponentState) then
1907 +      MonitorHook.TRStart(Self);
1908 +  DoOnStartTransaction;
1909   end;
1910  
1911   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1912   begin
1913    if InTransaction then
1914    begin
1915 <    if FCanTimeout then
1915 >    if not TransactionIntf.HasActivity then
1916      begin
1917        EndTransaction(FDefaultAction, True);
1918        if Assigned(FOnIdleTimer) then
1919          FOnIdleTimer(Self);
1920      end
1784    else
1785      FCanTimeout := True;
1921    end;
1922   end;
1923  
# Line 1795 | Line 1930 | procedure TIBTransaction.TRParamsChangin
1930   begin
1931    EnsureNotInTransaction;
1932    CheckNotInTransaction;
1933 +  FTransactionIntf := nil;
1934   end;
1935  
1936   { TIBBase }
# Line 1810 | Line 1946 | begin
1946    inherited Destroy;
1947   end;
1948  
1949 + procedure TIBBase.HandleException(Sender: TObject);
1950 + begin
1951 +  if assigned(Database) then
1952 +     Database.HandleException(Sender)
1953 +  else
1954 +     SysUtils.ShowException(ExceptObject,ExceptAddr);
1955 + end;
1956 +
1957 + procedure TIBBase.SetCursor;
1958 + begin
1959 +  if Assigned(Database) and not Database.SQLHourGlass then
1960 +     Exit;
1961 +  if assigned(IBGUIInterface) then
1962 +     IBGUIInterface.SetCursor;
1963 + end;
1964 +
1965 + procedure TIBBase.RestoreCursor;
1966 + begin
1967 +  if Assigned(Database) and not Database.SQLHourGlass then
1968 +     Exit;
1969 +  if assigned(IBGUIInterface) then
1970 +     IBGUIInterface.RestoreCursor;
1971 + end;
1972 +
1973   procedure TIBBase.CheckDatabase;
1974   begin
1975    if (FDatabase = nil) then
# Line 1824 | Line 1984 | begin
1984    FTransaction.CheckInTransaction;
1985   end;
1986  
1987 < function TIBBase.GetDBHandle: PISC_DB_HANDLE;
1988 < begin
1829 <  CheckDatabase;
1830 <  result := @FDatabase.Handle;
1831 < end;
1832 <
1833 < function TIBBase.GetTRHandle: PISC_TR_HANDLE;
1987 > procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1988 >  );
1989   begin
1990 <  CheckTransaction;
1991 <  result := @FTransaction.Handle;
1990 >  if assigned(FBeforeDatabaseConnect) then
1991 >    BeforeDatabaseConnect(self,DBParams,DBName);
1992   end;
1993  
1994   procedure TIBBase.DoAfterDatabaseConnect;
# Line 1862 | Line 2017 | begin
2017    SetTransaction(nil);
2018   end;
2019  
2020 < procedure TIBBase.DoBeforeTransactionEnd;
2020 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2021   begin
2022    if Assigned(BeforeTransactionEnd) then
2023 <    BeforeTransactionEnd(Self);
2023 >    BeforeTransactionEnd(Self,Action);
2024   end;
2025  
2026   procedure TIBBase.DoAfterTransactionEnd;
# Line 1881 | Line 2036 | begin
2036    FTransaction := nil;
2037   end;
2038  
2039 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2040 + begin
2041 +  if FTransaction <> nil then
2042 +    FTransaction.DoAfterExecQuery(Sender);
2043 + end;
2044 +
2045 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2046 + begin
2047 +  if FTransaction <> nil then
2048 +    FTransaction.DoAfterEdit(Sender);
2049 + end;
2050 +
2051 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2052 + begin
2053 +  if FTransaction <> nil then
2054 +    FTransaction.DoAfterDelete(Sender);
2055 + end;
2056 +
2057 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2058 + begin
2059 +  if FTransaction <> nil then
2060 +    FTransaction.DoAfterInsert(Sender);
2061 + end;
2062 +
2063 + procedure TIBBase.DoAfterPost(Sender: TObject);
2064 + begin
2065 +  if FTransaction <> nil then
2066 +    FTransaction.DoAfterPost(Sender);
2067 + end;
2068 +
2069   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2070   begin
2071    if (FDatabase <> nil) then
# Line 1913 | Line 2098 | end;
2098    parameter buffer, and return it and its length
2099    in DPB and DPBLength, respectively. }
2100  
2101 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2101 > function GenerateDPB(sl: TStrings): IDPB;
2102   var
2103 <  i, j, pval: Integer;
2103 >  i, j: Integer;
2104    DPBVal: UShort;
2105    ParamName, ParamValue: string;
2106   begin
2107 <  { The DPB is initially empty, with the exception that
1923 <    the DPB version must be the first byte of the string. }
1924 <  DPBLength := 1;
1925 <  DPB := Char(isc_dpb_version1);
2107 >  Result := FirebirdAPI.AllocateDPB;
2108  
2109    {Iterate through the textual database parameters, constructing
2110     a DPB on-the-fly }
# Line 1961 | Line 2143 | begin
2143        begin
2144          if DPBVal = isc_dpb_sql_dialect then
2145            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2146 <        DPB := DPB +
1965 <               Char(DPBVal) +
1966 <               Char(Length(ParamValue)) +
1967 <               ParamValue;
1968 <        Inc(DPBLength, 2 + Length(ParamValue));
2146 >        Result.Add(DPBVal).SetAsString(ParamValue);
2147        end;
2148 +
2149        isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2150        isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2151 <      begin
2152 <        DPB := DPB +
1974 <               Char(DPBVal) +
1975 <               #1 +
1976 <               Char(StrToInt(ParamValue));
1977 <        Inc(DPBLength, 3);
1978 <      end;
2151 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2152 >
2153        isc_dpb_sweep:
2154 <      begin
2155 <        DPB := DPB +
1982 <               Char(DPBVal) +
1983 <               #1 +
1984 <               Char(isc_dpb_records);
1985 <        Inc(DPBLength, 3);
1986 <      end;
2154 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2155 >
2156        isc_dpb_sweep_interval:
2157 <      begin
2158 <        pval := StrToInt(ParamValue);
1990 <        DPB := DPB +
1991 <               Char(DPBVal) +
1992 <               #4 +
1993 <               PChar(@pval)[0] +
1994 <               PChar(@pval)[1] +
1995 <               PChar(@pval)[2] +
1996 <               PChar(@pval)[3];
1997 <        Inc(DPBLength, 6);
1998 <      end;
2157 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2158 >
2159        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2160        isc_dpb_quit_log:
2161 <      begin
2002 <        DPB := DPB +
2003 <               Char(DPBVal) +
2004 <               #1 + #0;
2005 <        Inc(DPBLength, 3);
2006 <      end;
2161 >        Result.Add(DPBVal).SetAsByte(0);
2162        else
2163        begin
2164          if (DPBVal > 0) and
# Line 2021 | Line 2176 | end;
2176    of the transaction parameters, generate a transaction
2177    parameter buffer, and return it and its length in
2178    TPB and TPBLength, respectively. }
2179 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2179 > function GenerateTPB(sl: TStrings): ITPB;
2180   var
2181 <  i, j, TPBVal, ParamLength: Integer;
2181 >  i, j, TPBVal: Integer;
2182    ParamName, ParamValue: string;
2183   begin
2184 <  TPB := '';
2030 <  if (sl.Count = 0) then
2031 <    TPBLength := 0
2032 <  else
2033 <  begin
2034 <    TPBLength := sl.Count + 1;
2035 <    TPB := TPB + Char(isc_tpb_version3);
2036 <  end;
2184 >  Result := FirebirdAPI.AllocateTPB;
2185    for i := 0 to sl.Count - 1 do
2186    begin
2187      if (Trim(sl[i]) =  '') then
2040    begin
2041      Dec(TPBLength);
2188        Continue;
2189 <    end;
2189 >
2190      if (Pos('=', sl[i]) = 0) then {mbcs ok}
2191        ParamName := LowerCase(sl[i]) {mbcs ok}
2192      else
# Line 2064 | Line 2210 | begin
2210        isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2211        isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2212        isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2213 <        TPB := TPB + Char(TPBVal);
2213 >        Result.Add(TPBVal);
2214 >
2215        isc_tpb_lock_read, isc_tpb_lock_write:
2216 <      begin
2217 <        TPB := TPB + Char(TPBVal);
2071 <        { Now set the string parameter }
2072 <        ParamLength := Length(ParamValue);
2073 <        Inc(TPBLength, ParamLength + 1);
2074 <        TPB := TPB + Char(ParamLength) + ParamValue;
2075 <      end;
2216 >        Result.Add(TPBVal).SetAsString(ParamValue);
2217 >
2218        else
2219        begin
2220          if (TPBVal > 0) and

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines