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 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 49 by tony, Thu Feb 2 16:20:12 2017 UTC

#	Line 35 | Line 35 | unit IBDatabase;
35
36		{$Mode Delphi}
37
38	+	{$codepage UTF8}
39	+
40		interface
41
42		uses
#	Line 43 | Line 45 | uses
45		{$ELSE}
46		unix,
47		{$ENDIF}
48	<	SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
47	<	IB, CustApp;
48	>	SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49
50		const
51		DPBPrefix = 'isc_dpb_';
#	Line 115 | Line 116 | const
116		'set_db_readonly',
117		'set_db_sql_dialect',
118		'gfix_attach',
119	<	'gstat_attach'
119	>	'gstat_attach',
120	>	'set_db_charset',
121	>	'gsec_attach',
122	>	'address_path' ,
123	>	'process_id',
124	>	'no_db_triggers',
125	>	'trusted_auth',
126	>	'process_name',
127	>	'trusted_role',
128	>	'org_filename',
129	>	'utf8_ilename',
130	>	'ext_call_depth'
131		);
132
133		TPBPrefix = 'isc_tpb_';
#	Line 139 | Line 151 | const
151		'rec_version',
152		'no_rec_version',
153		'restart_requests',
154	<	'no_auto_undo'
154	>	'no_auto_undo',
155	>	'lock_timeout'
156		);
157
158		type
#	Line 155 | Line 168 | type
168		{ TIBDatabase }
169		TIBDataBase = class(TCustomConnection)
170		private
171	+	FAttachment: IAttachment;
172	+	FCreateDatabase: boolean;
173	+	FCreateIfNotExists: boolean;
174	+	FDefaultCharSetID: integer;
175	+	FDefaultCharSetName: RawByteString;
176	+	FDefaultCodePage: TSystemCodePage;
177	+	FDPB: IDPB;
178		FAllowStreamedConnected: boolean;
179		FHiddenPassword: string;
180	<	FIBLoaded: Boolean;
180	>	FOnCreateDatabase: TNotifyEvent;
181		FOnLogin: TIBDatabaseLoginEvent;
182		FSQLHourGlass: Boolean;
183		FTraceFlags: TTraceFlags;
184		FDBSQLDialect: Integer;
185		FSQLDialect: Integer;
186		FOnDialectDowngradeWarning: TNotifyEvent;
167	–	FCanTimeout: Boolean;
187		FSQLObjects: TList;
188		FTransactions: TList;
189		FDBName: TIBFileName;
190		FDBParams: TStrings;
191		FDBParamsChanged: Boolean;
173	–	FDPB: PChar;
174	–	FDPBLength: Short;
175	–	FHandle: TISC_DB_HANDLE;
176	–	FHandleIsShared: Boolean;
192		FOnIdleTimer: TNotifyEvent;
193		FDefaultTransaction: TIBTransaction;
194		FInternalTransaction: TIBTransaction;
180	–	FStreamedConnected: Boolean;
195		FTimer: TFPTimer;
196		FUserNames: TStringList;
197		FDataSets: TList;
198		FLoginCalled: boolean;
199	<	FCharSetSizes: array of integer;
199	>	FUseDefaultSystemCodePage: boolean;
200		procedure EnsureInactive;
201		function GetDBSQLDialect: Integer;
202		function GetSQLDialect: Integer;
#	Line 192 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
195	–	function GetDBParamByDPB(const Idx: Integer): String;
209		function GetIdleTimer: Integer;
210		function GetTransaction(Index: Integer): TIBTransaction;
211		function GetTransactionCount: Integer;
212	<	function Login: Boolean;
200	<	procedure LoadCharSetInfo;
212	>	function Login(var aDatabaseName: string): Boolean;
213		procedure SetDatabaseName(const Value: TIBFileName);
214		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215		procedure SetDBParams(Value: TStrings);
#	Line 228 | Line 240 | type
240		procedure CloseDataSets;
241		procedure CheckActive;
242		procedure CheckInactive;
243	<	procedure CreateDatabase;
243	>	procedure CreateDatabase; overload;
244	>	procedure CreateDatabase(createDatabaseSQL: string); overload;
245		procedure DropDatabase;
246		procedure ForceClose;
247		procedure GetFieldNames(const TableName: string; List: TStrings);
#	Line 236 | Line 249 | type
249		function IndexOfDBConst(st: String): Integer;
250		function TestConnected: Boolean;
251		procedure CheckDatabaseName;
239	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
252		function AddTransaction(TR: TIBTransaction): Integer;
253		function FindTransaction(TR: TIBTransaction): Integer;
254		function FindDefaultTransaction(): TIBTransaction;
255		procedure RemoveTransaction(Idx: Integer);
256		procedure RemoveTransactions;
245	–	procedure SetHandle(Value: TISC_DB_HANDLE);
257
258	<	property Handle: TISC_DB_HANDLE read FHandle;
258	>	property Attachment: IAttachment read FAttachment;
259	>	property DBSQLDialect : Integer read FDBSQLDialect;
260		property IsReadOnly: Boolean read GetIsReadOnly;
249	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
250	–	write SetDBParamByDPB;
261		property SQLObjectCount: Integer read GetSQLObjectCount;
262		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
253	–	property HandleIsShared: Boolean read FHandleIsShared;
263		property TransactionCount: Integer read GetTransactionCount;
264		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265		property InternalTransaction: TIBTransaction read FInternalTransaction;
266	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267	+	property DefaultCharSetID: integer read FDefaultCharSetID;
268	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
269
270		published
271		property Connected;
272	+	property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
273		property AllowStreamedConnected: boolean read FAllowStreamedConnected
274		write FAllowStreamedConnected;
275		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
#	Line 267 | Line 280 | type
280		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
270	–	property DBSQLDialect : Integer read FDBSQLDialect;
283		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285	+	write FUseDefaultSystemCodePage;
286		property AfterConnect;
287		property AfterDisconnect;
288		property BeforeConnect;
289		property BeforeDisconnect;
290	+	property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
291		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
292		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
293		property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
294		end;
295
296	<	{ TIBTransaction }
296	>	TDefaultEndAction = TARollback..TACommit;
297
298	<	TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
298	>	{ TIBTransaction }
299
300		TIBTransaction = class(TComponent)
301		private
302	+	FTransactionIntf: ITransaction;
303		FAfterDelete: TNotifyEvent;
304		FAfterEdit: TNotifyEvent;
305		FAfterExecQuery: TNotifyEvent;
#	Line 291 | Line 307 | type
307		FAfterPost: TNotifyEvent;
308		FAfterTransactionEnd: TNotifyEvent;
309		FBeforeTransactionEnd: TNotifyEvent;
294	–	FIBLoaded: Boolean;
295	–	FCanTimeout         : Boolean;
310		FDatabases          : TList;
311		FOnStartTransaction: TNotifyEvent;
312		FSQLObjects         : TList;
313		FDefaultDatabase    : TIBDatabase;
300	–	FHandle             : TISC_TR_HANDLE;
301	–	FHandleIsShared     : Boolean;
314		FOnIdleTimer          : TNotifyEvent;
315		FStreamedActive     : Boolean;
316	<	FTPB                : PChar;
305	<	FTPBLength          : Short;
316	>	FTPB                : ITPB;
317		FTimer              : TFPTimer;
318	<	FDefaultAction      : TTransactionAction;
318	>	FDefaultAction      : TDefaultEndAction;
319		FTRParams           : TStrings;
320		FTRParamsChanged    : Boolean;
321		FInEndTransaction   : boolean;
#	Line 327 | Line 338 | type
338		function GetIdleTimer: Integer;
339		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340		procedure SetActive(Value: Boolean);
330	–	procedure SetDefaultAction(Value: TTransactionAction);
341		procedure SetDefaultDatabase(Value: TIBDatabase);
342		procedure SetIdleTimer(Value: Integer);
343		procedure SetTRParams(Value: TStrings);
#	Line 340 | Line 350 | type
350
351		protected
352		procedure Loaded; override;
343	–	procedure SetHandle(Value: TISC_TR_HANDLE);
353		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
354
355		public
356		constructor Create(AOwner: TComponent); override;
357		destructor Destroy; override;
349	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358		procedure Commit;
359		procedure CommitRetaining;
360		procedure Rollback;
#	Line 367 | Line 375 | type
375		property Databases[Index: Integer]: TIBDatabase read GetDatabase;
376		property SQLObjectCount: Integer read GetSQLObjectCount;
377		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
370	–	property Handle: TISC_TR_HANDLE read FHandle;
371	–	property HandleIsShared: Boolean read FHandleIsShared;
378		property InTransaction: Boolean read GetInTransaction;
379	<	property TPB: PChar read FTPB;
380	<	property TPBLength: Short read FTPBLength;
379	>	property TransactionIntf: ITransaction read FTransactionIntf;
380	>	property TPB: ITPB read FTPB;
381		published
382		property Active: Boolean read GetInTransaction write SetActive;
383		property DefaultDatabase: TIBDatabase read FDefaultDatabase
384		write SetDefaultDatabase;
385		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
386	<	property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
386	>	property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
387		property Params: TStrings read FTRParams write SetTRParams;
388		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
389		property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
#	Line 428 | Line 434 | type
434		procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435		procedure DoAfterTransactionEnd; virtual;
436		procedure DoTransactionFree; virtual;
431	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
432	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
437		procedure SetDatabase(Value: TIBDatabase); virtual;
438		procedure SetTransaction(Value: TIBTransaction); virtual;
439		public
#	Line 442 | Line 446 | type
446		procedure DoAfterDelete(Sender: TObject); virtual;
447		procedure DoAfterInsert(Sender: TObject); virtual;
448		procedure DoAfterPost(Sender: TObject); virtual;
445	–	function GetCharSetSize(CharSetID: integer): integer;
449		procedure HandleException(Sender: TObject);
450		procedure SetCursor;
451		procedure RestoreCursor;
#	Line 461 | Line 464 | type
464		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465		property Database: TIBDatabase read FDatabase
466		write SetDatabase;
464	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467		property Owner: TObject read FOwner;
466	–	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468		property Transaction: TIBTransaction read FTransaction
469		write SetTransaction;
470		end;
471
472	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
473	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
472	>	function GenerateDPB(sl: TStrings): IDPB;
473	>	function GenerateTPB(sl: TStrings): ITPB;
474
475
476		implementation
477
478	<	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	<	typInfo;
478	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	>	typInfo, FBMessages, IBErrorCodes, RegExpr;
480
481		{ TIBDatabase }
482
483	<	constructor TIBDataBase.Create(AOwner: TComponent);
483	<	{$ifdef WINDOWS}
484	<	var acp: uint;
485	<	{$endif}
483	>	constructor TIBDataBase.Create(AOwner: TComponent);
484		begin
485		inherited Create(AOwner);
488	–	FIBLoaded := False;
489	–	CheckIBLoaded;
490	–	FIBLoaded := True;
486		LoginPrompt := True;
487		FSQLObjects := TList.Create;
488		FTransactions := TList.Create;
#	Line 498 | Line 493 | begin
493		(AOwner is TCustomApplication) and
494		TCustomApplication(AOWner).ConsoleApplication then
495		LoginPrompt := false;
501	–	{$ifdef UNIX}
502	–	if csDesigning in ComponentState then
503	–	FDBParams.Add('lc_ctype=UTF8');
504	–	{$else}
505	–	{$ifdef WINDOWS}
506	–	if csDesigning in ComponentState then
507	–	begin
508	–	acp := GetACP;
509	–	if (acp >= 1250) and (acp <= 1254) then
510	–	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
511	–	end;
512	–	{$endif}
513	–	{$endif}
496		FDBParamsChanged := True;
497		TStringList(FDBParams).OnChange := DBParamsChange;
498		TStringList(FDBParams).OnChanging := DBParamsChanging;
499		FDPB := nil;
518	–	FHandle := nil;
500		FUserNames := nil;
501		FInternalTransaction := TIBTransaction.Create(self);
502		FInternalTransaction.DefaultDatabase := Self;
#	Line 530 | Line 511 | begin
511		CheckStreamConnect;
512		end;
513
514	<	destructor TIBDataBase.Destroy;
514	>	destructor TIBDataBase.Destroy;
515		var
516		i: Integer;
517		begin
518	<	if FIBLoaded then
519	<	begin
520	<	IdleTimer := 0;
521	<	if FHandle <> nil then
522	<	ForceClose;
523	<	for i := 0 to FSQLObjects.Count - 1 do
524	<	if FSQLObjects[i] <> nil then
525	<	SQLObjects[i].DoDatabaseFree;
526	<	RemoveSQLObjects;
527	<	RemoveTransactions;
528	<	FInternalTransaction.Free;
529	<	FreeMem(FDPB);
530	<	FDPB := nil;
531	<	FDBParams.Free;
551	<	FSQLObjects.Free;
552	<	FUserNames.Free;
553	<	FTransactions.Free;
554	<	end;
518	>	IdleTimer := 0;
519	>	if FAttachment <> nil then
520	>	ForceClose;
521	>	for i := 0 to FSQLObjects.Count - 1 do
522	>	if FSQLObjects[i] <> nil then
523	>	SQLObjects[i].DoDatabaseFree;
524	>	RemoveSQLObjects;
525	>	RemoveTransactions;
526	>	FInternalTransaction.Free;
527	>	FDPB := nil;
528	>	FDBParams.Free;
529	>	FSQLObjects.Free;
530	>	FUserNames.Free;
531	>	FTransactions.Free;
532		FDataSets.Free;
533		inherited Destroy;
534		end;
535
559	–	function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
560	–	): ISC_STATUS;
561	–	begin
562	–	result := ErrCode;
563	–	FCanTimeout := False;
564	–	if RaiseError and (ErrCode > 0) then
565	–	IBDataBaseError;
566	–	end;
567	–
536		procedure TIBDataBase.CheckActive;
537		begin
538		if StreamedConnected and (not Connected) then
539		Loaded;
540	<	if FHandle = nil then
540	>	if FAttachment = nil then
541		IBError(ibxeDatabaseClosed, [nil]);
542		end;
543
#	Line 577 | Line 545 | end;
545		begin
546		if csDesigning in ComponentState then
547		begin
548	<	if FHandle <> nil then
548	>	if FAttachment <> nil then
549		Close;
550		end
551		end;
552
553		procedure TIBDataBase.CheckInactive;
554		begin
555	<	if FHandle <> nil then
555	>	if FAttachment <> nil then
556		IBError(ibxeDatabaseOpen, [nil]);
557		end;
558
559		procedure TIBDataBase.CheckDatabaseName;
560		begin
561	<	if (FDBName = '') then
561	>	if (Trim(FDBName) = '') then
562		IBError(ibxeDatabaseNameMissing, [nil]);
563		end;
564
#	Line 629 | Line 597 | begin
597		if Connected then
598		InternalClose(False);
599		FDBSQLDialect := 1;
600	<	SetLength(FCharSetSizes,0);
600	>	FDefaultCharSetName := '';
601	>	FDefaultCharSetID := 0;
602	>	FDefaultCodePage := CP_NONE;
603		end;
604
605	<	procedure TIBDataBase.CreateDatabase;
606	<	var
607	<	tr_handle: TISC_TR_HANDLE;
605	>	procedure TIBDataBase.CreateDatabase;
606	>	begin
607	>	CheckInactive;
608	>	CheckDatabaseName;
609	>	FCreateDatabase := true;
610	>	Connected := true;
611	>	end;
612	>
613	>	procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614	>	var RegexObj: TRegExpr;
615		begin
616		CheckInactive;
617	<	tr_handle := nil;
618	<	Call(
619	<	isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
620	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
621	<	Params.Text), SQLDialect, nil),
622	<	True);
617	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
618	>	RegexObj := TRegExpr.Create;
619	>	try
620	>	{extact database file spec}
621	>	RegexObj.ModifierG := false; {turn off greedy matches}
622	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
623	>	if RegexObj.Exec(AnsiUpperCase(createDatabaseSQL)) then
624	>	FDBName := system.copy(createDatabaseSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
625	>	finally
626	>	RegexObj.Free;
627	>	end;
628	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
629	>	OnCreateDatabase(self);
630		end;
631
632		procedure TIBDataBase.DropDatabase;
633		begin
634		CheckActive;
635	<	Call(isc_drop_database(StatusVector, @FHandle), True);
635	>	FAttachment.DropDatabase;
636	>	FAttachment := nil;
637		end;
638
639		procedure TIBDataBase.DBParamsChange(Sender: TObject);
#	Line 701 | Line 686 | end;
686
687		function TIBDataBase.GetConnected: Boolean;
688		begin
689	<	result := FHandle <> nil;
689	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
690		end;
691
692		function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
#	Line 718 | Line 703 | begin
703		Inc(result);
704		end;
705
706	<	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
722	<	var
723	<	ConstIdx, EqualsIdx: Integer;
724	<	begin
725	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
726	<	begin
727	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
728	<	if ConstIdx = -1 then
729	<	result := ''
730	<	else
731	<	begin
732	<	result := Params[ConstIdx];
733	<	EqualsIdx := Pos('=', result); {mbcs ok}
734	<	if EqualsIdx = 0 then
735	<	result := ''
736	<	else
737	<	result := Copy(result, EqualsIdx + 1, Length(result));
738	<	end;
739	<	end
740	<	else
741	<	result := '';
742	<	end;
743	<
744	<	function TIBDataBase.GetIdleTimer: Integer;
706	>	function TIBDataBase.GetIdleTimer: Integer;
707		begin
708		result := FTimer.Interval;
709		end;
#	Line 806 | Line 768 | begin
768		end;
769		end;
770
771	<	if (not HandleIsShared) and
772	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
811	<	(not Force) then
812	<	IBDataBaseError
813	<	else
814	<	begin
815	<	FHandle := nil;
816	<	FHandleIsShared := False;
817	<	end;
771	>	FAttachment.Disconnect(Force);
772	>	FAttachment := nil;
773
774		if not (csDesigning in ComponentState) then
775		MonitorHook.DBDisconnect(Self);
#	Line 824 | Line 779 | begin
779		SQLObjects[i].DoAfterDatabaseDisconnect;
780		end;
781
827	–	procedure TIBDataBase.LoadCharSetInfo;
828	–	var Query: TIBSQL;
829	–	i: integer;
830	–	begin
831	–	if not FInternalTransaction.Active then
832	–	FInternalTransaction.StartTransaction;
833	–	Query := TIBSQL.Create(self);
834	–	try
835	–	Query.Database := Self;
836	–	Query.Transaction := FInternalTransaction;
837	–	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
838	–	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
839	–	Query.Prepare;
840	–	Query.ExecQuery;
841	–	if not Query.EOF then
842	–	begin
843	–	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
844	–	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
845	–	repeat
846	–	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
847	–	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
848	–	Query.Next;
849	–	until Query.EOF;
850	–	end;
851	–	finally
852	–	Query.free;
853	–	FInternalTransaction.Commit;
854	–	end;
855	–	end;
856	–
782		procedure TIBDataBase.CheckStreamConnect;
783		var
784		i: integer;
#	Line 876 | Line 801 | begin
801		(FDefaultTransaction.FStreamedActive) and
802		(not FDefaultTransaction.InTransaction) then
803		FDefaultTransaction.StartTransaction;
804	<	FStreamedConnected := False;
804	>	StreamedConnected := False;
805		end;
806		except
807		if csDesigning in ComponentState then
#	Line 917 | Line 842 | begin
842		end;
843		end;
844
845	<	function TIBDataBase.Login: Boolean;
845	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
846		var
847		IndexOfUser, IndexOfPassword: Integer;
848		Username, Password, OldPassword: String;
#	Line 953 | Line 878 | begin
878		LoginParams.Assign(Params);
879		FOnLogin(Self, LoginParams);
880		Params.Assign (LoginParams);
881	+	aDatabaseName := FDBName;
882		HidePassword;
883		finally
884		LoginParams.Free;
#	Line 974 | Line 900 | begin
900		Length(Params[IndexOfPassword]));
901		OldPassword := password;
902		end;
903	<	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
903	>
904	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
905		if result then
906		begin
907	<	if IndexOfUser = -1 then
908	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
909	<	else
910	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
907	>	if Username <> '' then
908	>	begin
909	>	if IndexOfUser = -1 then
910	>	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
911	>	else
912	>	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
913		'=' + Username;
914	+	end
915	+	else
916	+	if IndexOfUser <> -1 then
917	+	Params.Delete(IndexOfUser);
918		if (Password = OldPassword) then
919		FHiddenPassword := ''
920		else
#	Line 1002 | Line 935 | end;
935
936		procedure TIBDataBase.DoConnect;
937		var
1005	–	DPB: String;
938		TempDBParams: TStrings;
939		I: integer;
940		aDBName: string;
941	+	Status: IStatus;
942	+	CharSetID: integer;
943		begin
944		CheckInactive;
945		CheckDatabaseName;
#	Line 1015 | Line 949 | begin
949		FDBParamsChanged := True;
950		end;
951		{ Use builtin login prompt if requested }
952	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
952	>	aDBName := FDBName;
953	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
954		IBError(ibxeOperationCancelled, [nil]);
955
956		TempDBParams := TStringList.Create;
957		try
958		TempDBParams.Assign(FDBParams);
959	<	aDBName := FDBName;
960	<	{Opportuning to override defaults}
959	>	if UseDefaultSystemCodePage then
960	>	begin
961	>	{$ifdef WINDOWS}
962	>	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
963	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
964	>	{$else}
965	>	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
966	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
967	>	{$endif}
968	>	else
969	>	TempDBParams.Values['lc_ctype'] :='UTF8';
970	>	end;
971	>	{Opportunity to override defaults}
972		for i := 0 to FSQLObjects.Count - 1 do
973		begin
974		if FSQLObjects[i] <> nil then
975		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
976		end;
977
978	+	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
979	+	if FDefaultCharSetName <> '' then
980	+	FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
981	+	FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
982		{ Generate a new DPB if necessary }
983		if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
984		begin
985		FDBParamsChanged := False;
986		if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
987	<	GenerateDPB(TempDBParams, DPB, FDPBLength)
987	>	FDPB := GenerateDPB(TempDBParams)
988		else
989		begin
990		TempDBParams.Add('password=' + FHiddenPassword);
991	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
991	>	FDPB := GenerateDPB(TempDBParams);
992		end;
1043	–	IBAlloc(FDPB, 0, FDPBLength);
1044	–	Move(DPB[1], FDPB[0], FDPBLength);
993		end;
994		finally
995		TempDBParams.Free;
996		end;
997	<	if Call(isc_attach_database(StatusVector, Length(aDBName),
998	<	PChar(aDBName), @FHandle,
999	<	FDPBLength, FDPB), False) > 0 then
1000	<	begin
1001	<	FHandle := nil;
1002	<	IBDataBaseError;
1003	<	end;
997	>
998	>	repeat
999	>	if FCreateDatabase then
1000	>	begin
1001	>	FCreateDatabase := false;
1002	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1003	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1004	>	OnCreateDatabase(self);
1005	>	end
1006	>	else
1007	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1008	>	if FAttachment = nil then
1009	>	begin
1010	>	Status := FirebirdAPI.GetStatus;
1011	>	{$IFDEF UNIX}
1012	>	if Pos(':',aDBName) = 0 then
1013	>	begin
1014	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1015	>	or
1016	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1017	>	or
1018	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1019	>	or
1020	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1021	>	then
1022	>	begin
1023	>	aDBName := 'localhost:' + aDBName;
1024	>	Continue;
1025	>	end
1026	>	end;
1027	>	{$ENDIF}
1028	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1029	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1030	>	FCreateDatabase := true
1031	>	else
1032	>	raise EIBInterBaseError.Create(Status);
1033	>	end;
1034	>	until FAttachment <> nil;
1035		if not (csDesigning in ComponentState) then
1036		FDBName := aDBName; {Synchronise at run time}
1037		FDBSQLDialect := GetDBSQLDialect;
#	Line 1064 | Line 1043 | begin
1043		end;
1044		if not (csDesigning in ComponentState) then
1045		MonitorHook.DBConnect(Self);
1067	–	LoadCharSetInfo;
1046		end;
1047
1048		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 1167 | Line 1145 | begin
1145		FDefaultTransaction := Value;
1146		end;
1147
1170	–	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1171	–	begin
1172	–	if HandleIsShared then
1173	–	Close
1174	–	else
1175	–	CheckInactive;
1176	–	FHandle := Value;
1177	–	FHandleIsShared := (Value <> nil);
1178	–	end;
1179	–
1148		procedure TIBDataBase.SetIdleTimer(Value: Integer);
1149		begin
1150		if Value < 0 then
#	Line 1221 | Line 1189 | end;
1189		begin
1190		if Connected then
1191		begin
1192	<	if FCanTimeout then
1192	>	if not FAttachment.HasActivity then
1193		begin
1194		ForceClose;
1195		if Assigned(FOnIdleTimer) then
1196		FOnIdleTimer(Self);
1197		end
1230	–	else
1231	–	FCanTimeout := True;
1198		end;
1199		end;
1200
#	Line 1259 | Line 1225 | end;
1225		procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1226		begin
1227		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1228	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1228	>	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1229		FSQLDialect := Value
1230		else
1231		IBError(ibxeSQLDialectInvalid, [nil]);
#	Line 1378 | Line 1344 | begin
1344		BeginUpdate;
1345		try
1346		Clear;
1347	<	while (not Query.EOF) and (Query.Next <> nil) do
1348	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1347	>	while (not Query.EOF) and Query.Next  do
1348	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1349		finally
1350		EndUpdate;
1351		end;
#	Line 1418 | Line 1384 | begin
1384		BeginUpdate;
1385		try
1386		Clear;
1387	<	while (not Query.EOF) and (Query.Next <> nil) do
1388	<	List.Add(TrimRight(Query.Current[0].AsString));
1387	>	while (not Query.EOF) and Query.Next  do
1388	>	List.Add(TrimRight(Query.Fields[0].AsString));
1389		finally
1390		EndUpdate;
1391		end;
#	Line 1436 | Line 1402 | end;
1402		constructor TIBTransaction.Create(AOwner: TComponent);
1403		begin
1404		inherited Create(AOwner);
1439	–	FIBLoaded := False;
1440	–	CheckIBLoaded;
1441	–	FIBLoaded := True;
1442	–	CheckIBLoaded;
1405		FDatabases := TList.Create;
1406		FSQLObjects := TList.Create;
1445	–	FHandle := nil;
1407		FTPB := nil;
1447	–	FTPBLength := 0;
1408		FTRParams := TStringList.Create;
1409		FTRParamsChanged := True;
1410		TStringList(FTRParams).OnChange := TRParamsChange;
#	Line 1460 | Line 1420 | destructor TIBTransaction.Destroy;
1420		var
1421		i: Integer;
1422		begin
1423	<	if FIBLoaded then
1424	<	begin
1425	<	if InTransaction then
1426	<	EndTransaction(FDefaultAction, True);
1427	<	for i := 0 to FSQLObjects.Count - 1 do
1428	<	if FSQLObjects[i] <> nil then
1429	<	SQLObjects[i].DoTransactionFree;
1430	<	RemoveSQLObjects;
1431	<	RemoveDatabases;
1432	<	FreeMem(FTPB);
1433	<	FTPB := nil;
1474	<	FTRParams.Free;
1475	<	FSQLObjects.Free;
1476	<	FDatabases.Free;
1477	<	end;
1423	>	if InTransaction then
1424	>	EndTransaction(FDefaultAction, True);
1425	>	for i := 0 to FSQLObjects.Count - 1 do
1426	>	if FSQLObjects[i] <> nil then
1427	>	SQLObjects[i].DoTransactionFree;
1428	>	RemoveSQLObjects;
1429	>	RemoveDatabases;
1430	>	FTPB := nil;
1431	>	FTRParams.Free;
1432	>	FSQLObjects.Free;
1433	>	FDatabases.Free;
1434		inherited Destroy;
1435		end;
1436
1481	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1482	–	RaiseError: Boolean): ISC_STATUS;
1483	–	var
1484	–	i: Integer;
1485	–	begin
1486	–	result := ErrCode;
1487	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1488	–	Databases[i].FCanTimeout := False;
1489	–	FCanTimeout := False;
1490	–	if RaiseError and (result > 0) then
1491	–	IBDataBaseError;
1492	–	end;
1493	–
1437		procedure TIBTransaction.CheckDatabasesInList;
1438		begin
1439		if GetDatabaseCount = 0 then
#	Line 1501 | Line 1444 | procedure TIBTransaction.CheckInTransact
1444		begin
1445		if FStreamedActive and (not InTransaction) then
1446		Loaded;
1447	<	if (FHandle = nil) then
1447	>	if (TransactionIntf = nil) then
1448		IBError(ibxeNotInTransaction, [nil]);
1449		end;
1450
#	Line 1557 | Line 1500 | procedure TIBTransaction.EnsureNotInTran
1500		begin
1501		if csDesigning in ComponentState then
1502		begin
1503	<	if FHandle <> nil then
1503	>	if TransactionIntf <> nil then
1504		Rollback;
1505		end;
1506		end;
1507
1508		procedure TIBTransaction.CheckNotInTransaction;
1509		begin
1510	<	if (FHandle <> nil) then
1510	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1511		IBError(ibxeInTransaction, [nil]);
1512		end;
1513
#	Line 1573 | Line 1516 | var
1516		i: Integer;
1517		NilFound: Boolean;
1518		begin
1519	+	EnsureNotInTransaction;
1520	+	CheckNotInTransaction;
1521	+	FTransactionIntf := nil;
1522	+
1523		i := FindDatabase(db);
1524		if i <> -1 then
1525		begin
#	Line 1623 | Line 1570 | end;
1570		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1571		Force: Boolean);
1572		var
1626	–	status: ISC_STATUS;
1573		i: Integer;
1574		begin
1575		CheckInTransaction;
#	Line 1634 | Line 1580 | begin
1580		case Action of
1581		TARollback, TACommit:
1582		begin
1637	–	if (HandleIsShared) and
1638	–	(Action <> FDefaultAction) and
1639	–	(not Force) then
1640	–	IBError(ibxeCantEndSharedTransaction, [nil]);
1583		DoBeforeTransactionEnd;
1584		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1585		SQLObjects[i].DoBeforeTransactionEnd(Action);
1586		if InTransaction then
1587		begin
1588	<	if HandleIsShared then
1589	<	begin
1648	<	FHandle := nil;
1649	<	FHandleIsShared := False;
1650	<	status := 0;
1651	<	end
1588	>	if (Action = TARollback) then
1589	>	FTransactionIntf.Rollback(Force)
1590		else
1591	<	if (Action = TARollback) then
1592	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1593	<	else
1594	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1595	<	if ((Force) and (status > 0)) then
1596	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1597	<	if Force then
1598	<	FHandle := nil
1599	<	else
1600	<	if (status > 0) then
1601	<	IBDataBaseError;
1591	>	try
1592	>	FTransactionIntf.Commit;
1593	>	except on E: EIBInterBaseError do
1594	>	begin
1595	>	if Force then
1596	>	FTransactionIntf.Rollback(Force)
1597	>	else
1598	>	raise;
1599	>	end;
1600	>	end;
1601	>
1602		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1603		SQLObjects[i].DoAfterTransactionEnd;
1604		DoAfterTransactionEnd;
1605		end;
1606		end;
1607		TACommitRetaining:
1608	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1608	>	FTransactionIntf.CommitRetaining;
1609	>
1610		TARollbackRetaining:
1611	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1611	>	FTransactionIntf.RollbackRetaining;
1612		end;
1613		if not (csDesigning in ComponentState) then
1614		begin
#	Line 1721 | Line 1660 | end;
1660
1661		function TIBTransaction.GetInTransaction: Boolean;
1662		begin
1663	<	result := (FHandle <> nil);
1663	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1664		end;
1665
1666		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1777 | Line 1716 | procedure TIBTransaction.BeforeDatabaseD
1716		begin
1717		if InTransaction then
1718		EndTransaction(FDefaultAction, True);
1719	+	FTransactionIntf := nil;
1720		end;
1721
1722		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1785 | Line 1725 | var
1725		begin
1726		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1727		begin
1728	+	EnsureNotInTransaction;
1729	+	CheckNotInTransaction;
1730	+	FTransactionIntf := nil;
1731	+
1732		DB := Databases[Idx];
1733		FDatabases[Idx] := nil;
1734		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1797 | Line 1741 | procedure TIBTransaction.RemoveDatabases
1741		var
1742		i: Integer;
1743		begin
1744	+	EnsureNotInTransaction;
1745	+	CheckNotInTransaction;
1746	+	FTransactionIntf := nil;
1747	+
1748		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1749		RemoveDatabase(i);
1750		end;
#	Line 1843 | Line 1791 | begin
1791		Rollback;
1792		end;
1793
1846	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1847	–	begin
1848	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1849	–	IBError(ibxeIB60feature, [nil]);*)
1850	–	FDefaultAction := Value;
1851	–	end;
1852	–
1794		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1795		var
1796		i: integer;
#	Line 1872 | Line 1813 | begin
1813		FDefaultDatabase := Value;
1814		end;
1815
1875	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1876	–	begin
1877	–	if (HandleIsShared) then
1878	–	EndTransaction(DefaultAction, True)
1879	–	else
1880	–	CheckNotInTransaction;
1881	–	FHandle := Value;
1882	–	FHandleIsShared := (Value <> nil);
1883	–	end;
1884	–
1816		procedure TIBTransaction.Notification( AComponent: TComponent;
1817		Operation: TOperation);
1818		var
#	Line 1923 | Line 1854 | end;
1854
1855		procedure TIBTransaction.StartTransaction;
1856		var
1926	–	pteb: PISC_TEB_ARRAY;
1927	–	TPB: String;
1857		i: Integer;
1858	+	Attachments: array of IAttachment;
1859	+	ValidDatabaseCount: integer;
1860		begin
1861		CheckNotInTransaction;
1862		CheckDatabasesInList;
1863	+	if TransactionIntf <> nil then
1864	+	begin
1865	+	TransactionIntf.Start(DefaultAction);
1866	+	Exit;
1867	+	end;
1868	+
1869		for i := 0 to FDatabases.Count - 1 do
1870		if  FDatabases[i] <> nil then
1871		begin
1872		with TIBDatabase(FDatabases[i]) do
1873		if not Connected then
1874	<	if FStreamedConnected then
1874	>	if StreamedConnected then
1875		begin
1876		Open;
1877	<	FStreamedConnected := False;
1877	>	StreamedConnected := False;
1878		end
1879		else
1880		IBError(ibxeDatabaseClosed, [nil]);
#	Line 1945 | Line 1882 | begin
1882		if FTRParamsChanged then
1883		begin
1884		FTRParamsChanged := False;
1885	<	GenerateTPB(FTRParams, TPB, FTPBLength);
1949	<	if FTPBLength > 0 then
1950	<	begin
1951	<	IBAlloc(FTPB, 0, FTPBLength);
1952	<	Move(TPB[1], FTPB[0], FTPBLength);
1953	<	end;
1885	>	FTPB :=  GenerateTPB(FTRParams);
1886		end;
1887
1888	<	pteb := nil;
1889	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1890	<	try
1891	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1892	<	begin
1893	<	pteb^[i].db_handle := @(Databases[i].Handle);
1894	<	pteb^[i].tpb_length := FTPBLength;
1895	<	pteb^[i].tpb_address := FTPB;
1896	<	end;
1897	<	if Call(isc_start_multiple(StatusVector, @FHandle,
1898	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1899	<	begin
1900	<	FHandle := nil;
1901	<	IBDataBaseError;
1970	<	end;
1971	<	if not (csDesigning in ComponentState) then
1972	<	MonitorHook.TRStart(Self);
1973	<	finally
1974	<	FreeMem(pteb);
1888	>	ValidDatabaseCount := 0;
1889	>	for i := 0 to DatabaseCount - 1 do
1890	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1891	>
1892	>	if ValidDatabaseCount = 1 then
1893	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1894	>	else
1895	>	begin
1896	>	SetLength(Attachments,ValidDatabaseCount);
1897	>	for i := 0 to DatabaseCount - 1 do
1898	>	if Databases[i] <> nil then
1899	>	Attachments[i] := Databases[i].Attachment;
1900	>
1901	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1902		end;
1903	+
1904	+	if not (csDesigning in ComponentState) then
1905	+	MonitorHook.TRStart(Self);
1906		DoOnStartTransaction;
1907		end;
1908
#	Line 1980 | Line 1910 | procedure TIBTransaction.TimeoutTransact
1910		begin
1911		if InTransaction then
1912		begin
1913	<	if FCanTimeout then
1913	>	if not TransactionIntf.HasActivity then
1914		begin
1915		EndTransaction(FDefaultAction, True);
1916		if Assigned(FOnIdleTimer) then
1917		FOnIdleTimer(Self);
1918		end
1989	–	else
1990	–	FCanTimeout := True;
1919		end;
1920		end;
1921
#	Line 2000 | Line 1928 | procedure TIBTransaction.TRParamsChangin
1928		begin
1929		EnsureNotInTransaction;
1930		CheckNotInTransaction;
1931	+	FTransactionIntf := nil;
1932		end;
1933
1934		{ TIBBase }
#	Line 2015 | Line 1944 | begin
1944		inherited Destroy;
1945		end;
1946
2018	–	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2019	–	begin
2020	–	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2021	–	Result := Database.FCharSetSizes[CharSetID]
2022	–	else
2023	–	Result := 1; {Unknown character set}
2024	–	end;
2025	–
1947		procedure TIBBase.HandleException(Sender: TObject);
1948		begin
1949		if assigned(Database) then
#	Line 2061 | Line 1982 | begin
1982		FTransaction.CheckInTransaction;
1983		end;
1984
2064	–	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2065	–	begin
2066	–	CheckDatabase;
2067	–	result := @FDatabase.Handle;
2068	–	end;
2069	–
2070	–	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2071	–	begin
2072	–	CheckTransaction;
2073	–	result := @FTransaction.Handle;
2074	–	end;
2075	–
1985		procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1986		);
1987		begin
#	Line 2187 | Line 2096 | end;
2096		parameter buffer, and return it and its length
2097		in DPB and DPBLength, respectively. }
2098
2099	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2099	>	function GenerateDPB(sl: TStrings): IDPB;
2100		var
2101	<	i, j, pval: Integer;
2101	>	i, j: Integer;
2102		DPBVal: UShort;
2103		ParamName, ParamValue: string;
2104		begin
2105	<	{ The DPB is initially empty, with the exception that
2197	<	the DPB version must be the first byte of the string. }
2198	<	DPBLength := 1;
2199	<	DPB := Char(isc_dpb_version1);
2105	>	Result := FirebirdAPI.AllocateDPB;
2106
2107		{Iterate through the textual database parameters, constructing
2108		a DPB on-the-fly }
#	Line 2235 | Line 2141 | begin
2141		begin
2142		if DPBVal = isc_dpb_sql_dialect then
2143		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2144	<	DPB := DPB +
2239	<	Char(DPBVal) +
2240	<	Char(Length(ParamValue)) +
2241	<	ParamValue;
2242	<	Inc(DPBLength, 2 + Length(ParamValue));
2144	>	Result.Add(DPBVal).SetAsString(ParamValue);
2145		end;
2146	+
2147		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2148		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2149	<	begin
2150	<	DPB := DPB +
2248	<	Char(DPBVal) +
2249	<	#1 +
2250	<	Char(StrToInt(ParamValue));
2251	<	Inc(DPBLength, 3);
2252	<	end;
2149	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2150	>
2151		isc_dpb_sweep:
2152	<	begin
2153	<	DPB := DPB +
2256	<	Char(DPBVal) +
2257	<	#1 +
2258	<	Char(isc_dpb_records);
2259	<	Inc(DPBLength, 3);
2260	<	end;
2152	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2153	>
2154		isc_dpb_sweep_interval:
2155	<	begin
2156	<	pval := StrToInt(ParamValue);
2264	<	DPB := DPB +
2265	<	Char(DPBVal) +
2266	<	#4 +
2267	<	PChar(@pval)[0] +
2268	<	PChar(@pval)[1] +
2269	<	PChar(@pval)[2] +
2270	<	PChar(@pval)[3];
2271	<	Inc(DPBLength, 6);
2272	<	end;
2155	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2156	>
2157		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2158		isc_dpb_quit_log:
2159	<	begin
2276	<	DPB := DPB +
2277	<	Char(DPBVal) +
2278	<	#1 + #0;
2279	<	Inc(DPBLength, 3);
2280	<	end;
2159	>	Result.Add(DPBVal).SetAsByte(0);
2160		else
2161		begin
2162		if (DPBVal > 0) and
#	Line 2295 | Line 2174 | end;
2174		of the transaction parameters, generate a transaction
2175		parameter buffer, and return it and its length in
2176		TPB and TPBLength, respectively. }
2177	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2177	>	function GenerateTPB(sl: TStrings): ITPB;
2178		var
2179	<	i, j, TPBVal, ParamLength: Integer;
2179	>	i, j, TPBVal: Integer;
2180		ParamName, ParamValue: string;
2181		begin
2182	<	TPB := '';
2304	<	if (sl.Count = 0) then
2305	<	TPBLength := 0
2306	<	else
2307	<	begin
2308	<	TPBLength := sl.Count + 1;
2309	<	TPB := TPB + Char(isc_tpb_version3);
2310	<	end;
2182	>	Result := FirebirdAPI.AllocateTPB;
2183		for i := 0 to sl.Count - 1 do
2184		begin
2185		if (Trim(sl[i]) =  '') then
2314	–	begin
2315	–	Dec(TPBLength);
2186		Continue;
2187	<	end;
2187	>
2188		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2189		ParamName := LowerCase(sl[i]) {mbcs ok}
2190		else
#	Line 2338 | Line 2208 | begin
2208		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2209		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2210		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2211	<	TPB := TPB + Char(TPBVal);
2211	>	Result.Add(TPBVal);
2212	>
2213		isc_tpb_lock_read, isc_tpb_lock_write:
2214	<	begin
2215	<	TPB := TPB + Char(TPBVal);
2345	<	{ Now set the string parameter }
2346	<	ParamLength := Length(ParamValue);
2347	<	Inc(TPBLength, ParamLength + 1);
2348	<	TPB := TPB + Char(ParamLength) + ParamValue;
2349	<	end;
2214	>	Result.Add(TPBVal).SetAsString(ParamValue);
2215	>
2216		else
2217		begin
2218		if (TPBVal > 0) and

Diff Legend

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