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 33 by tony, Sat Jul 18 12:30:52 2015 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 <  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 +    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;
167    FCanTimeout: Boolean;
187      FSQLObjects: TList;
188      FTransactions: TList;
189      FDBName: TIBFileName;
190      FDBParams: TStrings;
191      FDBParamsChanged: Boolean;
173    FDPB: PChar;
174    FDPBLength: Short;
175    FHandle: TISC_DB_HANDLE;
176    FHandleIsShared: Boolean;
192      FOnIdleTimer: TNotifyEvent;
193      FDefaultTransaction: TIBTransaction;
194      FInternalTransaction: TIBTransaction;
180    FStreamedConnected: Boolean;
195      FTimer: TFPTimer;
196      FUserNames: TStringList;
197      FDataSets: TList;
198      FLoginCalled: boolean;
199 <    FCharSetSizes: array of integer;
199 >    FUseDefaultSystemCodePage: boolean;
200      procedure EnsureInactive;
201      function GetDBSQLDialect: Integer;
202      function GetSQLDialect: Integer;
# Line 192 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
195    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
212 <    function Login: Boolean;
200 <    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 228 | 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 236 | Line 249 | type
249      function IndexOfDBConst(st: String): Integer;
250      function TestConnected: Boolean;
251      procedure CheckDatabaseName;
239    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;
245    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;
249    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
250                                                      write SetDBParamByDPB;
261      property SQLObjectCount: Integer read GetSQLObjectCount;
262      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
253    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 267 | 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;
270    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 291 | Line 307 | type
307      FAfterPost: TNotifyEvent;
308      FAfterTransactionEnd: TNotifyEvent;
309      FBeforeTransactionEnd: TNotifyEvent;
294    FIBLoaded: Boolean;
295    FCanTimeout         : Boolean;
310      FDatabases          : TList;
311      FOnStartTransaction: TNotifyEvent;
312      FSQLObjects         : TList;
313      FDefaultDatabase    : TIBDatabase;
300    FHandle             : TISC_TR_HANDLE;
301    FHandleIsShared     : Boolean;
314      FOnIdleTimer          : TNotifyEvent;
315      FStreamedActive     : Boolean;
316 <    FTPB                : PChar;
305 <    FTPBLength          : Short;
316 >    FTPB                : ITPB;
317      FTimer              : TFPTimer;
318 <    FDefaultAction      : TTransactionAction;
318 >    FDefaultAction      : TDefaultEndAction;
319      FTRParams           : TStrings;
320      FTRParamsChanged    : Boolean;
321      FInEndTransaction   : boolean;
# Line 327 | Line 338 | type
338      function GetIdleTimer: Integer;
339      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340      procedure SetActive(Value: Boolean);
330    procedure SetDefaultAction(Value: TTransactionAction);
341      procedure SetDefaultDatabase(Value: TIBDatabase);
342      procedure SetIdleTimer(Value: Integer);
343      procedure SetTRParams(Value: TStrings);
# Line 340 | Line 350 | type
350  
351    protected
352      procedure Loaded; override;
343    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;
349    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358      procedure Commit;
359      procedure CommitRetaining;
360      procedure Rollback;
# Line 367 | 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;
370    property Handle: TISC_TR_HANDLE read FHandle;
371    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 428 | Line 434 | type
434      procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435      procedure DoAfterTransactionEnd; virtual;
436      procedure DoTransactionFree; virtual;
431    function GetDBHandle: PISC_DB_HANDLE; virtual;
432    function GetTRHandle: PISC_TR_HANDLE; virtual;
437      procedure SetDatabase(Value: TIBDatabase); virtual;
438      procedure SetTransaction(Value: TIBTransaction); virtual;
439    public
# Line 442 | Line 446 | type
446      procedure DoAfterDelete(Sender: TObject); virtual;
447      procedure DoAfterInsert(Sender: TObject); virtual;
448      procedure DoAfterPost(Sender: TObject); virtual;
445    function GetCharSetSize(CharSetID: integer): integer;
449      procedure HandleException(Sender: TObject);
450      procedure SetCursor;
451      procedure RestoreCursor;
# Line 461 | Line 464 | type
464      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465      property Database: TIBDatabase read FDatabase
466                                      write SetDatabase;
464    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467      property Owner: TObject read FOwner;
466    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, RegExpr;
480  
481   { TIBDatabase }
482  
483 < constructor TIBDataBase.Create(AOwner: TComponent);
483 < {$ifdef WINDOWS}
484 < var acp: uint;
485 < {$endif}
483 > constructor TIBDataBase.Create(AOwner: TComponent);
484   begin
485    inherited Create(AOwner);
488  FIBLoaded := False;
489  CheckIBLoaded;
490  FIBLoaded := True;
486    LoginPrompt := True;
487    FSQLObjects := TList.Create;
488    FTransactions := TList.Create;
# Line 498 | Line 493 | begin
493       (AOwner is TCustomApplication) and
494       TCustomApplication(AOWner).ConsoleApplication then
495      LoginPrompt := false;
501  {$ifdef UNIX}
502  if csDesigning in ComponentState then
503    FDBParams.Add('lc_ctype=UTF8');
504  {$else}
505  {$ifdef WINDOWS}
506  if csDesigning in ComponentState then
507  begin
508    acp := GetACP;
509    if (acp >= 1250) and (acp <= 1254) then
510      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
511  end;
512  {$endif}
513  {$endif}
496    FDBParamsChanged := True;
497    TStringList(FDBParams).OnChange := DBParamsChange;
498    TStringList(FDBParams).OnChanging := DBParamsChanging;
499    FDPB := nil;
518  FHandle := nil;
500    FUserNames := nil;
501    FInternalTransaction := TIBTransaction.Create(self);
502    FInternalTransaction.DefaultDatabase := Self;
# Line 530 | 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;
551 <    FSQLObjects.Free;
552 <    FUserNames.Free;
553 <    FTransactions.Free;
554 <  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  
559 function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
560   ): ISC_STATUS;
561 begin
562  result := ErrCode;
563  FCanTimeout := False;
564  if RaiseError and (ErrCode > 0) then
565    IBDataBaseError;
566 end;
567
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 577 | 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 629 | Line 597 | begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
600 <  SetLength(FCharSetSizes,0);
600 >  FDefaultCharSetName := '';
601 >  FDefaultCharSetID := 0;
602 >  FDefaultCodePage := CP_NONE;
603   end;
604  
605 < procedure TIBDataBase.CreateDatabase;
636 < var
637 <  tr_handle: TISC_TR_HANDLE;
605 >  procedure TIBDataBase.CreateDatabase;
606   begin
607    CheckInactive;
608 <  tr_handle := nil;
609 <  Call(
610 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
611 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
612 <                               Params.Text), SQLDialect, nil),
613 <    True);
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 >  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;
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);
# Line 701 | Line 686 | end;
686  
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;
# Line 718 | Line 703 | begin
703      Inc(result);
704   end;
705  
706 < function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
722 < var
723 <  ConstIdx, EqualsIdx: Integer;
724 < begin
725 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
726 <  begin
727 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
728 <    if ConstIdx = -1 then
729 <      result := ''
730 <    else
731 <    begin
732 <      result := Params[ConstIdx];
733 <      EqualsIdx := Pos('=', result); {mbcs ok}
734 <      if EqualsIdx = 0 then
735 <        result := ''
736 <      else
737 <        result := Copy(result, EqualsIdx + 1, Length(result));
738 <    end;
739 <  end
740 <  else
741 <    result := '';
742 < end;
743 <
744 < function TIBDataBase.GetIdleTimer: Integer;
706 > function TIBDataBase.GetIdleTimer: Integer;
707   begin
708    result := FTimer.Interval;
709   end;
# Line 806 | Line 768 | begin
768      end;
769    end;
770  
771 <  if (not HandleIsShared) and
772 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
811 <     (not Force) then
812 <    IBDataBaseError
813 <  else
814 <  begin
815 <    FHandle := nil;
816 <    FHandleIsShared := False;
817 <  end;
771 >  FAttachment.Disconnect(Force);
772 >  FAttachment := nil;
773  
774    if not (csDesigning in ComponentState) then
775      MonitorHook.DBDisconnect(Self);
# Line 824 | Line 779 | begin
779        SQLObjects[i].DoAfterDatabaseDisconnect;
780   end;
781  
827 procedure TIBDataBase.LoadCharSetInfo;
828 var Query: TIBSQL;
829    i: integer;
830 begin
831  if not FInternalTransaction.Active then
832    FInternalTransaction.StartTransaction;
833  Query := TIBSQL.Create(self);
834  try
835    Query.Database := Self;
836    Query.Transaction := FInternalTransaction;
837    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
838                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
839    Query.Prepare;
840    Query.ExecQuery;
841    if not Query.EOF then
842    begin
843      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
844      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
845      repeat
846        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
847                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
848        Query.Next;
849      until Query.EOF;
850    end;
851  finally
852    Query.free;
853    FInternalTransaction.Commit;
854  end;
855 end;
856
782   procedure TIBDataBase.CheckStreamConnect;
783   var
784    i: integer;
# Line 876 | 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
# Line 917 | 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 953 | 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;
# Line 974 | Line 900 | begin
900                                           Length(Params[IndexOfPassword]));
901        OldPassword := password;
902      end;
903 <    result := IBGUIInterface.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 1002 | Line 935 | end;
935  
936   procedure TIBDataBase.DoConnect;
937   var
1005  DPB: String;
938    TempDBParams: TStrings;
939    I: integer;
940    aDBName: string;
941 +  Status: IStatus;
942 +  CharSetID: integer;
943   begin
944    CheckInactive;
945    CheckDatabaseName;
# Line 1015 | 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  
956    TempDBParams := TStringList.Create;
957    try
958     TempDBParams.Assign(FDBParams);
959 <   aDBName := FDBName;
960 <   {Opportuning to override defaults}
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 <       GenerateDPB(TempDBParams, DPB, FDPBLength)
984 >       FDPB := GenerateDPB(TempDBParams)
985       else
986       begin
987          TempDBParams.Add('password=' + FHiddenPassword);
988 <        GenerateDPB(TempDBParams, DPB, FDPBLength);
988 >        FDPB := GenerateDPB(TempDBParams);
989       end;
1043     IBAlloc(FDPB, 0, FDPBLength);
1044     Move(DPB[1], FDPB[0], FDPBLength);
990     end;
991    finally
992     TempDBParams.Free;
993    end;
994 <  if Call(isc_attach_database(StatusVector, Length(aDBName),
995 <                         PChar(aDBName), @FHandle,
996 <                         FDPBLength, FDPB), False) > 0 then
997 <  begin
998 <    FHandle := nil;
999 <    IBDataBaseError;
1000 <  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 >      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 >  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;
# Line 1064 | Line 1045 | begin
1045    end;
1046    if not (csDesigning in ComponentState) then
1047      MonitorHook.DBConnect(Self);
1067  LoadCharSetInfo;
1048   end;
1049  
1050   procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
# Line 1167 | Line 1147 | begin
1147    FDefaultTransaction := Value;
1148   end;
1149  
1170 procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1171 begin
1172  if HandleIsShared then
1173    Close
1174  else
1175    CheckInactive;
1176  FHandle := Value;
1177  FHandleIsShared := (Value <> nil);
1178 end;
1179
1150   procedure TIBDataBase.SetIdleTimer(Value: Integer);
1151   begin
1152    if Value < 0 then
# Line 1221 | Line 1191 | end;
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
1230    else
1231      FCanTimeout := True;
1200    end;
1201   end;
1202  
# Line 1259 | Line 1227 | end;
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]);
# Line 1378 | 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 1418 | 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 1436 | Line 1404 | end;
1404   constructor TIBTransaction.Create(AOwner: TComponent);
1405   begin
1406    inherited Create(AOwner);
1439  FIBLoaded := False;
1440  CheckIBLoaded;
1441  FIBLoaded := True;
1442  CheckIBLoaded;
1407    FDatabases := TList.Create;
1408    FSQLObjects := TList.Create;
1445  FHandle := nil;
1409    FTPB := nil;
1447  FTPBLength := 0;
1410    FTRParams := TStringList.Create;
1411    FTRParamsChanged := True;
1412    TStringList(FTRParams).OnChange := TRParamsChange;
# Line 1460 | 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;
1474 <    FTRParams.Free;
1475 <    FSQLObjects.Free;
1476 <    FDatabases.Free;
1477 <  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  
1481 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1482  RaiseError: Boolean): ISC_STATUS;
1483 var
1484  i: Integer;
1485 begin
1486  result := ErrCode;
1487  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1488    Databases[i].FCanTimeout := False;
1489  FCanTimeout := False;
1490  if RaiseError and (result > 0) then
1491    IBDataBaseError;
1492 end;
1493
1439   procedure TIBTransaction.CheckDatabasesInList;
1440   begin
1441    if GetDatabaseCount = 0 then
# Line 1501 | 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  
# Line 1557 | Line 1502 | procedure TIBTransaction.EnsureNotInTran
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 1573 | 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 1623 | Line 1572 | end;
1572   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1573    Force: Boolean);
1574   var
1626  status: ISC_STATUS;
1575    i: Integer;
1576   begin
1577    CheckInTransaction;
# Line 1634 | Line 1582 | begin
1582    case Action of
1583      TARollback, TACommit:
1584      begin
1637      if (HandleIsShared) and
1638         (Action <> FDefaultAction) and
1639         (not Force) then
1640        IBError(ibxeCantEndSharedTransaction, [nil]);
1585        DoBeforeTransactionEnd;
1586        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1587          SQLObjects[i].DoBeforeTransactionEnd(Action);
1588        if InTransaction then
1589        begin
1590 <        if HandleIsShared then
1591 <        begin
1648 <          FHandle := nil;
1649 <          FHandleIsShared := False;
1650 <          status := 0;
1651 <        end
1652 <        else
1653 <          if (Action = TARollback) then
1654 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1655 <          else
1656 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1657 <        if ((Force) and (status > 0)) then
1658 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1659 <        if Force then
1660 <          FHandle := nil
1590 >        if (Action = TARollback) then
1591 >            FTransactionIntf.Rollback(Force)
1592          else
1593 <          if (status > 0) then
1594 <            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 1721 | 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 1777 | 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 1785 | 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 1797 | 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 1843 | Line 1793 | begin
1793          Rollback;
1794   end;
1795  
1846 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1847 begin
1848 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1849    IBError(ibxeIB60feature, [nil]);*)
1850  FDefaultAction := Value;
1851 end;
1852
1796   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1797   var
1798    i: integer;
# Line 1872 | Line 1815 | begin
1815    FDefaultDatabase := Value;
1816   end;
1817  
1875 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1876 begin
1877  if (HandleIsShared) then
1878    EndTransaction(DefaultAction, True)
1879  else
1880    CheckNotInTransaction;
1881  FHandle := Value;
1882  FHandleIsShared := (Value <> nil);
1883 end;
1884
1818   procedure TIBTransaction.Notification( AComponent: TComponent;
1819                                          Operation: TOperation);
1820   var
# Line 1923 | Line 1856 | end;
1856  
1857   procedure TIBTransaction.StartTransaction;
1858   var
1926  pteb: PISC_TEB_ARRAY;
1927  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 1945 | Line 1884 | begin
1884    if FTRParamsChanged then
1885    begin
1886      FTRParamsChanged := False;
1887 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1949 <    if FTPBLength > 0 then
1950 <    begin
1951 <      IBAlloc(FTPB, 0, FTPBLength);
1952 <      Move(TPB[1], FTPB[0], FTPBLength);
1953 <    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;
1970 <    end;
1971 <    if not (csDesigning in ComponentState) then
1972 <      MonitorHook.TRStart(Self);
1973 <  finally
1974 <    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  
# Line 1980 | Line 1912 | procedure TIBTransaction.TimeoutTransact
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
1989    else
1990      FCanTimeout := True;
1921    end;
1922   end;
1923  
# Line 2000 | Line 1930 | procedure TIBTransaction.TRParamsChangin
1930   begin
1931    EnsureNotInTransaction;
1932    CheckNotInTransaction;
1933 +  FTransactionIntf := nil;
1934   end;
1935  
1936   { TIBBase }
# Line 2015 | Line 1946 | begin
1946    inherited Destroy;
1947   end;
1948  
2018 function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2019 begin
2020  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2021    Result := Database.FCharSetSizes[CharSetID]
2022  else
2023    Result := 1; {Unknown character set}
2024 end;
2025
1949   procedure TIBBase.HandleException(Sender: TObject);
1950   begin
1951    if assigned(Database) then
# Line 2061 | Line 1984 | begin
1984    FTransaction.CheckInTransaction;
1985   end;
1986  
2064 function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2065 begin
2066  CheckDatabase;
2067  result := @FDatabase.Handle;
2068 end;
2069
2070 function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2071 begin
2072  CheckTransaction;
2073  result := @FTransaction.Handle;
2074 end;
2075
1987   procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1988    );
1989   begin
# Line 2187 | 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
2197 <    the DPB version must be the first byte of the string. }
2198 <  DPBLength := 1;
2199 <  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 2235 | Line 2143 | begin
2143        begin
2144          if DPBVal = isc_dpb_sql_dialect then
2145            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2146 <        DPB := DPB +
2239 <               Char(DPBVal) +
2240 <               Char(Length(ParamValue)) +
2241 <               ParamValue;
2242 <        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 +
2248 <               Char(DPBVal) +
2249 <               #1 +
2250 <               Char(StrToInt(ParamValue));
2251 <        Inc(DPBLength, 3);
2252 <      end;
2151 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2152 >
2153        isc_dpb_sweep:
2154 <      begin
2155 <        DPB := DPB +
2256 <               Char(DPBVal) +
2257 <               #1 +
2258 <               Char(isc_dpb_records);
2259 <        Inc(DPBLength, 3);
2260 <      end;
2154 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2155 >
2156        isc_dpb_sweep_interval:
2157 <      begin
2158 <        pval := StrToInt(ParamValue);
2264 <        DPB := DPB +
2265 <               Char(DPBVal) +
2266 <               #4 +
2267 <               PChar(@pval)[0] +
2268 <               PChar(@pval)[1] +
2269 <               PChar(@pval)[2] +
2270 <               PChar(@pval)[3];
2271 <        Inc(DPBLength, 6);
2272 <      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
2276 <        DPB := DPB +
2277 <               Char(DPBVal) +
2278 <               #1 + #0;
2279 <        Inc(DPBLength, 3);
2280 <      end;
2161 >        Result.Add(DPBVal).SetAsByte(0);
2162        else
2163        begin
2164          if (DPBVal > 0) and
# Line 2295 | 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 := '';
2304 <  if (sl.Count = 0) then
2305 <    TPBLength := 0
2306 <  else
2307 <  begin
2308 <    TPBLength := sl.Count + 1;
2309 <    TPB := TPB + Char(isc_tpb_version3);
2310 <  end;
2184 >  Result := FirebirdAPI.AllocateTPB;
2185    for i := 0 to sl.Count - 1 do
2186    begin
2187      if (Trim(sl[i]) =  '') then
2314    begin
2315      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 2338 | 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);
2345 <        { Now set the string parameter }
2346 <        ParamLength := Length(ParamValue);
2347 <        Inc(TPBLength, ParamLength + 1);
2348 <        TPB := TPB + Char(ParamLength) + ParamValue;
2349 <      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