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 44 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

# Line 35 | Line 35 | unit IBDatabase;
35  
36   {$Mode Delphi}
37  
38 {$IF FPC_FULLVERSION >= 20700 }
38   {$codepage UTF8}
40 {$DEFINE HAS_ANSISTRING_CODEPAGE}
41 {$ENDIF}
39  
40   interface
41  
# Line 48 | Line 45 | uses
45   {$ELSE}
46    unix,
47   {$ENDIF}
48 <  SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
52 <  IB, CustApp;
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49  
50   const
51    DPBPrefix = 'isc_dpb_';
# Line 120 | Line 116 | const
116      'set_db_readonly',
117      'set_db_sql_dialect',
118      'gfix_attach',
119 <    'gstat_attach'
119 >    'gstat_attach',
120 >    'set_db_charset',
121 >    'gsec_attach',
122 >    'address_path' ,
123 >    'process_id',
124 >    'no_db_triggers',
125 >    'trusted_auth',
126 >    'process_name',
127 >    'trusted_role',
128 >    'org_filename',
129 >    'utf8_ilename',
130 >    'ext_call_depth'
131    );
132  
133    TPBPrefix = 'isc_tpb_';
# Line 144 | Line 151 | const
151      'rec_version',
152      'no_rec_version',
153      'restart_requests',
154 <    'no_auto_undo'
154 >    'no_auto_undo',
155 >    'lock_timeout'
156    );
157  
158   type
# Line 160 | Line 168 | type
168    { TIBDatabase }
169    TIBDataBase = class(TCustomConnection)
170    private
171 +    FAttachment: IAttachment;
172 +    FCreateDatabase: boolean;
173 +    FCreateIfNotExists: boolean;
174 +    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;
172    FCanTimeout: Boolean;
187      FSQLObjects: TList;
188      FTransactions: TList;
189      FDBName: TIBFileName;
190      FDBParams: TStrings;
191      FDBParamsChanged: Boolean;
178    FDPB: PChar;
179    FDPBLength: Short;
180    FHandle: TISC_DB_HANDLE;
181    FHandleIsShared: Boolean;
192      FOnIdleTimer: TNotifyEvent;
193      FDefaultTransaction: TIBTransaction;
194      FInternalTransaction: TIBTransaction;
185    FStreamedConnected: Boolean;
195      FTimer: TFPTimer;
196      FUserNames: TStringList;
197      FDataSets: TList;
198      FLoginCalled: boolean;
190    FDefaultCharSetName: RawByteString;
191    FDefaultCharSetID: integer;
192    {$IFDEF HAS_ANSISTRING_CODEPAGE}
193    FDefaultCodePage: TSystemCodePage;
194    {$ENDIF}
199      FUseDefaultSystemCodePage: boolean;
200      procedure EnsureInactive;
201      function GetDBSQLDialect: Integer;
# Line 202 | Line 206 | type
206      procedure DBParamsChanging(Sender: TObject);
207      function GetSQLObject(Index: Integer): TIBBase;
208      function GetSQLObjectCount: Integer;
205    function GetDBParamByDPB(const Idx: Integer): String;
209      function GetIdleTimer: Integer;
210      function GetTransaction(Index: Integer): TIBTransaction;
211      function GetTransactionCount: Integer;
# Line 245 | Line 248 | type
248      function IndexOfDBConst(st: String): Integer;
249      function TestConnected: Boolean;
250      procedure CheckDatabaseName;
248    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
251      function AddTransaction(TR: TIBTransaction): Integer;
252      function FindTransaction(TR: TIBTransaction): Integer;
253      function FindDefaultTransaction(): TIBTransaction;
254      procedure RemoveTransaction(Idx: Integer);
255      procedure RemoveTransactions;
254    procedure SetHandle(Value: TISC_DB_HANDLE);
256  
257 <    property Handle: TISC_DB_HANDLE read FHandle;
257 >    property Attachment: IAttachment read FAttachment;
258 >    property DBSQLDialect : Integer read FDBSQLDialect;
259      property IsReadOnly: Boolean read GetIsReadOnly;
258    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
259                                                      write SetDBParamByDPB;
260      property SQLObjectCount: Integer read GetSQLObjectCount;
261      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
262    property HandleIsShared: Boolean read FHandleIsShared;
262      property TransactionCount: Integer read GetTransactionCount;
263      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
264      property InternalTransaction: TIBTransaction read FInternalTransaction;
265      property DefaultCharSetName: RawByteString read FDefaultCharSetName;
266      property DefaultCharSetID: integer read FDefaultCharSetID;
268    {$IFDEF HAS_ANSISTRING_CODEPAGE}
267      property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
270    {$ENDIF}
268  
269    published
270      property Connected;
271 +    property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
272      property AllowStreamedConnected: boolean read FAllowStreamedConnected
273               write FAllowStreamedConnected;
274      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
# Line 281 | Line 279 | type
279      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
280      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
281      property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
284    property DBSQLDialect : Integer read FDBSQLDialect;
282      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
283      property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
284                                                 write FUseDefaultSystemCodePage;
# Line 289 | Line 286 | type
286      property AfterDisconnect;
287      property BeforeConnect;
288      property BeforeDisconnect;
289 +    property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
290      property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
291      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
292      property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
293    end;
294  
295 <  { TIBTransaction }
295 >  TDefaultEndAction = TARollback..TACommit;
296  
297 <  TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
297 >  { TIBTransaction }
298  
299    TIBTransaction = class(TComponent)
300    private
301 +    FTransactionIntf: ITransaction;
302      FAfterDelete: TNotifyEvent;
303      FAfterEdit: TNotifyEvent;
304      FAfterExecQuery: TNotifyEvent;
# Line 307 | Line 306 | type
306      FAfterPost: TNotifyEvent;
307      FAfterTransactionEnd: TNotifyEvent;
308      FBeforeTransactionEnd: TNotifyEvent;
310    FIBLoaded: Boolean;
311    FCanTimeout         : Boolean;
309      FDatabases          : TList;
310      FOnStartTransaction: TNotifyEvent;
311      FSQLObjects         : TList;
312      FDefaultDatabase    : TIBDatabase;
316    FHandle             : TISC_TR_HANDLE;
317    FHandleIsShared     : Boolean;
313      FOnIdleTimer          : TNotifyEvent;
314      FStreamedActive     : Boolean;
315 <    FTPB                : PChar;
321 <    FTPBLength          : Short;
315 >    FTPB                : ITPB;
316      FTimer              : TFPTimer;
317 <    FDefaultAction      : TTransactionAction;
317 >    FDefaultAction      : TDefaultEndAction;
318      FTRParams           : TStrings;
319      FTRParamsChanged    : Boolean;
320      FInEndTransaction   : boolean;
# Line 343 | Line 337 | type
337      function GetIdleTimer: Integer;
338      procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
339      procedure SetActive(Value: Boolean);
346    procedure SetDefaultAction(Value: TTransactionAction);
340      procedure SetDefaultDatabase(Value: TIBDatabase);
341      procedure SetIdleTimer(Value: Integer);
342      procedure SetTRParams(Value: TStrings);
# Line 356 | Line 349 | type
349  
350    protected
351      procedure Loaded; override;
359    procedure SetHandle(Value: TISC_TR_HANDLE);
352      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
353  
354    public
355      constructor Create(AOwner: TComponent); override;
356      destructor Destroy; override;
365    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
357      procedure Commit;
358      procedure CommitRetaining;
359      procedure Rollback;
# Line 383 | Line 374 | type
374      property Databases[Index: Integer]: TIBDatabase read GetDatabase;
375      property SQLObjectCount: Integer read GetSQLObjectCount;
376      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
386    property Handle: TISC_TR_HANDLE read FHandle;
387    property HandleIsShared: Boolean read FHandleIsShared;
377      property InTransaction: Boolean read GetInTransaction;
378 <    property TPB: PChar read FTPB;
379 <    property TPBLength: Short read FTPBLength;
378 >    property TransactionIntf: ITransaction read FTransactionIntf;
379 >    property TPB: ITPB read FTPB;
380    published
381      property Active: Boolean read GetInTransaction write SetActive;
382      property DefaultDatabase: TIBDatabase read FDefaultDatabase
383                                             write SetDefaultDatabase;
384      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
385 <    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
385 >    property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
386      property Params: TStrings read FTRParams write SetTRParams;
387      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
388      property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
# Line 444 | Line 433 | type
433      procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
434      procedure DoAfterTransactionEnd; virtual;
435      procedure DoTransactionFree; virtual;
447    function GetDBHandle: PISC_DB_HANDLE; virtual;
448    function GetTRHandle: PISC_TR_HANDLE; virtual;
436      procedure SetDatabase(Value: TIBDatabase); virtual;
437      procedure SetTransaction(Value: TIBTransaction); virtual;
438    public
# Line 458 | Line 445 | type
445      procedure DoAfterDelete(Sender: TObject); virtual;
446      procedure DoAfterInsert(Sender: TObject); virtual;
447      procedure DoAfterPost(Sender: TObject); virtual;
461    function GetDefaultCharSetName: RawByteString;
462    function GetDefaultCharSetID: cardinal;
448      procedure HandleException(Sender: TObject);
449      procedure SetCursor;
450      procedure RestoreCursor;
# Line 478 | Line 463 | type
463      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
464      property Database: TIBDatabase read FDatabase
465                                      write SetDatabase;
481    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
466      property Owner: TObject read FOwner;
483    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
467      property Transaction: TIBTransaction read FTransaction
468                                            write SetTransaction;
469    end;
470  
471 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
472 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
471 > function GenerateDPB(sl: TStrings): IDPB;
472 > function GenerateTPB(sl: TStrings): ITPB;
473  
474  
475   implementation
476  
477 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478 <     typInfo, IBCodePage;
477 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478 >     typInfo, FBMessages, IBErrorCodes;
479  
480   { TIBDatabase }
481  
482   constructor TIBDataBase.Create(AOwner: TComponent);
483   begin
484    inherited Create(AOwner);
502  FIBLoaded := False;
503  CheckIBLoaded;
504  FIBLoaded := True;
485    LoginPrompt := True;
486    FSQLObjects := TList.Create;
487    FTransactions := TList.Create;
# Line 512 | Line 492 | begin
492       (AOwner is TCustomApplication) and
493       TCustomApplication(AOWner).ConsoleApplication then
494      LoginPrompt := false;
515  {$IFDEF HAS_ANSISTRING_CODEPAGE}
516  FDefaultCodePage := CP_NONE;
517  {$ENDIF}
495    FDBParamsChanged := True;
496    TStringList(FDBParams).OnChange := DBParamsChange;
497    TStringList(FDBParams).OnChanging := DBParamsChanging;
498    FDPB := nil;
522  FHandle := nil;
499    FUserNames := nil;
500    FInternalTransaction := TIBTransaction.Create(self);
501    FInternalTransaction.DefaultDatabase := Self;
# Line 534 | Line 510 | begin
510    CheckStreamConnect;
511   end;
512  
513 < destructor TIBDataBase.Destroy;
513 > destructor TIBDataBase.Destroy;
514   var
515    i: Integer;
516   begin
517 <  if FIBLoaded then
518 <  begin
519 <    IdleTimer := 0;
520 <    if FHandle <> nil then
521 <      ForceClose;
522 <    for i := 0 to FSQLObjects.Count - 1 do
523 <      if FSQLObjects[i] <> nil then
524 <        SQLObjects[i].DoDatabaseFree;
525 <    RemoveSQLObjects;
526 <    RemoveTransactions;
527 <    FInternalTransaction.Free;
528 <    FreeMem(FDPB);
529 <    FDPB := nil;
530 <    FDBParams.Free;
555 <    FSQLObjects.Free;
556 <    FUserNames.Free;
557 <    FTransactions.Free;
558 <  end;
517 >  IdleTimer := 0;
518 >  if FAttachment <> nil then
519 >    ForceClose;
520 >  for i := 0 to FSQLObjects.Count - 1 do
521 >    if FSQLObjects[i] <> nil then
522 >      SQLObjects[i].DoDatabaseFree;
523 >  RemoveSQLObjects;
524 >  RemoveTransactions;
525 >  FInternalTransaction.Free;
526 >  FDPB := nil;
527 >  FDBParams.Free;
528 >  FSQLObjects.Free;
529 >  FUserNames.Free;
530 >  FTransactions.Free;
531    FDataSets.Free;
532    inherited Destroy;
533   end;
534  
563 function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
564   ): ISC_STATUS;
565 begin
566  result := ErrCode;
567  FCanTimeout := False;
568  if RaiseError and (ErrCode > 0) then
569    IBDataBaseError;
570 end;
571
535   procedure TIBDataBase.CheckActive;
536   begin
537    if StreamedConnected and (not Connected) then
538      Loaded;
539 <  if FHandle = nil then
539 >  if FAttachment = nil then
540      IBError(ibxeDatabaseClosed, [nil]);
541   end;
542  
# Line 581 | Line 544 | end;
544   begin
545    if csDesigning in ComponentState then
546    begin
547 <    if FHandle <> nil then
547 >    if FAttachment <> nil then
548        Close;
549    end
550   end;
551  
552   procedure TIBDataBase.CheckInactive;
553   begin
554 <  if FHandle <> nil then
554 >  if FAttachment <> nil then
555      IBError(ibxeDatabaseOpen, [nil]);
556   end;
557  
# Line 635 | Line 598 | begin
598    FDBSQLDialect := 1;
599    FDefaultCharSetName := '';
600    FDefaultCharSetID := 0;
638  {$IFDEF HAS_ANSISTRING_CODEPAGE}
601    FDefaultCodePage := CP_NONE;
640  {$ENDIF}
602   end;
603  
604 < procedure TIBDataBase.CreateDatabase;
644 < var
645 <  tr_handle: TISC_TR_HANDLE;
604 >  procedure TIBDataBase.CreateDatabase;
605   begin
606    CheckInactive;
607 <  tr_handle := nil;
608 <  Call(
609 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
651 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
652 <                               Params.Text), SQLDialect, nil),
653 <    True);
607 >  CheckDatabaseName;
608 >  FCreateDatabase := true;
609 >  Connected := true;
610   end;
611  
612   procedure TIBDataBase.DropDatabase;
613   begin
614    CheckActive;
615 <  Call(isc_drop_database(StatusVector, @FHandle), True);
615 >  FAttachment.DropDatabase;
616 >  FAttachment := nil;
617   end;
618  
619   procedure TIBDataBase.DBParamsChange(Sender: TObject);
# Line 709 | Line 666 | end;
666  
667   function TIBDataBase.GetConnected: Boolean;
668   begin
669 <  result := FHandle <> nil;
669 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
670   end;
671  
672   function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
# Line 726 | Line 683 | begin
683      Inc(result);
684   end;
685  
686 < function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
730 < var
731 <  ConstIdx, EqualsIdx: Integer;
732 < begin
733 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
734 <  begin
735 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
736 <    if ConstIdx = -1 then
737 <      result := ''
738 <    else
739 <    begin
740 <      result := Params[ConstIdx];
741 <      EqualsIdx := Pos('=', result); {mbcs ok}
742 <      if EqualsIdx = 0 then
743 <        result := ''
744 <      else
745 <        result := Copy(result, EqualsIdx + 1, Length(result));
746 <    end;
747 <  end
748 <  else
749 <    result := '';
750 < end;
751 <
752 < function TIBDataBase.GetIdleTimer: Integer;
686 > function TIBDataBase.GetIdleTimer: Integer;
687   begin
688    result := FTimer.Interval;
689   end;
# Line 814 | Line 748 | begin
748      end;
749    end;
750  
751 <  if (not HandleIsShared) and
752 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
819 <     (not Force) then
820 <    IBDataBaseError
821 <  else
822 <  begin
823 <    FHandle := nil;
824 <    FHandleIsShared := False;
825 <  end;
751 >  FAttachment.Disconnect(Force);
752 >  FAttachment := nil;
753  
754    if not (csDesigning in ComponentState) then
755      MonitorHook.DBDisconnect(Self);
# Line 854 | Line 781 | begin
781           (FDefaultTransaction.FStreamedActive) and
782           (not FDefaultTransaction.InTransaction) then
783          FDefaultTransaction.StartTransaction;
784 <      FStreamedConnected := False;
784 >      StreamedConnected := False;
785      end;
786    except
787      if csDesigning in ComponentState then
# Line 895 | Line 822 | begin
822    end;
823   end;
824  
825 <  function TIBDataBase.Login(var aDatabaseName: string): Boolean;
825 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
826   var
827    IndexOfUser, IndexOfPassword: Integer;
828    Username, Password, OldPassword: String;
# Line 953 | Line 880 | begin
880                                           Length(Params[IndexOfPassword]));
881        OldPassword := password;
882      end;
883 +
884      result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
885      if result then
886      begin
887 <      if IndexOfUser = -1 then
888 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
889 <      else
890 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
887 >      if Username <> '' then
888 >      begin
889 >        if IndexOfUser = -1 then
890 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
891 >        else
892 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
893                                   '=' + Username;
894 +      end
895 +      else
896 +      if IndexOfUser <> -1 then
897 +        Params.Delete(IndexOfUser);
898        if (Password = OldPassword) then
899          FHiddenPassword := ''
900        else
# Line 981 | Line 915 | end;
915  
916   procedure TIBDataBase.DoConnect;
917   var
984  DPB: String;
918    TempDBParams: TStrings;
919    I: integer;
920    aDBName: string;
921 <
989 <  {Call error analysis}
990 <  sqlcode: Long;
991 <  IBErrorCode: Long;
992 <  status_vector: PISC_STATUS;
921 >  Status: IStatus;
922    CharSetID: integer;
923   begin
924    CheckInactive;
# Line 1009 | Line 938 | begin
938     TempDBParams.Assign(FDBParams);
939     if UseDefaultSystemCodePage then
940     begin
1012     {$IFDEF HAS_ANSISTRING_CODEPAGE}
941       {$ifdef WINDOWS}
942 <     if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then
943 <       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1016 <     else
942 >     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
943 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
944       {$else}
945 <     if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946 <       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1020 <     else
945 >     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
947       {$endif}
948 <     {$ENDIF}
949 <     TempDBParams.Values['lc_ctype'] :='UTF8';
948 >     else
949 >       TempDBParams.Values['lc_ctype'] :='UTF8';
950     end;
951     {Opportunity to override defaults}
952     for i := 0 to FSQLObjects.Count - 1 do
# Line 1028 | Line 954 | begin
954         if FSQLObjects[i] <> nil then
955           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
956     end;
957 +
958     FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
959     if FDefaultCharSetName <> '' then
960 <     TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
961 <   {$IFDEF HAS_ANSISTRING_CODEPAGE}
1035 <   TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036 <   {$ENDIF}
960 >     FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
961 >   FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
962     { Generate a new DPB if necessary }
963     if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
964     begin
965       FDBParamsChanged := False;
966       if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
967 <       GenerateDPB(TempDBParams, DPB, FDPBLength)
967 >       FDPB := GenerateDPB(TempDBParams)
968       else
969       begin
970          TempDBParams.Add('password=' + FHiddenPassword);
971 <        GenerateDPB(TempDBParams, DPB, FDPBLength);
971 >        FDPB := GenerateDPB(TempDBParams);
972       end;
1048     IBAlloc(FDPB, 0, FDPBLength);
1049     Move(DPB[1], FDPB[0], FDPBLength);
973     end;
974    finally
975     TempDBParams.Free;
976    end;
977 +
978    repeat
979 <    if Call(isc_attach_database(StatusVector, Length(aDBName),
980 <                         PChar(aDBName), @FHandle,
981 <                         FDPBLength, FDPB), False) > 0 then
979 >    if FCreateDatabase then
980 >    begin
981 >      FCreateDatabase := false;
982 >      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
983 >      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
984 >        OnCreateDatabase(self);
985 >    end
986 >    else
987 >      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
988 >    if FAttachment = nil then
989      begin
990 +      Status := FirebirdAPI.GetStatus;
991        {$IFDEF UNIX}
992 <      if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
992 >      if Pos(':',aDBName) = 0 then
993        begin
994 <        status_vector := StatusVector;
995 <        IBErrorCode := StatusVectorArray[1];
996 <        sqlcode := isc_sqlcode(StatusVector);
997 <
998 <        if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
999 <           or
1000 <           ((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1001 <           then
1002 <           begin
1003 <             aDBName := 'localhost:' + aDBName;
1004 <             Continue;
1005 <           end;
994 >          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
995 >             or
996 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
997 >             or
998 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
999 >             or
1000 >             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1001 >             then
1002 >             begin
1003 >               aDBName := 'localhost:' + aDBName;
1004 >               Continue;
1005 >            end
1006        end;
1007        {$ENDIF}
1008 <      FHandle := nil;
1009 <      IBDataBaseError;
1008 >      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1009 >                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1010 >        FCreateDatabase := true
1011 >      else
1012 >        raise EIBInterBaseError.Create(Status);
1013      end;
1014 <  until FHandle <> nil;
1014 >  until FAttachment <> nil;
1015    if not (csDesigning in ComponentState) then
1016      FDBName := aDBName; {Synchronise at run time}
1017    FDBSQLDialect := GetDBSQLDialect;
# Line 1190 | Line 1125 | begin
1125    FDefaultTransaction := Value;
1126   end;
1127  
1193 procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1194 begin
1195  if HandleIsShared then
1196    Close
1197  else
1198    CheckInactive;
1199  FHandle := Value;
1200  FHandleIsShared := (Value <> nil);
1201 end;
1202
1128   procedure TIBDataBase.SetIdleTimer(Value: Integer);
1129   begin
1130    if Value < 0 then
# Line 1244 | Line 1169 | end;
1169   begin
1170    if Connected then
1171    begin
1172 <    if FCanTimeout then
1172 >    if not FAttachment.HasActivity then
1173      begin
1174        ForceClose;
1175        if Assigned(FOnIdleTimer) then
1176          FOnIdleTimer(Self);
1177      end
1253    else
1254      FCanTimeout := True;
1178    end;
1179   end;
1180  
# Line 1282 | Line 1205 | end;
1205   procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1206   begin
1207    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1208 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1208 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1209      FSQLDialect := Value
1210    else
1211      IBError(ibxeSQLDialectInvalid, [nil]);
# Line 1401 | Line 1324 | begin
1324        BeginUpdate;
1325        try
1326          Clear;
1327 <        while (not Query.EOF) and (Query.Next <> nil) do
1328 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1327 >        while (not Query.EOF) and Query.Next  do
1328 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1329        finally
1330          EndUpdate;
1331        end;
# Line 1441 | Line 1364 | begin
1364          BeginUpdate;
1365          try
1366            Clear;
1367 <          while (not Query.EOF) and (Query.Next <> nil) do
1368 <            List.Add(TrimRight(Query.Current[0].AsString));
1367 >          while (not Query.EOF) and Query.Next  do
1368 >            List.Add(TrimRight(Query.Fields[0].AsString));
1369          finally
1370            EndUpdate;
1371          end;
# Line 1459 | Line 1382 | end;
1382   constructor TIBTransaction.Create(AOwner: TComponent);
1383   begin
1384    inherited Create(AOwner);
1462  FIBLoaded := False;
1463  CheckIBLoaded;
1464  FIBLoaded := True;
1465  CheckIBLoaded;
1385    FDatabases := TList.Create;
1386    FSQLObjects := TList.Create;
1468  FHandle := nil;
1387    FTPB := nil;
1470  FTPBLength := 0;
1388    FTRParams := TStringList.Create;
1389    FTRParamsChanged := True;
1390    TStringList(FTRParams).OnChange := TRParamsChange;
# Line 1483 | Line 1400 | destructor TIBTransaction.Destroy;
1400   var
1401    i: Integer;
1402   begin
1403 <  if FIBLoaded then
1404 <  begin
1405 <    if InTransaction then
1406 <      EndTransaction(FDefaultAction, True);
1407 <    for i := 0 to FSQLObjects.Count - 1 do
1408 <      if FSQLObjects[i] <> nil then
1409 <        SQLObjects[i].DoTransactionFree;
1410 <    RemoveSQLObjects;
1411 <    RemoveDatabases;
1412 <    FreeMem(FTPB);
1413 <    FTPB := nil;
1497 <    FTRParams.Free;
1498 <    FSQLObjects.Free;
1499 <    FDatabases.Free;
1500 <  end;
1403 >  if InTransaction then
1404 >    EndTransaction(FDefaultAction, True);
1405 >  for i := 0 to FSQLObjects.Count - 1 do
1406 >    if FSQLObjects[i] <> nil then
1407 >      SQLObjects[i].DoTransactionFree;
1408 >  RemoveSQLObjects;
1409 >  RemoveDatabases;
1410 >  FTPB := nil;
1411 >  FTRParams.Free;
1412 >  FSQLObjects.Free;
1413 >  FDatabases.Free;
1414    inherited Destroy;
1415   end;
1416  
1504 function TIBTransaction.Call(ErrCode: ISC_STATUS;
1505  RaiseError: Boolean): ISC_STATUS;
1506 var
1507  i: Integer;
1508 begin
1509  result := ErrCode;
1510  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1511    Databases[i].FCanTimeout := False;
1512  FCanTimeout := False;
1513  if RaiseError and (result > 0) then
1514    IBDataBaseError;
1515 end;
1516
1417   procedure TIBTransaction.CheckDatabasesInList;
1418   begin
1419    if GetDatabaseCount = 0 then
# Line 1524 | Line 1424 | procedure TIBTransaction.CheckInTransact
1424   begin
1425    if FStreamedActive and (not InTransaction) then
1426      Loaded;
1427 <  if (FHandle = nil) then
1427 >  if (TransactionIntf = nil) then
1428      IBError(ibxeNotInTransaction, [nil]);
1429   end;
1430  
# Line 1580 | Line 1480 | procedure TIBTransaction.EnsureNotInTran
1480   begin
1481    if csDesigning in ComponentState then
1482    begin
1483 <    if FHandle <> nil then
1483 >    if TransactionIntf <> nil then
1484        Rollback;
1485    end;
1486   end;
1487  
1488   procedure TIBTransaction.CheckNotInTransaction;
1489   begin
1490 <  if (FHandle <> nil) then
1490 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1491      IBError(ibxeInTransaction, [nil]);
1492   end;
1493  
# Line 1596 | Line 1496 | var
1496    i: Integer;
1497    NilFound: Boolean;
1498   begin
1499 +  EnsureNotInTransaction;
1500 +  CheckNotInTransaction;
1501 +  FTransactionIntf := nil;
1502 +
1503    i := FindDatabase(db);
1504    if i <> -1 then
1505    begin
# Line 1646 | Line 1550 | end;
1550   procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1551    Force: Boolean);
1552   var
1649  status: ISC_STATUS;
1553    i: Integer;
1554   begin
1555    CheckInTransaction;
# Line 1657 | Line 1560 | begin
1560    case Action of
1561      TARollback, TACommit:
1562      begin
1660      if (HandleIsShared) and
1661         (Action <> FDefaultAction) and
1662         (not Force) then
1663        IBError(ibxeCantEndSharedTransaction, [nil]);
1563        DoBeforeTransactionEnd;
1564        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1565          SQLObjects[i].DoBeforeTransactionEnd(Action);
1566        if InTransaction then
1567        begin
1568 <        if HandleIsShared then
1569 <        begin
1671 <          FHandle := nil;
1672 <          FHandleIsShared := False;
1673 <          status := 0;
1674 <        end
1675 <        else
1676 <          if (Action = TARollback) then
1677 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1678 <          else
1679 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1680 <        if ((Force) and (status > 0)) then
1681 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1682 <        if Force then
1683 <          FHandle := nil
1568 >        if (Action = TARollback) then
1569 >            FTransactionIntf.Rollback(Force)
1570          else
1571 <          if (status > 0) then
1572 <            IBDataBaseError;
1571 >        try
1572 >          FTransactionIntf.Commit;
1573 >        except on E: EIBInterBaseError do
1574 >          begin
1575 >            if Force then
1576 >              FTransactionIntf.Rollback(Force)
1577 >            else
1578 >              raise;
1579 >          end;
1580 >        end;
1581 >
1582          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1583            SQLObjects[i].DoAfterTransactionEnd;
1584          DoAfterTransactionEnd;
1585        end;
1586      end;
1587      TACommitRetaining:
1588 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1588 >      FTransactionIntf.CommitRetaining;
1589 >
1590      TARollbackRetaining:
1591 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1591 >      FTransactionIntf.RollbackRetaining;
1592    end;
1593    if not (csDesigning in ComponentState) then
1594    begin
# Line 1744 | Line 1640 | end;
1640  
1641   function TIBTransaction.GetInTransaction: Boolean;
1642   begin
1643 <  result := (FHandle <> nil);
1643 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1644   end;
1645  
1646   function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
# Line 1800 | Line 1696 | procedure TIBTransaction.BeforeDatabaseD
1696   begin
1697    if InTransaction then
1698      EndTransaction(FDefaultAction, True);
1699 +  FTransactionIntf := nil;
1700   end;
1701  
1702   procedure TIBTransaction.RemoveDatabase(Idx: Integer);
# Line 1808 | Line 1705 | var
1705   begin
1706    if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1707    begin
1708 +    EnsureNotInTransaction;
1709 +    CheckNotInTransaction;
1710 +    FTransactionIntf := nil;
1711 +
1712      DB := Databases[Idx];
1713      FDatabases[Idx] := nil;
1714      DB.RemoveTransaction(DB.FindTransaction(Self));
# Line 1820 | Line 1721 | procedure TIBTransaction.RemoveDatabases
1721   var
1722    i: Integer;
1723   begin
1724 +  EnsureNotInTransaction;
1725 +  CheckNotInTransaction;
1726 +  FTransactionIntf := nil;
1727 +
1728    for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1729      RemoveDatabase(i);
1730   end;
# Line 1866 | Line 1771 | begin
1771          Rollback;
1772   end;
1773  
1869 procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1870 begin
1871 (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1872    IBError(ibxeIB60feature, [nil]);*)
1873  FDefaultAction := Value;
1874 end;
1875
1774   procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1775   var
1776    i: integer;
# Line 1895 | Line 1793 | begin
1793    FDefaultDatabase := Value;
1794   end;
1795  
1898 procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1899 begin
1900  if (HandleIsShared) then
1901    EndTransaction(DefaultAction, True)
1902  else
1903    CheckNotInTransaction;
1904  FHandle := Value;
1905  FHandleIsShared := (Value <> nil);
1906 end;
1907
1796   procedure TIBTransaction.Notification( AComponent: TComponent;
1797                                          Operation: TOperation);
1798   var
# Line 1946 | Line 1834 | end;
1834  
1835   procedure TIBTransaction.StartTransaction;
1836   var
1949  pteb: PISC_TEB_ARRAY;
1950  TPB: String;
1837    i: Integer;
1838 +  Attachments: array of IAttachment;
1839 +  ValidDatabaseCount: integer;
1840   begin
1841    CheckNotInTransaction;
1842    CheckDatabasesInList;
1843 +  if TransactionIntf <> nil then
1844 +  begin
1845 +    TransactionIntf.Start(DefaultAction);
1846 +    Exit;
1847 +  end;
1848 +
1849    for i := 0 to FDatabases.Count - 1 do
1850     if  FDatabases[i] <> nil then
1851     begin
1852       with TIBDatabase(FDatabases[i]) do
1853       if not Connected then
1854 <       if FStreamedConnected then
1854 >       if StreamedConnected then
1855         begin
1856           Open;
1857 <         FStreamedConnected := False;
1857 >         StreamedConnected := False;
1858         end
1859         else
1860           IBError(ibxeDatabaseClosed, [nil]);
# Line 1968 | Line 1862 | begin
1862    if FTRParamsChanged then
1863    begin
1864      FTRParamsChanged := False;
1865 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1972 <    if FTPBLength > 0 then
1973 <    begin
1974 <      IBAlloc(FTPB, 0, FTPBLength);
1975 <      Move(TPB[1], FTPB[0], FTPBLength);
1976 <    end;
1865 >    FTPB :=  GenerateTPB(FTRParams);
1866    end;
1867  
1868 <  pteb := nil;
1869 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1870 <  try
1871 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1872 <    begin
1873 <      pteb^[i].db_handle := @(Databases[i].Handle);
1874 <      pteb^[i].tpb_length := FTPBLength;
1875 <      pteb^[i].tpb_address := FTPB;
1876 <    end;
1877 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1878 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1879 <    begin
1880 <      FHandle := nil;
1881 <      IBDataBaseError;
1993 <    end;
1994 <    if not (csDesigning in ComponentState) then
1995 <      MonitorHook.TRStart(Self);
1996 <  finally
1997 <    FreeMem(pteb);
1868 >  ValidDatabaseCount := 0;
1869 >  for i := 0 to DatabaseCount - 1 do
1870 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1871 >
1872 >  if ValidDatabaseCount = 1 then
1873 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1874 >  else
1875 >  begin
1876 >    SetLength(Attachments,ValidDatabaseCount);
1877 >    for i := 0 to DatabaseCount - 1 do
1878 >      if Databases[i] <> nil then
1879 >        Attachments[i] := Databases[i].Attachment;
1880 >
1881 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1882    end;
1883 +
1884 +  if not (csDesigning in ComponentState) then
1885 +      MonitorHook.TRStart(Self);
1886    DoOnStartTransaction;
1887   end;
1888  
# Line 2003 | Line 1890 | procedure TIBTransaction.TimeoutTransact
1890   begin
1891    if InTransaction then
1892    begin
1893 <    if FCanTimeout then
1893 >    if not TransactionIntf.HasActivity then
1894      begin
1895        EndTransaction(FDefaultAction, True);
1896        if Assigned(FOnIdleTimer) then
1897          FOnIdleTimer(Self);
1898      end
2012    else
2013      FCanTimeout := True;
1899    end;
1900   end;
1901  
# Line 2023 | Line 1908 | procedure TIBTransaction.TRParamsChangin
1908   begin
1909    EnsureNotInTransaction;
1910    CheckNotInTransaction;
1911 +  FTransactionIntf := nil;
1912   end;
1913  
1914   { TIBBase }
# Line 2038 | Line 1924 | begin
1924    inherited Destroy;
1925   end;
1926  
2041 function TIBBase.GetDefaultCharSetName: RawByteString;
2042 begin
2043  Result := Database.FDefaultCharSetName;
2044 end;
2045
2046 function TIBBase.GetDefaultCharSetID: cardinal;
2047 begin
2048  Result := Database.DefaultCharSetID;
2049 end;
2050
1927   procedure TIBBase.HandleException(Sender: TObject);
1928   begin
1929    if assigned(Database) then
# Line 2086 | Line 1962 | begin
1962    FTransaction.CheckInTransaction;
1963   end;
1964  
2089 function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2090 begin
2091  CheckDatabase;
2092  result := @FDatabase.Handle;
2093 end;
2094
2095 function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2096 begin
2097  CheckTransaction;
2098  result := @FTransaction.Handle;
2099 end;
2100
1965   procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1966    );
1967   begin
# Line 2212 | Line 2076 | end;
2076    parameter buffer, and return it and its length
2077    in DPB and DPBLength, respectively. }
2078  
2079 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2079 > function GenerateDPB(sl: TStrings): IDPB;
2080   var
2081 <  i, j, pval: Integer;
2081 >  i, j: Integer;
2082    DPBVal: UShort;
2083    ParamName, ParamValue: string;
2084   begin
2085 <  { The DPB is initially empty, with the exception that
2222 <    the DPB version must be the first byte of the string. }
2223 <  DPBLength := 1;
2224 <  DPB := Char(isc_dpb_version1);
2085 >  Result := FirebirdAPI.AllocateDPB;
2086  
2087    {Iterate through the textual database parameters, constructing
2088     a DPB on-the-fly }
# Line 2260 | Line 2121 | begin
2121        begin
2122          if DPBVal = isc_dpb_sql_dialect then
2123            ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2124 <        DPB := DPB +
2264 <               Char(DPBVal) +
2265 <               Char(Length(ParamValue)) +
2266 <               ParamValue;
2267 <        Inc(DPBLength, 2 + Length(ParamValue));
2124 >        Result.Add(DPBVal).SetAsString(ParamValue);
2125        end;
2126 +
2127        isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2128        isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2129 <      begin
2130 <        DPB := DPB +
2273 <               Char(DPBVal) +
2274 <               #1 +
2275 <               Char(StrToInt(ParamValue));
2276 <        Inc(DPBLength, 3);
2277 <      end;
2129 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2130 >
2131        isc_dpb_sweep:
2132 <      begin
2133 <        DPB := DPB +
2281 <               Char(DPBVal) +
2282 <               #1 +
2283 <               Char(isc_dpb_records);
2284 <        Inc(DPBLength, 3);
2285 <      end;
2132 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2133 >
2134        isc_dpb_sweep_interval:
2135 <      begin
2136 <        pval := StrToInt(ParamValue);
2289 <        DPB := DPB +
2290 <               Char(DPBVal) +
2291 <               #4 +
2292 <               PChar(@pval)[0] +
2293 <               PChar(@pval)[1] +
2294 <               PChar(@pval)[2] +
2295 <               PChar(@pval)[3];
2296 <        Inc(DPBLength, 6);
2297 <      end;
2135 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2136 >
2137        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2138        isc_dpb_quit_log:
2139 <      begin
2301 <        DPB := DPB +
2302 <               Char(DPBVal) +
2303 <               #1 + #0;
2304 <        Inc(DPBLength, 3);
2305 <      end;
2139 >        Result.Add(DPBVal).SetAsByte(0);
2140        else
2141        begin
2142          if (DPBVal > 0) and
# Line 2320 | Line 2154 | end;
2154    of the transaction parameters, generate a transaction
2155    parameter buffer, and return it and its length in
2156    TPB and TPBLength, respectively. }
2157 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2157 > function GenerateTPB(sl: TStrings): ITPB;
2158   var
2159 <  i, j, TPBVal, ParamLength: Integer;
2159 >  i, j, TPBVal: Integer;
2160    ParamName, ParamValue: string;
2161   begin
2162 <  TPB := '';
2329 <  if (sl.Count = 0) then
2330 <    TPBLength := 0
2331 <  else
2332 <  begin
2333 <    TPBLength := sl.Count + 1;
2334 <    TPB := TPB + Char(isc_tpb_version3);
2335 <  end;
2162 >  Result := FirebirdAPI.AllocateTPB;
2163    for i := 0 to sl.Count - 1 do
2164    begin
2165      if (Trim(sl[i]) =  '') then
2339    begin
2340      Dec(TPBLength);
2166        Continue;
2167 <    end;
2167 >
2168      if (Pos('=', sl[i]) = 0) then {mbcs ok}
2169        ParamName := LowerCase(sl[i]) {mbcs ok}
2170      else
# Line 2363 | Line 2188 | begin
2188        isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2189        isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2190        isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2191 <        TPB := TPB + Char(TPBVal);
2191 >        Result.Add(TPBVal);
2192 >
2193        isc_tpb_lock_read, isc_tpb_lock_write:
2194 <      begin
2195 <        TPB := TPB + Char(TPBVal);
2370 <        { Now set the string parameter }
2371 <        ParamLength := Length(ParamValue);
2372 <        Inc(TPBLength, ParamLength + 1);
2373 <        TPB := TPB + Char(ParamLength) + ParamValue;
2374 <      end;
2194 >        Result.Add(TPBVal).SetAsString(ParamValue);
2195 >
2196        else
2197        begin
2198          if (TPBVal > 0) and

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines