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 35 by tony, Tue Jan 26 14:38:47 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	+	{$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;
186	<	FCharSetNames: array of string;
199	>	FUseDefaultSystemCodePage: boolean;
200		procedure EnsureInactive;
201		function GetDBSQLDialect: Integer;
202		function GetSQLDialect: Integer;
#	Line 193 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
196	–	function GetDBParamByDPB(const Idx: Integer): String;
209		function GetIdleTimer: Integer;
210		function GetTransaction(Index: Integer): TIBTransaction;
211		function GetTransactionCount: Integer;
212	<	function Login: Boolean;
201	<	procedure LoadCharSetInfo;
212	>	function Login(var aDatabaseName: string): Boolean;
213		procedure SetDatabaseName(const Value: TIBFileName);
214		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215		procedure SetDBParams(Value: TStrings);
#	Line 237 | Line 248 | type
248		function IndexOfDBConst(st: String): Integer;
249		function TestConnected: Boolean;
250		procedure CheckDatabaseName;
240	–	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;
246	–	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;
250	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
251	–	write SetDBParamByDPB;
260		property SQLObjectCount: Integer read GetSQLObjectCount;
261		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
254	–	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;
267	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
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 268 | 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;
271	–	property DBSQLDialect : Integer read FDBSQLDialect;
282		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
283	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
284	+	write FUseDefaultSystemCodePage;
285		property AfterConnect;
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 292 | Line 306 | type
306		FAfterPost: TNotifyEvent;
307		FAfterTransactionEnd: TNotifyEvent;
308		FBeforeTransactionEnd: TNotifyEvent;
295	–	FIBLoaded: Boolean;
296	–	FCanTimeout         : Boolean;
309		FDatabases          : TList;
310		FOnStartTransaction: TNotifyEvent;
311		FSQLObjects         : TList;
312		FDefaultDatabase    : TIBDatabase;
301	–	FHandle             : TISC_TR_HANDLE;
302	–	FHandleIsShared     : Boolean;
313		FOnIdleTimer          : TNotifyEvent;
314		FStreamedActive     : Boolean;
315	<	FTPB                : PChar;
306	<	FTPBLength          : Short;
315	>	FTPB                : ITPB;
316		FTimer              : TFPTimer;
317	<	FDefaultAction      : TTransactionAction;
317	>	FDefaultAction      : TDefaultEndAction;
318		FTRParams           : TStrings;
319		FTRParamsChanged    : Boolean;
320		FInEndTransaction   : boolean;
#	Line 328 | Line 337 | type
337		function GetIdleTimer: Integer;
338		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
339		procedure SetActive(Value: Boolean);
331	–	procedure SetDefaultAction(Value: TTransactionAction);
340		procedure SetDefaultDatabase(Value: TIBDatabase);
341		procedure SetIdleTimer(Value: Integer);
342		procedure SetTRParams(Value: TStrings);
#	Line 341 | Line 349 | type
349
350		protected
351		procedure Loaded; override;
344	–	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;
350	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
357		procedure Commit;
358		procedure CommitRetaining;
359		procedure Rollback;
#	Line 368 | 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;
371	–	property Handle: TISC_TR_HANDLE read FHandle;
372	–	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 429 | Line 433 | type
433		procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
434		procedure DoAfterTransactionEnd; virtual;
435		procedure DoTransactionFree; virtual;
432	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
433	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
436		procedure SetDatabase(Value: TIBDatabase); virtual;
437		procedure SetTransaction(Value: TIBTransaction); virtual;
438		public
#	Line 443 | Line 445 | type
445		procedure DoAfterDelete(Sender: TObject); virtual;
446		procedure DoAfterInsert(Sender: TObject); virtual;
447		procedure DoAfterPost(Sender: TObject); virtual;
446	–	function GetCharSetSize(CharSetID: integer): integer;
447	–	function GetDefaultCharSetSize: integer;
448	–	function GetCharSetName(CharSetID: integer): string;
449	–	function GetDefaultCharSetName: string;
448		procedure HandleException(Sender: TObject);
449		procedure SetCursor;
450		procedure RestoreCursor;
#	Line 465 | Line 463 | type
463		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
464		property Database: TIBDatabase read FDatabase
465		write SetDatabase;
468	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
466		property Owner: TObject read FOwner;
470	–	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;
477	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478	>	typInfo, FBMessages, IBErrorCodes;
479
480		{ TIBDatabase }
481
482	<	constructor TIBDataBase.Create(AOwner: TComponent);
487	<	{$ifdef WINDOWS}
488	<	var acp: uint;
489	<	{$endif}
482	>	constructor TIBDataBase.Create(AOwner: TComponent);
483		begin
484		inherited Create(AOwner);
492	–	FIBLoaded := False;
493	–	CheckIBLoaded;
494	–	FIBLoaded := True;
485		LoginPrompt := True;
486		FSQLObjects := TList.Create;
487		FTransactions := TList.Create;
#	Line 502 | Line 492 | begin
492		(AOwner is TCustomApplication) and
493		TCustomApplication(AOWner).ConsoleApplication then
494		LoginPrompt := false;
505	–	{$ifdef UNIX}
506	–	if csDesigning in ComponentState then
507	–	FDBParams.Add('lc_ctype=UTF8');
508	–	{$else}
509	–	{$ifdef WINDOWS}
510	–	if csDesigning in ComponentState then
511	–	begin
512	–	acp := GetACP;
513	–	if (acp >= 1250) and (acp <= 1254) then
514	–	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515	–	end;
516	–	{$endif}
517	–	{$endif}
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
558		procedure TIBDataBase.CheckDatabaseName;
559		begin
560	<	if (FDBName = '') then
560	>	if (Trim(FDBName) = '') then
561		IBError(ibxeDatabaseNameMissing, [nil]);
562		end;
563
#	Line 633 | Line 596 | begin
596		if Connected then
597		InternalClose(False);
598		FDBSQLDialect := 1;
599	<	SetLength(FCharSetSizes,0);
600	<	SetLength(FCharSetNames,0);
599	>	FDefaultCharSetName := '';
600	>	FDefaultCharSetID := 0;
601	>	FDefaultCodePage := CP_NONE;
602		end;
603
604	<	procedure TIBDataBase.CreateDatabase;
641	<	var
642	<	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,
648	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
649	<	Params.Text), SQLDialect, nil),
650	<	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 706 | 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 723 | Line 683 | begin
683		Inc(result);
684		end;
685
686	<	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
727	<	var
728	<	ConstIdx, EqualsIdx: Integer;
729	<	begin
730	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
731	<	begin
732	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
733	<	if ConstIdx = -1 then
734	<	result := ''
735	<	else
736	<	begin
737	<	result := Params[ConstIdx];
738	<	EqualsIdx := Pos('=', result); {mbcs ok}
739	<	if EqualsIdx = 0 then
740	<	result := ''
741	<	else
742	<	result := Copy(result, EqualsIdx + 1, Length(result));
743	<	end;
744	<	end
745	<	else
746	<	result := '';
747	<	end;
748	<
749	<	function TIBDataBase.GetIdleTimer: Integer;
686	>	function TIBDataBase.GetIdleTimer: Integer;
687		begin
688		result := FTimer.Interval;
689		end;
#	Line 811 | Line 748 | begin
748		end;
749		end;
750
751	<	if (not HandleIsShared) and
752	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
816	<	(not Force) then
817	<	IBDataBaseError
818	<	else
819	<	begin
820	<	FHandle := nil;
821	<	FHandleIsShared := False;
822	<	end;
751	>	FAttachment.Disconnect(Force);
752	>	FAttachment := nil;
753
754		if not (csDesigning in ComponentState) then
755		MonitorHook.DBDisconnect(Self);
#	Line 829 | Line 759 | begin
759		SQLObjects[i].DoAfterDatabaseDisconnect;
760		end;
761
832	–	procedure TIBDataBase.LoadCharSetInfo;
833	–	var Query: TIBSQL;
834	–	i: integer;
835	–	begin
836	–	if not FInternalTransaction.Active then
837	–	FInternalTransaction.StartTransaction;
838	–	Query := TIBSQL.Create(self);
839	–	try
840	–	Query.Database := Self;
841	–	Query.Transaction := FInternalTransaction;
842	–	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
843	–	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
844	–	Query.Prepare;
845	–	Query.ExecQuery;
846	–	if not Query.EOF then
847	–	begin
848	–	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
849	–	SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
850	–	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
851	–	repeat
852	–	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
853	–	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
854	–	FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
855	–	Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
856	–	Query.Next;
857	–	until Query.EOF;
858	–	end;
859	–	finally
860	–	Query.free;
861	–	FInternalTransaction.Commit;
862	–	end;
863	–	end;
864	–
762		procedure TIBDataBase.CheckStreamConnect;
763		var
764		i: integer;
#	Line 884 | 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 925 | Line 822 | begin
822		end;
823		end;
824
825	<	function TIBDataBase.Login: Boolean;
825	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
826		var
827		IndexOfUser, IndexOfPassword: Integer;
828		Username, Password, OldPassword: String;
#	Line 961 | Line 858 | begin
858		LoginParams.Assign(Params);
859		FOnLogin(Self, LoginParams);
860		Params.Assign (LoginParams);
861	+	aDatabaseName := FDBName;
862		HidePassword;
863		finally
864		LoginParams.Free;
#	Line 982 | Line 880 | begin
880		Length(Params[IndexOfPassword]));
881		OldPassword := password;
882		end;
883	<	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
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 1010 | Line 915 | end;
915
916		procedure TIBDataBase.DoConnect;
917		var
1013	–	DPB: String;
918		TempDBParams: TStrings;
919		I: integer;
920		aDBName: string;
921	+	Status: IStatus;
922	+	CharSetID: integer;
923		begin
924		CheckInactive;
925		CheckDatabaseName;
#	Line 1023 | Line 929 | begin
929		FDBParamsChanged := True;
930		end;
931		{ Use builtin login prompt if requested }
932	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
932	>	aDBName := FDBName;
933	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
934		IBError(ibxeOperationCancelled, [nil]);
935
936		TempDBParams := TStringList.Create;
937		try
938		TempDBParams.Assign(FDBParams);
939	<	aDBName := FDBName;
939	>	if UseDefaultSystemCodePage then
940	>	begin
941	>	{$ifdef WINDOWS}
942	>	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
943	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
944	>	{$else}
945	>	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
947	>	{$endif}
948	>	else
949	>	TempDBParams.Values['lc_ctype'] :='UTF8';
950	>	end;
951		{Opportunity to override defaults}
952		for i := 0 to FSQLObjects.Count - 1 do
953		begin
#	Line 1037 | Line 955 | begin
955		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
956		end;
957
958	+	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
959	+	if FDefaultCharSetName <> '' then
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;
1051	–	IBAlloc(FDPB, 0, FDPBLength);
1052	–	Move(DPB[1], FDPB[0], FDPBLength);
973		end;
974		finally
975		TempDBParams.Free;
976		end;
977	<	if Call(isc_attach_database(StatusVector, Length(aDBName),
978	<	PChar(aDBName), @FHandle,
979	<	FDPBLength, FDPB), False) > 0 then
980	<	begin
981	<	FHandle := nil;
982	<	IBDataBaseError;
983	<	end;
977	>
978	>	repeat
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 Pos(':',aDBName) = 0 then
993	>	begin
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	>	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 FAttachment <> nil;
1015		if not (csDesigning in ComponentState) then
1016		FDBName := aDBName; {Synchronise at run time}
1017		FDBSQLDialect := GetDBSQLDialect;
#	Line 1072 | Line 1023 | begin
1023		end;
1024		if not (csDesigning in ComponentState) then
1025		MonitorHook.DBConnect(Self);
1075	–	LoadCharSetInfo;
1026		end;
1027
1028		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 1175 | Line 1125 | begin
1125		FDefaultTransaction := Value;
1126		end;
1127
1178	–	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1179	–	begin
1180	–	if HandleIsShared then
1181	–	Close
1182	–	else
1183	–	CheckInactive;
1184	–	FHandle := Value;
1185	–	FHandleIsShared := (Value <> nil);
1186	–	end;
1187	–
1128		procedure TIBDataBase.SetIdleTimer(Value: Integer);
1129		begin
1130		if Value < 0 then
#	Line 1229 | 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
1238	–	else
1239	–	FCanTimeout := True;
1178		end;
1179		end;
1180
#	Line 1267 | 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 1386 | 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 1426 | 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 1444 | Line 1382 | end;
1382		constructor TIBTransaction.Create(AOwner: TComponent);
1383		begin
1384		inherited Create(AOwner);
1447	–	FIBLoaded := False;
1448	–	CheckIBLoaded;
1449	–	FIBLoaded := True;
1450	–	CheckIBLoaded;
1385		FDatabases := TList.Create;
1386		FSQLObjects := TList.Create;
1453	–	FHandle := nil;
1387		FTPB := nil;
1455	–	FTPBLength := 0;
1388		FTRParams := TStringList.Create;
1389		FTRParamsChanged := True;
1390		TStringList(FTRParams).OnChange := TRParamsChange;
#	Line 1468 | 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;
1482	<	FTRParams.Free;
1483	<	FSQLObjects.Free;
1484	<	FDatabases.Free;
1485	<	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
1489	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1490	–	RaiseError: Boolean): ISC_STATUS;
1491	–	var
1492	–	i: Integer;
1493	–	begin
1494	–	result := ErrCode;
1495	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1496	–	Databases[i].FCanTimeout := False;
1497	–	FCanTimeout := False;
1498	–	if RaiseError and (result > 0) then
1499	–	IBDataBaseError;
1500	–	end;
1501	–
1417		procedure TIBTransaction.CheckDatabasesInList;
1418		begin
1419		if GetDatabaseCount = 0 then
#	Line 1509 | 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 1565 | 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 1581 | 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 1631 | Line 1550 | end;
1550		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1551		Force: Boolean);
1552		var
1634	–	status: ISC_STATUS;
1553		i: Integer;
1554		begin
1555		CheckInTransaction;
#	Line 1642 | Line 1560 | begin
1560		case Action of
1561		TARollback, TACommit:
1562		begin
1645	–	if (HandleIsShared) and
1646	–	(Action <> FDefaultAction) and
1647	–	(not Force) then
1648	–	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
1656	<	FHandle := nil;
1657	<	FHandleIsShared := False;
1658	<	status := 0;
1659	<	end
1660	<	else
1661	<	if (Action = TARollback) then
1662	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1663	<	else
1664	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1665	<	if ((Force) and (status > 0)) then
1666	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1667	<	if Force then
1668	<	FHandle := nil
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 1729 | 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 1785 | 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 1793 | 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 1805 | 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 1851 | Line 1771 | begin
1771		Rollback;
1772		end;
1773
1854	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1855	–	begin
1856	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1857	–	IBError(ibxeIB60feature, [nil]);*)
1858	–	FDefaultAction := Value;
1859	–	end;
1860	–
1774		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1775		var
1776		i: integer;
#	Line 1880 | Line 1793 | begin
1793		FDefaultDatabase := Value;
1794		end;
1795
1883	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1884	–	begin
1885	–	if (HandleIsShared) then
1886	–	EndTransaction(DefaultAction, True)
1887	–	else
1888	–	CheckNotInTransaction;
1889	–	FHandle := Value;
1890	–	FHandleIsShared := (Value <> nil);
1891	–	end;
1892	–
1796		procedure TIBTransaction.Notification( AComponent: TComponent;
1797		Operation: TOperation);
1798		var
#	Line 1931 | Line 1834 | end;
1834
1835		procedure TIBTransaction.StartTransaction;
1836		var
1934	–	pteb: PISC_TEB_ARRAY;
1935	–	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 1953 | Line 1862 | begin
1862		if FTRParamsChanged then
1863		begin
1864		FTRParamsChanged := False;
1865	<	GenerateTPB(FTRParams, TPB, FTPBLength);
1957	<	if FTPBLength > 0 then
1958	<	begin
1959	<	IBAlloc(FTPB, 0, FTPBLength);
1960	<	Move(TPB[1], FTPB[0], FTPBLength);
1961	<	end;
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;
1978	<	end;
1979	<	if not (csDesigning in ComponentState) then
1980	<	MonitorHook.TRStart(Self);
1981	<	finally
1982	<	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 1988 | 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
1997	–	else
1998	–	FCanTimeout := True;
1899		end;
1900		end;
1901
#	Line 2008 | Line 1908 | procedure TIBTransaction.TRParamsChangin
1908		begin
1909		EnsureNotInTransaction;
1910		CheckNotInTransaction;
1911	+	FTransactionIntf := nil;
1912		end;
1913
1914		{ TIBBase }
#	Line 2023 | Line 1924 | begin
1924		inherited Destroy;
1925		end;
1926
2026	–	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2027	–	begin
2028	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2029	–	Result := Database.FCharSetSizes[CharSetID]
2030	–	else
2031	–	Result := 1; {Unknown character set}
2032	–	end;
2033	–
2034	–	function TIBBase.GetDefaultCharSetSize: integer;
2035	–	var DefaultCharSetName: string;
2036	–	i: integer;
2037	–	begin
2038	–	DefaultCharSetName := GetDefaultCharSetName;
2039	–	Result := 4; {worse case}
2040	–	for i := 0 to Length(Database.FCharSetSizes) - 1 do
2041	–	if Database.FCharSetNames[i] = DefaultCharSetName then
2042	–	begin
2043	–	Result := Database.FCharSetSizes[i];
2044	–	break;
2045	–	end;
2046	–	end;
2047	–
2048	–	function TIBBase.GetCharSetName(CharSetID: integer): string;
2049	–	begin
2050	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2051	–	Result := Database.FCharSetNames[CharSetID]
2052	–	else
2053	–	Result := ''; {Unknown character set}
2054	–	end;
2055	–
2056	–	function TIBBase.GetDefaultCharSetName: string;
2057	–	begin
2058	–	Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2059	–	end;
2060	–
1927		procedure TIBBase.HandleException(Sender: TObject);
1928		begin
1929		if assigned(Database) then
#	Line 2096 | Line 1962 | begin
1962		FTransaction.CheckInTransaction;
1963		end;
1964
2099	–	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2100	–	begin
2101	–	CheckDatabase;
2102	–	result := @FDatabase.Handle;
2103	–	end;
2104	–
2105	–	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2106	–	begin
2107	–	CheckTransaction;
2108	–	result := @FTransaction.Handle;
2109	–	end;
2110	–
1965		procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1966		);
1967		begin
#	Line 2222 | 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
2232	<	the DPB version must be the first byte of the string. }
2233	<	DPBLength := 1;
2234	<	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 2270 | Line 2121 | begin
2121		begin
2122		if DPBVal = isc_dpb_sql_dialect then
2123		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2124	<	DPB := DPB +
2274	<	Char(DPBVal) +
2275	<	Char(Length(ParamValue)) +
2276	<	ParamValue;
2277	<	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 +
2283	<	Char(DPBVal) +
2284	<	#1 +
2285	<	Char(StrToInt(ParamValue));
2286	<	Inc(DPBLength, 3);
2287	<	end;
2129	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2130	>
2131		isc_dpb_sweep:
2132	<	begin
2133	<	DPB := DPB +
2291	<	Char(DPBVal) +
2292	<	#1 +
2293	<	Char(isc_dpb_records);
2294	<	Inc(DPBLength, 3);
2295	<	end;
2132	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2133	>
2134		isc_dpb_sweep_interval:
2135	<	begin
2136	<	pval := StrToInt(ParamValue);
2299	<	DPB := DPB +
2300	<	Char(DPBVal) +
2301	<	#4 +
2302	<	PChar(@pval)[0] +
2303	<	PChar(@pval)[1] +
2304	<	PChar(@pval)[2] +
2305	<	PChar(@pval)[3];
2306	<	Inc(DPBLength, 6);
2307	<	end;
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
2311	<	DPB := DPB +
2312	<	Char(DPBVal) +
2313	<	#1 + #0;
2314	<	Inc(DPBLength, 3);
2315	<	end;
2139	>	Result.Add(DPBVal).SetAsByte(0);
2140		else
2141		begin
2142		if (DPBVal > 0) and
#	Line 2330 | 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 := '';
2339	<	if (sl.Count = 0) then
2340	<	TPBLength := 0
2341	<	else
2342	<	begin
2343	<	TPBLength := sl.Count + 1;
2344	<	TPB := TPB + Char(isc_tpb_version3);
2345	<	end;
2162	>	Result := FirebirdAPI.AllocateTPB;
2163		for i := 0 to sl.Count - 1 do
2164		begin
2165		if (Trim(sl[i]) =  '') then
2349	–	begin
2350	–	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 2373 | 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);
2380	<	{ Now set the string parameter }
2381	<	ParamLength := Length(ParamValue);
2382	<	Inc(TPBLength, ParamLength + 1);
2383	<	TPB := TPB + Char(ParamLength) + ParamValue;
2384	<	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