ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBDatabase.pas

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 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	–	FCharSetSizes: array of integer;
191	–	FCharSetNames: array of RawByteString;
192	–	FDefaultCharSetName: RawByteString;
193	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
194	–	FCodePages: array of TSystemCodePage;
195	–	FDefaultCodePage: TSystemCodePage;
196	–	{$ENDIF}
199		FUseDefaultSystemCodePage: boolean;
200		procedure EnsureInactive;
201		function GetDBSQLDialect: Integer;
#	Line 204 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
207	–	function GetDBParamByDPB(const Idx: Integer): String;
209		function GetIdleTimer: Integer;
210		function GetTransaction(Index: Integer): TIBTransaction;
211		function GetTransactionCount: Integer;
212		function Login(var aDatabaseName: string): Boolean;
212	–	procedure LoadCharSetInfo;
213		procedure SetDatabaseName(const Value: TIBFileName);
214		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215		procedure SetDBParams(Value: TStrings);
#	Line 240 | Line 240 | type
240		procedure CloseDataSets;
241		procedure CheckActive;
242		procedure CheckInactive;
243	<	procedure CreateDatabase;
243	>	procedure CreateDatabase; overload;
244	>	procedure CreateDatabase(createDatabaseSQL: string); overload;
245		procedure DropDatabase;
246		procedure ForceClose;
247		procedure GetFieldNames(const TableName: string; List: TStrings);
#	Line 248 | Line 249 | type
249		function IndexOfDBConst(st: String): Integer;
250		function TestConnected: Boolean;
251		procedure CheckDatabaseName;
251	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
252		function AddTransaction(TR: TIBTransaction): Integer;
253		function FindTransaction(TR: TIBTransaction): Integer;
254		function FindDefaultTransaction(): TIBTransaction;
255		procedure RemoveTransaction(Idx: Integer);
256		procedure RemoveTransactions;
257	–	procedure SetHandle(Value: TISC_DB_HANDLE);
257
258	<	property Handle: TISC_DB_HANDLE read FHandle;
258	>	property Attachment: IAttachment read FAttachment;
259	>	property DBSQLDialect : Integer read FDBSQLDialect;
260		property IsReadOnly: Boolean read GetIsReadOnly;
261	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
262	–	write SetDBParamByDPB;
261		property SQLObjectCount: Integer read GetSQLObjectCount;
262		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
265	–	property HandleIsShared: Boolean read FHandleIsShared;
263		property TransactionCount: Integer read GetTransactionCount;
264		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265		property InternalTransaction: TIBTransaction read FInternalTransaction;
266		property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
267	>	property DefaultCharSetID: integer read FDefaultCharSetID;
268		property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
272	–	{$ENDIF}
269
270		published
271		property Connected;
272	+	property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
273		property AllowStreamedConnected: boolean read FAllowStreamedConnected
274		write FAllowStreamedConnected;
275		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
#	Line 283 | Line 280 | type
280		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
286	–	property DBSQLDialect : Integer read FDBSQLDialect;
283		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284		property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285		write FUseDefaultSystemCodePage;
#	Line 291 | Line 287 | type
287		property AfterDisconnect;
288		property BeforeConnect;
289		property BeforeDisconnect;
290	+	property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
291		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
292		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
293		property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
294		end;
295
296	<	{ TIBTransaction }
296	>	TDefaultEndAction = TARollback..TACommit;
297
298	<	TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
298	>	{ TIBTransaction }
299
300		TIBTransaction = class(TComponent)
301		private
302	+	FTransactionIntf: ITransaction;
303		FAfterDelete: TNotifyEvent;
304		FAfterEdit: TNotifyEvent;
305		FAfterExecQuery: TNotifyEvent;
#	Line 309 | Line 307 | type
307		FAfterPost: TNotifyEvent;
308		FAfterTransactionEnd: TNotifyEvent;
309		FBeforeTransactionEnd: TNotifyEvent;
312	–	FIBLoaded: Boolean;
313	–	FCanTimeout         : Boolean;
310		FDatabases          : TList;
311		FOnStartTransaction: TNotifyEvent;
312		FSQLObjects         : TList;
313		FDefaultDatabase    : TIBDatabase;
318	–	FHandle             : TISC_TR_HANDLE;
319	–	FHandleIsShared     : Boolean;
314		FOnIdleTimer          : TNotifyEvent;
315		FStreamedActive     : Boolean;
316	<	FTPB                : PChar;
323	<	FTPBLength          : Short;
316	>	FTPB                : ITPB;
317		FTimer              : TFPTimer;
318	<	FDefaultAction      : TTransactionAction;
318	>	FDefaultAction      : TDefaultEndAction;
319		FTRParams           : TStrings;
320		FTRParamsChanged    : Boolean;
321		FInEndTransaction   : boolean;
#	Line 345 | Line 338 | type
338		function GetIdleTimer: Integer;
339		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340		procedure SetActive(Value: Boolean);
348	–	procedure SetDefaultAction(Value: TTransactionAction);
341		procedure SetDefaultDatabase(Value: TIBDatabase);
342		procedure SetIdleTimer(Value: Integer);
343		procedure SetTRParams(Value: TStrings);
#	Line 358 | Line 350 | type
350
351		protected
352		procedure Loaded; override;
361	–	procedure SetHandle(Value: TISC_TR_HANDLE);
353		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
354
355		public
356		constructor Create(AOwner: TComponent); override;
357		destructor Destroy; override;
367	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358		procedure Commit;
359		procedure CommitRetaining;
360		procedure Rollback;
#	Line 385 | Line 375 | type
375		property Databases[Index: Integer]: TIBDatabase read GetDatabase;
376		property SQLObjectCount: Integer read GetSQLObjectCount;
377		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
388	–	property Handle: TISC_TR_HANDLE read FHandle;
389	–	property HandleIsShared: Boolean read FHandleIsShared;
378		property InTransaction: Boolean read GetInTransaction;
379	<	property TPB: PChar read FTPB;
380	<	property TPBLength: Short read FTPBLength;
379	>	property TransactionIntf: ITransaction read FTransactionIntf;
380	>	property TPB: ITPB read FTPB;
381		published
382		property Active: Boolean read GetInTransaction write SetActive;
383		property DefaultDatabase: TIBDatabase read FDefaultDatabase
384		write SetDefaultDatabase;
385		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
386	<	property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
386	>	property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
387		property Params: TStrings read FTRParams write SetTRParams;
388		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
389		property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
#	Line 446 | Line 434 | type
434		procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435		procedure DoAfterTransactionEnd; virtual;
436		procedure DoTransactionFree; virtual;
449	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
450	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
437		procedure SetDatabase(Value: TIBDatabase); virtual;
438		procedure SetTransaction(Value: TIBTransaction); virtual;
439		public
#	Line 460 | Line 446 | type
446		procedure DoAfterDelete(Sender: TObject); virtual;
447		procedure DoAfterInsert(Sender: TObject); virtual;
448		procedure DoAfterPost(Sender: TObject); virtual;
463	–	function GetCharSetSize(CharSetID: integer): integer;
464	–	function GetDefaultCharSetSize: integer;
465	–	function GetCharSetName(CharSetID: integer): string;
466	–	function GetDefaultCharSetName: RawByteString;
467	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
468	–	function GetCodePage(CharSetID: integer): TSystemCodePage;
469	–	function GetDefaultCodePage: TSystemCodePage;
470	–	{$ENDIF}
449		procedure HandleException(Sender: TObject);
450		procedure SetCursor;
451		procedure RestoreCursor;
#	Line 486 | Line 464 | type
464		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465		property Database: TIBDatabase read FDatabase
466		write SetDatabase;
489	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467		property Owner: TObject read FOwner;
491	–	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468		property Transaction: TIBTransaction read FTransaction
469		write SetTransaction;
470		end;
471
472	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
473	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
472	>	function GenerateDPB(sl: TStrings): IDPB;
473	>	function GenerateTPB(sl: TStrings): ITPB;
474
475
476		implementation
477
478	<	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	<	typInfo, IBCodePage;
478	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	>	typInfo, FBMessages, IBErrorCodes;
480
481		{ TIBDatabase }
482
483		constructor TIBDataBase.Create(AOwner: TComponent);
484		begin
485		inherited Create(AOwner);
510	–	FIBLoaded := False;
511	–	CheckIBLoaded;
512	–	FIBLoaded := True;
486		LoginPrompt := True;
487		FSQLObjects := TList.Create;
488		FTransactions := TList.Create;
#	Line 520 | Line 493 | begin
493		(AOwner is TCustomApplication) and
494		TCustomApplication(AOWner).ConsoleApplication then
495		LoginPrompt := false;
523	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
524	–	FDefaultCodePage := CP_NONE;
525	–	{$ENDIF}
496		FDBParamsChanged := True;
497		TStringList(FDBParams).OnChange := DBParamsChange;
498		TStringList(FDBParams).OnChanging := DBParamsChanging;
499		FDPB := nil;
530	–	FHandle := nil;
500		FUserNames := nil;
501		FInternalTransaction := TIBTransaction.Create(self);
502		FInternalTransaction.DefaultDatabase := Self;
#	Line 542 | Line 511 | begin
511		CheckStreamConnect;
512		end;
513
514	<	destructor TIBDataBase.Destroy;
514	>	destructor TIBDataBase.Destroy;
515		var
516		i: Integer;
517		begin
518	<	if FIBLoaded then
519	<	begin
520	<	IdleTimer := 0;
521	<	if FHandle <> nil then
522	<	ForceClose;
523	<	for i := 0 to FSQLObjects.Count - 1 do
524	<	if FSQLObjects[i] <> nil then
525	<	SQLObjects[i].DoDatabaseFree;
526	<	RemoveSQLObjects;
527	<	RemoveTransactions;
528	<	FInternalTransaction.Free;
529	<	FreeMem(FDPB);
530	<	FDPB := nil;
531	<	FDBParams.Free;
563	<	FSQLObjects.Free;
564	<	FUserNames.Free;
565	<	FTransactions.Free;
566	<	end;
518	>	IdleTimer := 0;
519	>	if FAttachment <> nil then
520	>	ForceClose;
521	>	for i := 0 to FSQLObjects.Count - 1 do
522	>	if FSQLObjects[i] <> nil then
523	>	SQLObjects[i].DoDatabaseFree;
524	>	RemoveSQLObjects;
525	>	RemoveTransactions;
526	>	FInternalTransaction.Free;
527	>	FDPB := nil;
528	>	FDBParams.Free;
529	>	FSQLObjects.Free;
530	>	FUserNames.Free;
531	>	FTransactions.Free;
532		FDataSets.Free;
533		inherited Destroy;
534		end;
535
571	–	function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
572	–	): ISC_STATUS;
573	–	begin
574	–	result := ErrCode;
575	–	FCanTimeout := False;
576	–	if RaiseError and (ErrCode > 0) then
577	–	IBDataBaseError;
578	–	end;
579	–
536		procedure TIBDataBase.CheckActive;
537		begin
538		if StreamedConnected and (not Connected) then
539		Loaded;
540	<	if FHandle = nil then
540	>	if FAttachment = nil then
541		IBError(ibxeDatabaseClosed, [nil]);
542		end;
543
#	Line 589 | Line 545 | end;
545		begin
546		if csDesigning in ComponentState then
547		begin
548	<	if FHandle <> nil then
548	>	if FAttachment <> nil then
549		Close;
550		end
551		end;
552
553		procedure TIBDataBase.CheckInactive;
554		begin
555	<	if FHandle <> nil then
555	>	if FAttachment <> nil then
556		IBError(ibxeDatabaseOpen, [nil]);
557		end;
558
#	Line 641 | Line 597 | begin
597		if Connected then
598		InternalClose(False);
599		FDBSQLDialect := 1;
644	–	SetLength(FCharSetSizes,0);
645	–	SetLength(FCharSetNames,0);
600		FDefaultCharSetName := '';
601	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
648	<	SetLength(FCodePages,0);
601	>	FDefaultCharSetID := 0;
602		FDefaultCodePage := CP_NONE;
650	–	{$ENDIF}
603		end;
604
605	<	procedure TIBDataBase.CreateDatabase;
654	<	var
655	<	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 info: IDBInformation;
615	>	ConnectionType: integer;
616	>	SiteName: string;
617	>	begin
618	>	CheckInactive;
619	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
620	>	info := FAttachment.GetDBInformation(isc_info_db_id);
621	>	info[0].DecodeIDCluster(ConnectionType,FDBName,SiteName);
622	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
623	>	OnCreateDatabase(self);
624		end;
625
626		procedure TIBDataBase.DropDatabase;
627		begin
628		CheckActive;
629	<	Call(isc_drop_database(StatusVector, @FHandle), True);
629	>	FAttachment.DropDatabase;
630	>	FAttachment := nil;
631		end;
632
633		procedure TIBDataBase.DBParamsChange(Sender: TObject);
#	Line 719 | Line 680 | end;
680
681		function TIBDataBase.GetConnected: Boolean;
682		begin
683	<	result := FHandle <> nil;
683	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
684		end;
685
686		function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
#	Line 736 | Line 697 | begin
697		Inc(result);
698		end;
699
700	<	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
740	<	var
741	<	ConstIdx, EqualsIdx: Integer;
742	<	begin
743	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
744	<	begin
745	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
746	<	if ConstIdx = -1 then
747	<	result := ''
748	<	else
749	<	begin
750	<	result := Params[ConstIdx];
751	<	EqualsIdx := Pos('=', result); {mbcs ok}
752	<	if EqualsIdx = 0 then
753	<	result := ''
754	<	else
755	<	result := Copy(result, EqualsIdx + 1, Length(result));
756	<	end;
757	<	end
758	<	else
759	<	result := '';
760	<	end;
761	<
762	<	function TIBDataBase.GetIdleTimer: Integer;
700	>	function TIBDataBase.GetIdleTimer: Integer;
701		begin
702		result := FTimer.Interval;
703		end;
#	Line 824 | Line 762 | begin
762		end;
763		end;
764
765	<	if (not HandleIsShared) and
766	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
829	<	(not Force) then
830	<	IBDataBaseError
831	<	else
832	<	begin
833	<	FHandle := nil;
834	<	FHandleIsShared := False;
835	<	end;
765	>	FAttachment.Disconnect(Force);
766	>	FAttachment := nil;
767
768		if not (csDesigning in ComponentState) then
769		MonitorHook.DBDisconnect(Self);
#	Line 842 | Line 773 | begin
773		SQLObjects[i].DoAfterDatabaseDisconnect;
774		end;
775
845	–	procedure TIBDataBase.LoadCharSetInfo;
846	–	var Query: TIBSQL;
847	–	i: integer;
848	–	begin
849	–	if not FInternalTransaction.Active then
850	–	FInternalTransaction.StartTransaction;
851	–	Query := TIBSQL.Create(self);
852	–	try
853	–	Query.Database := Self;
854	–	Query.Transaction := FInternalTransaction;
855	–	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
856	–	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
857	–	Query.Prepare;
858	–	Query.ExecQuery;
859	–	if not Query.EOF then
860	–	begin
861	–	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
862	–	SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
863	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
864	–	SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
865	–	{$ENDIF}
866	–	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
867	–	repeat
868	–	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
869	–	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
870	–	FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
871	–	Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
872	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
873	–	FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
874	–	IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
875	–	{$ENDIF}
876	–	Query.Next;
877	–	until Query.EOF;
878	–	end;
879	–	finally
880	–	Query.free;
881	–	FInternalTransaction.Commit;
882	–	end;
883	–	end;
884	–
776		procedure TIBDataBase.CheckStreamConnect;
777		var
778		i: integer;
#	Line 904 | Line 795 | begin
795		(FDefaultTransaction.FStreamedActive) and
796		(not FDefaultTransaction.InTransaction) then
797		FDefaultTransaction.StartTransaction;
798	<	FStreamedConnected := False;
798	>	StreamedConnected := False;
799		end;
800		except
801		if csDesigning in ComponentState then
#	Line 945 | Line 836 | begin
836		end;
837		end;
838
839	<	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
839	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
840		var
841		IndexOfUser, IndexOfPassword: Integer;
842		Username, Password, OldPassword: String;
#	Line 1003 | Line 894 | begin
894		Length(Params[IndexOfPassword]));
895		OldPassword := password;
896		end;
897	+
898		result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
899		if result then
900		begin
901	<	if IndexOfUser = -1 then
902	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
903	<	else
904	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
901	>	if Username <> '' then
902	>	begin
903	>	if IndexOfUser = -1 then
904	>	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
905	>	else
906	>	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
907		'=' + Username;
908	+	end
909	+	else
910	+	if IndexOfUser <> -1 then
911	+	Params.Delete(IndexOfUser);
912		if (Password = OldPassword) then
913		FHiddenPassword := ''
914		else
#	Line 1031 | Line 929 | end;
929
930		procedure TIBDataBase.DoConnect;
931		var
1034	–	DPB: String;
932		TempDBParams: TStrings;
933		I: integer;
934		aDBName: string;
935	<
936	<	{Call error analysis}
1040	<	sqlcode: Long;
1041	<	IBErrorCode: Long;
1042	<	status_vector: PISC_STATUS;
1043	<	{$ifdef WINDOWS}
1044	<	acp: uint;
1045	<	{$endif}
935	>	Status: IStatus;
936	>	CharSetID: integer;
937		begin
938		CheckInactive;
939		CheckDatabaseName;
#	Line 1062 | Line 953 | begin
953		if UseDefaultSystemCodePage then
954		begin
955		{$ifdef WINDOWS}
956	<	acp := GetACP;
957	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1067	<	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1068	<	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1069	<	{$ELSE}
1070	<	if (acp >= 1250) and (acp <= 1258) then
1071	<	TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1072	<	else
1073	<	TempDBParams.Values['lc_ctype'] :='UTF8';
1074	<	{$ENDIF}
956	>	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
957	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
958		{$else}
959	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
960	<	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1078	<	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079	<	{$ELSE}
1080	<	TempDBParams.Values['lc_ctype'] :='UTF8';
1081	<	{$ENDIF}
959	>	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
960	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
961		{$endif}
962	+	else
963	+	TempDBParams.Values['lc_ctype'] :='UTF8';
964		end;
965		{Opportunity to override defaults}
966		for i := 0 to FSQLObjects.Count - 1 do
#	Line 1087 | Line 968 | begin
968		if FSQLObjects[i] <> nil then
969		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
970		end;
1090	–	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
971
972	+	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
973	+	if FDefaultCharSetName <> '' then
974	+	FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
975	+	FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
976		{ Generate a new DPB if necessary }
977		if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
978		begin
979		FDBParamsChanged := False;
980		if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
981	<	GenerateDPB(TempDBParams, DPB, FDPBLength)
981	>	FDPB := GenerateDPB(TempDBParams)
982		else
983		begin
984		TempDBParams.Add('password=' + FHiddenPassword);
985	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
985	>	FDPB := GenerateDPB(TempDBParams);
986		end;
1103	–	IBAlloc(FDPB, 0, FDPBLength);
1104	–	Move(DPB[1], FDPB[0], FDPBLength);
987		end;
988		finally
989		TempDBParams.Free;
990		end;
991	+
992		repeat
993	<	if Call(isc_attach_database(StatusVector, Length(aDBName),
994	<	PChar(aDBName), @FHandle,
995	<	FDPBLength, FDPB), False) > 0 then
993	>	if FCreateDatabase then
994	>	begin
995	>	FCreateDatabase := false;
996	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
997	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
998	>	OnCreateDatabase(self);
999	>	end
1000	>	else
1001	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1002	>	if FAttachment = nil then
1003		begin
1004	+	Status := FirebirdAPI.GetStatus;
1005		{$IFDEF UNIX}
1006	<	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1006	>	if Pos(':',aDBName) = 0 then
1007		begin
1008	<	status_vector := StatusVector;
1009	<	IBErrorCode := StatusVectorArray[1];
1010	<	sqlcode := isc_sqlcode(StatusVector);
1011	<
1012	<	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1013	<	or
1014	<	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1015	<	then
1016	<	begin
1017	<	aDBName := 'localhost:' + aDBName;
1018	<	Continue;
1019	<	end;
1008	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1009	>	or
1010	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1011	>	or
1012	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1013	>	or
1014	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1015	>	then
1016	>	begin
1017	>	aDBName := 'localhost:' + aDBName;
1018	>	Continue;
1019	>	end
1020		end;
1021		{$ENDIF}
1022	<	FHandle := nil;
1023	<	IBDataBaseError;
1022	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1023	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1024	>	FCreateDatabase := true
1025	>	else
1026	>	raise EIBInterBaseError.Create(Status);
1027		end;
1028	<	until FHandle <> nil;
1028	>	until FAttachment <> nil;
1029		if not (csDesigning in ComponentState) then
1030		FDBName := aDBName; {Synchronise at run time}
1031		FDBSQLDialect := GetDBSQLDialect;
#	Line 1143 | Line 1037 | begin
1037		end;
1038		if not (csDesigning in ComponentState) then
1039		MonitorHook.DBConnect(Self);
1146	–	LoadCharSetInfo;
1040		end;
1041
1042		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 1246 | Line 1139 | begin
1139		FDefaultTransaction := Value;
1140		end;
1141
1249	–	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1250	–	begin
1251	–	if HandleIsShared then
1252	–	Close
1253	–	else
1254	–	CheckInactive;
1255	–	FHandle := Value;
1256	–	FHandleIsShared := (Value <> nil);
1257	–	end;
1258	–
1142		procedure TIBDataBase.SetIdleTimer(Value: Integer);
1143		begin
1144		if Value < 0 then
#	Line 1300 | Line 1183 | end;
1183		begin
1184		if Connected then
1185		begin
1186	<	if FCanTimeout then
1186	>	if not FAttachment.HasActivity then
1187		begin
1188		ForceClose;
1189		if Assigned(FOnIdleTimer) then
1190		FOnIdleTimer(Self);
1191		end
1309	–	else
1310	–	FCanTimeout := True;
1192		end;
1193		end;
1194
#	Line 1338 | Line 1219 | end;
1219		procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1220		begin
1221		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1222	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1222	>	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1223		FSQLDialect := Value
1224		else
1225		IBError(ibxeSQLDialectInvalid, [nil]);
#	Line 1457 | Line 1338 | begin
1338		BeginUpdate;
1339		try
1340		Clear;
1341	<	while (not Query.EOF) and (Query.Next <> nil) do
1342	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1341	>	while (not Query.EOF) and Query.Next  do
1342	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1343		finally
1344		EndUpdate;
1345		end;
#	Line 1497 | Line 1378 | begin
1378		BeginUpdate;
1379		try
1380		Clear;
1381	<	while (not Query.EOF) and (Query.Next <> nil) do
1382	<	List.Add(TrimRight(Query.Current[0].AsString));
1381	>	while (not Query.EOF) and Query.Next  do
1382	>	List.Add(TrimRight(Query.Fields[0].AsString));
1383		finally
1384		EndUpdate;
1385		end;
#	Line 1515 | Line 1396 | end;
1396		constructor TIBTransaction.Create(AOwner: TComponent);
1397		begin
1398		inherited Create(AOwner);
1518	–	FIBLoaded := False;
1519	–	CheckIBLoaded;
1520	–	FIBLoaded := True;
1521	–	CheckIBLoaded;
1399		FDatabases := TList.Create;
1400		FSQLObjects := TList.Create;
1524	–	FHandle := nil;
1401		FTPB := nil;
1526	–	FTPBLength := 0;
1402		FTRParams := TStringList.Create;
1403		FTRParamsChanged := True;
1404		TStringList(FTRParams).OnChange := TRParamsChange;
#	Line 1539 | Line 1414 | destructor TIBTransaction.Destroy;
1414		var
1415		i: Integer;
1416		begin
1417	<	if FIBLoaded then
1418	<	begin
1419	<	if InTransaction then
1420	<	EndTransaction(FDefaultAction, True);
1421	<	for i := 0 to FSQLObjects.Count - 1 do
1422	<	if FSQLObjects[i] <> nil then
1423	<	SQLObjects[i].DoTransactionFree;
1424	<	RemoveSQLObjects;
1425	<	RemoveDatabases;
1426	<	FreeMem(FTPB);
1427	<	FTPB := nil;
1553	<	FTRParams.Free;
1554	<	FSQLObjects.Free;
1555	<	FDatabases.Free;
1556	<	end;
1417	>	if InTransaction then
1418	>	EndTransaction(FDefaultAction, True);
1419	>	for i := 0 to FSQLObjects.Count - 1 do
1420	>	if FSQLObjects[i] <> nil then
1421	>	SQLObjects[i].DoTransactionFree;
1422	>	RemoveSQLObjects;
1423	>	RemoveDatabases;
1424	>	FTPB := nil;
1425	>	FTRParams.Free;
1426	>	FSQLObjects.Free;
1427	>	FDatabases.Free;
1428		inherited Destroy;
1429		end;
1430
1560	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1561	–	RaiseError: Boolean): ISC_STATUS;
1562	–	var
1563	–	i: Integer;
1564	–	begin
1565	–	result := ErrCode;
1566	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1567	–	Databases[i].FCanTimeout := False;
1568	–	FCanTimeout := False;
1569	–	if RaiseError and (result > 0) then
1570	–	IBDataBaseError;
1571	–	end;
1572	–
1431		procedure TIBTransaction.CheckDatabasesInList;
1432		begin
1433		if GetDatabaseCount = 0 then
#	Line 1580 | Line 1438 | procedure TIBTransaction.CheckInTransact
1438		begin
1439		if FStreamedActive and (not InTransaction) then
1440		Loaded;
1441	<	if (FHandle = nil) then
1441	>	if (TransactionIntf = nil) then
1442		IBError(ibxeNotInTransaction, [nil]);
1443		end;
1444
#	Line 1636 | Line 1494 | procedure TIBTransaction.EnsureNotInTran
1494		begin
1495		if csDesigning in ComponentState then
1496		begin
1497	<	if FHandle <> nil then
1497	>	if TransactionIntf <> nil then
1498		Rollback;
1499		end;
1500		end;
1501
1502		procedure TIBTransaction.CheckNotInTransaction;
1503		begin
1504	<	if (FHandle <> nil) then
1504	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1505		IBError(ibxeInTransaction, [nil]);
1506		end;
1507
#	Line 1652 | Line 1510 | var
1510		i: Integer;
1511		NilFound: Boolean;
1512		begin
1513	+	EnsureNotInTransaction;
1514	+	CheckNotInTransaction;
1515	+	FTransactionIntf := nil;
1516	+
1517		i := FindDatabase(db);
1518		if i <> -1 then
1519		begin
#	Line 1702 | Line 1564 | end;
1564		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1565		Force: Boolean);
1566		var
1705	–	status: ISC_STATUS;
1567		i: Integer;
1568		begin
1569		CheckInTransaction;
#	Line 1713 | Line 1574 | begin
1574		case Action of
1575		TARollback, TACommit:
1576		begin
1716	–	if (HandleIsShared) and
1717	–	(Action <> FDefaultAction) and
1718	–	(not Force) then
1719	–	IBError(ibxeCantEndSharedTransaction, [nil]);
1577		DoBeforeTransactionEnd;
1578		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1579		SQLObjects[i].DoBeforeTransactionEnd(Action);
1580		if InTransaction then
1581		begin
1582	<	if HandleIsShared then
1583	<	begin
1727	<	FHandle := nil;
1728	<	FHandleIsShared := False;
1729	<	status := 0;
1730	<	end
1731	<	else
1732	<	if (Action = TARollback) then
1733	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1734	<	else
1735	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1736	<	if ((Force) and (status > 0)) then
1737	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1738	<	if Force then
1739	<	FHandle := nil
1582	>	if (Action = TARollback) then
1583	>	FTransactionIntf.Rollback(Force)
1584		else
1585	<	if (status > 0) then
1586	<	IBDataBaseError;
1585	>	try
1586	>	FTransactionIntf.Commit;
1587	>	except on E: EIBInterBaseError do
1588	>	begin
1589	>	if Force then
1590	>	FTransactionIntf.Rollback(Force)
1591	>	else
1592	>	raise;
1593	>	end;
1594	>	end;
1595	>
1596		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1597		SQLObjects[i].DoAfterTransactionEnd;
1598		DoAfterTransactionEnd;
1599		end;
1600		end;
1601		TACommitRetaining:
1602	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1602	>	FTransactionIntf.CommitRetaining;
1603	>
1604		TARollbackRetaining:
1605	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1605	>	FTransactionIntf.RollbackRetaining;
1606		end;
1607		if not (csDesigning in ComponentState) then
1608		begin
#	Line 1800 | Line 1654 | end;
1654
1655		function TIBTransaction.GetInTransaction: Boolean;
1656		begin
1657	<	result := (FHandle <> nil);
1657	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1658		end;
1659
1660		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1856 | Line 1710 | procedure TIBTransaction.BeforeDatabaseD
1710		begin
1711		if InTransaction then
1712		EndTransaction(FDefaultAction, True);
1713	+	FTransactionIntf := nil;
1714		end;
1715
1716		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1864 | Line 1719 | var
1719		begin
1720		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1721		begin
1722	+	EnsureNotInTransaction;
1723	+	CheckNotInTransaction;
1724	+	FTransactionIntf := nil;
1725	+
1726		DB := Databases[Idx];
1727		FDatabases[Idx] := nil;
1728		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1876 | Line 1735 | procedure TIBTransaction.RemoveDatabases
1735		var
1736		i: Integer;
1737		begin
1738	+	EnsureNotInTransaction;
1739	+	CheckNotInTransaction;
1740	+	FTransactionIntf := nil;
1741	+
1742		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1743		RemoveDatabase(i);
1744		end;
#	Line 1922 | Line 1785 | begin
1785		Rollback;
1786		end;
1787
1925	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1926	–	begin
1927	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1928	–	IBError(ibxeIB60feature, [nil]);*)
1929	–	FDefaultAction := Value;
1930	–	end;
1931	–
1788		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1789		var
1790		i: integer;
#	Line 1951 | Line 1807 | begin
1807		FDefaultDatabase := Value;
1808		end;
1809
1954	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1955	–	begin
1956	–	if (HandleIsShared) then
1957	–	EndTransaction(DefaultAction, True)
1958	–	else
1959	–	CheckNotInTransaction;
1960	–	FHandle := Value;
1961	–	FHandleIsShared := (Value <> nil);
1962	–	end;
1963	–
1810		procedure TIBTransaction.Notification( AComponent: TComponent;
1811		Operation: TOperation);
1812		var
#	Line 2002 | Line 1848 | end;
1848
1849		procedure TIBTransaction.StartTransaction;
1850		var
2005	–	pteb: PISC_TEB_ARRAY;
2006	–	TPB: String;
1851		i: Integer;
1852	+	Attachments: array of IAttachment;
1853	+	ValidDatabaseCount: integer;
1854		begin
1855		CheckNotInTransaction;
1856		CheckDatabasesInList;
1857	+	if TransactionIntf <> nil then
1858	+	begin
1859	+	TransactionIntf.Start(DefaultAction);
1860	+	Exit;
1861	+	end;
1862	+
1863		for i := 0 to FDatabases.Count - 1 do
1864		if  FDatabases[i] <> nil then
1865		begin
1866		with TIBDatabase(FDatabases[i]) do
1867		if not Connected then
1868	<	if FStreamedConnected then
1868	>	if StreamedConnected then
1869		begin
1870		Open;
1871	<	FStreamedConnected := False;
1871	>	StreamedConnected := False;
1872		end
1873		else
1874		IBError(ibxeDatabaseClosed, [nil]);
#	Line 2024 | Line 1876 | begin
1876		if FTRParamsChanged then
1877		begin
1878		FTRParamsChanged := False;
1879	<	GenerateTPB(FTRParams, TPB, FTPBLength);
2028	<	if FTPBLength > 0 then
2029	<	begin
2030	<	IBAlloc(FTPB, 0, FTPBLength);
2031	<	Move(TPB[1], FTPB[0], FTPBLength);
2032	<	end;
1879	>	FTPB :=  GenerateTPB(FTRParams);
1880		end;
1881
1882	<	pteb := nil;
1883	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1884	<	try
1885	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1886	<	begin
1887	<	pteb^[i].db_handle := @(Databases[i].Handle);
1888	<	pteb^[i].tpb_length := FTPBLength;
1889	<	pteb^[i].tpb_address := FTPB;
1890	<	end;
1891	<	if Call(isc_start_multiple(StatusVector, @FHandle,
1892	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1893	<	begin
1894	<	FHandle := nil;
1895	<	IBDataBaseError;
2049	<	end;
2050	<	if not (csDesigning in ComponentState) then
2051	<	MonitorHook.TRStart(Self);
2052	<	finally
2053	<	FreeMem(pteb);
1882	>	ValidDatabaseCount := 0;
1883	>	for i := 0 to DatabaseCount - 1 do
1884	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1885	>
1886	>	if ValidDatabaseCount = 1 then
1887	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1888	>	else
1889	>	begin
1890	>	SetLength(Attachments,ValidDatabaseCount);
1891	>	for i := 0 to DatabaseCount - 1 do
1892	>	if Databases[i] <> nil then
1893	>	Attachments[i] := Databases[i].Attachment;
1894	>
1895	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1896		end;
1897	+
1898	+	if not (csDesigning in ComponentState) then
1899	+	MonitorHook.TRStart(Self);
1900		DoOnStartTransaction;
1901		end;
1902
#	Line 2059 | Line 1904 | procedure TIBTransaction.TimeoutTransact
1904		begin
1905		if InTransaction then
1906		begin
1907	<	if FCanTimeout then
1907	>	if not TransactionIntf.HasActivity then
1908		begin
1909		EndTransaction(FDefaultAction, True);
1910		if Assigned(FOnIdleTimer) then
1911		FOnIdleTimer(Self);
1912		end
2068	–	else
2069	–	FCanTimeout := True;
1913		end;
1914		end;
1915
#	Line 2079 | Line 1922 | procedure TIBTransaction.TRParamsChangin
1922		begin
1923		EnsureNotInTransaction;
1924		CheckNotInTransaction;
1925	+	FTransactionIntf := nil;
1926		end;
1927
1928		{ TIBBase }
#	Line 2094 | Line 1938 | begin
1938		inherited Destroy;
1939		end;
1940
2097	–	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2098	–	begin
2099	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2100	–	Result := Database.FCharSetSizes[CharSetID]
2101	–	else
2102	–	Result := 1; {Unknown character set}
2103	–	end;
2104	–
2105	–	function TIBBase.GetDefaultCharSetSize: integer;
2106	–	var DefaultCharSetName: string;
2107	–	i: integer;
2108	–	begin
2109	–	DefaultCharSetName := GetDefaultCharSetName;
2110	–	Result := 4; {worse case}
2111	–	for i := 0 to Length(Database.FCharSetSizes) - 1 do
2112	–	if Database.FCharSetNames[i] = DefaultCharSetName then
2113	–	begin
2114	–	Result := Database.FCharSetSizes[i];
2115	–	break;
2116	–	end;
2117	–	end;
2118	–
2119	–	function TIBBase.GetCharSetName(CharSetID: integer): string;
2120	–	begin
2121	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2122	–	Result := Database.FCharSetNames[CharSetID]
2123	–	else
2124	–	Result := ''; {Unknown character set}
2125	–	end;
2126	–
2127	–	function TIBBase.GetDefaultCharSetName: RawByteString;
2128	–	begin
2129	–	Result := Database.FDefaultCharSetName;
2130	–	end;
2131	–
2132	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2133	–	function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134	–	begin
2135	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
2136	–	Result := Database.FCodePages[CharSetID]
2137	–	else
2138	–	Result := CP_NONE; {Unknown character set}
2139	–	end;
2140	–
2141	–	function TIBBase.GetDefaultCodePage: TSystemCodePage;
2142	–	begin
2143	–	Result := Database.FDefaultCodePage;
2144	–	end;
2145	–
2146	–	{$ENDIF}
2147	–
1941		procedure TIBBase.HandleException(Sender: TObject);
1942		begin
1943		if assigned(Database) then
#	Line 2183 | Line 1976 | begin
1976		FTransaction.CheckInTransaction;
1977		end;
1978
2186	–	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2187	–	begin
2188	–	CheckDatabase;
2189	–	result := @FDatabase.Handle;
2190	–	end;
2191	–
2192	–	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2193	–	begin
2194	–	CheckTransaction;
2195	–	result := @FTransaction.Handle;
2196	–	end;
2197	–
1979		procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1980		);
1981		begin
#	Line 2309 | Line 2090 | end;
2090		parameter buffer, and return it and its length
2091		in DPB and DPBLength, respectively. }
2092
2093	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2093	>	function GenerateDPB(sl: TStrings): IDPB;
2094		var
2095	<	i, j, pval: Integer;
2095	>	i, j: Integer;
2096		DPBVal: UShort;
2097		ParamName, ParamValue: string;
2098		begin
2099	<	{ The DPB is initially empty, with the exception that
2319	<	the DPB version must be the first byte of the string. }
2320	<	DPBLength := 1;
2321	<	DPB := Char(isc_dpb_version1);
2099	>	Result := FirebirdAPI.AllocateDPB;
2100
2101		{Iterate through the textual database parameters, constructing
2102		a DPB on-the-fly }
#	Line 2357 | Line 2135 | begin
2135		begin
2136		if DPBVal = isc_dpb_sql_dialect then
2137		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2138	<	DPB := DPB +
2361	<	Char(DPBVal) +
2362	<	Char(Length(ParamValue)) +
2363	<	ParamValue;
2364	<	Inc(DPBLength, 2 + Length(ParamValue));
2138	>	Result.Add(DPBVal).SetAsString(ParamValue);
2139		end;
2140	+
2141		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2142		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2143	<	begin
2144	<	DPB := DPB +
2370	<	Char(DPBVal) +
2371	<	#1 +
2372	<	Char(StrToInt(ParamValue));
2373	<	Inc(DPBLength, 3);
2374	<	end;
2143	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2144	>
2145		isc_dpb_sweep:
2146	<	begin
2147	<	DPB := DPB +
2378	<	Char(DPBVal) +
2379	<	#1 +
2380	<	Char(isc_dpb_records);
2381	<	Inc(DPBLength, 3);
2382	<	end;
2146	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2147	>
2148		isc_dpb_sweep_interval:
2149	<	begin
2150	<	pval := StrToInt(ParamValue);
2386	<	DPB := DPB +
2387	<	Char(DPBVal) +
2388	<	#4 +
2389	<	PChar(@pval)[0] +
2390	<	PChar(@pval)[1] +
2391	<	PChar(@pval)[2] +
2392	<	PChar(@pval)[3];
2393	<	Inc(DPBLength, 6);
2394	<	end;
2149	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2150	>
2151		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2152		isc_dpb_quit_log:
2153	<	begin
2398	<	DPB := DPB +
2399	<	Char(DPBVal) +
2400	<	#1 + #0;
2401	<	Inc(DPBLength, 3);
2402	<	end;
2153	>	Result.Add(DPBVal).SetAsByte(0);
2154		else
2155		begin
2156		if (DPBVal > 0) and
#	Line 2417 | Line 2168 | end;
2168		of the transaction parameters, generate a transaction
2169		parameter buffer, and return it and its length in
2170		TPB and TPBLength, respectively. }
2171	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2171	>	function GenerateTPB(sl: TStrings): ITPB;
2172		var
2173	<	i, j, TPBVal, ParamLength: Integer;
2173	>	i, j, TPBVal: Integer;
2174		ParamName, ParamValue: string;
2175		begin
2176	<	TPB := '';
2426	<	if (sl.Count = 0) then
2427	<	TPBLength := 0
2428	<	else
2429	<	begin
2430	<	TPBLength := sl.Count + 1;
2431	<	TPB := TPB + Char(isc_tpb_version3);
2432	<	end;
2176	>	Result := FirebirdAPI.AllocateTPB;
2177		for i := 0 to sl.Count - 1 do
2178		begin
2179		if (Trim(sl[i]) =  '') then
2436	–	begin
2437	–	Dec(TPBLength);
2180		Continue;
2181	<	end;
2181	>
2182		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2183		ParamName := LowerCase(sl[i]) {mbcs ok}
2184		else
#	Line 2460 | Line 2202 | begin
2202		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2203		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2204		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2205	<	TPB := TPB + Char(TPBVal);
2205	>	Result.Add(TPBVal);
2206	>
2207		isc_tpb_lock_read, isc_tpb_lock_write:
2208	<	begin
2209	<	TPB := TPB + Char(TPBVal);
2467	<	{ Now set the string parameter }
2468	<	ParamLength := Length(ParamValue);
2469	<	Inc(TPBLength, ParamLength + 1);
2470	<	TPB := TPB + Char(ParamLength) + ParamValue;
2471	<	end;
2208	>	Result.Add(TPBVal).SetAsString(ParamValue);
2209	>
2210		else
2211		begin
2212		if (TPBVal > 0) and

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines