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 13 by tony, Thu Nov 22 22:53:40 2012 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 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	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47	<	IB, DBLoginDlg;
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	+	FDPB: IDPB;
175		FAllowStreamedConnected: boolean;
176		FHiddenPassword: string;
177	<	FIBLoaded: Boolean;
177	>	FOnCreateDatabase: TNotifyEvent;
178		FOnLogin: TIBDatabaseLoginEvent;
179	+	FSQLHourGlass: Boolean;
180		FTraceFlags: TTraceFlags;
181		FDBSQLDialect: Integer;
182		FSQLDialect: Integer;
183		FOnDialectDowngradeWarning: TNotifyEvent;
166	–	FCanTimeout: Boolean;
184		FSQLObjects: TList;
185		FTransactions: TList;
186		FDBName: TIBFileName;
187		FDBParams: TStrings;
188		FDBParamsChanged: Boolean;
172	–	FDPB: PChar;
173	–	FDPBLength: Short;
174	–	FHandle: TISC_DB_HANDLE;
175	–	FHandleIsShared: Boolean;
189		FOnIdleTimer: TNotifyEvent;
190		FDefaultTransaction: TIBTransaction;
191		FInternalTransaction: TIBTransaction;
192	<	FStreamedConnected: Boolean;
180	<	FTimer: TTimer;
192	>	FTimer: TFPTimer;
193		FUserNames: TStringList;
194		FDataSets: TList;
195		FLoginCalled: boolean;
196	+	FUseDefaultSystemCodePage: boolean;
197		procedure EnsureInactive;
198		function GetDBSQLDialect: Integer;
199	+	function GetDefaultCharSetID: integer;
200	+	function GetDefaultCharSetName: AnsiString;
201	+	function GetDefaultCodePage: TSystemCodePage;
202		function GetSQLDialect: Integer;
203		procedure SetSQLDialect(const Value: Integer);
204		procedure ValidateClientSQLDialect;
#	Line 190 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
193	–	function GetDBParamByDPB(const Idx: Integer): String;
209		function GetIdleTimer: Integer;
210		function GetTransaction(Index: Integer): TIBTransaction;
211		function GetTransactionCount: Integer;
212	<	function Login: Boolean;
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 212 | Line 227 | type
227		procedure DoDisconnect; override;
228		function GetConnected: Boolean; override;
229		procedure CheckStreamConnect;
230	+	procedure HandleException(Sender: TObject);
231		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
232		function GetDataset(Index : longint) : TDataset; override;
233		function GetDataSetCount : Longint; override;
#	Line 224 | 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 232 | Line 249 | type
249		function IndexOfDBConst(st: String): Integer;
250		function TestConnected: Boolean;
251		procedure CheckDatabaseName;
235	–	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;
241	–	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;
245	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
246	–	write SetDBParamByDPB;
261		property SQLObjectCount: Integer read GetSQLObjectCount;
262		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
249	–	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: AnsiString read GetDefaultCharSetName;
267	+	property DefaultCharSetID: integer read GetDefaultCharSetID;
268	+	property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
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 262 | Line 279 | type
279		write SetDefaultTransaction;
280		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282	<	property DBSQLDialect : Integer read FDBSQLDialect;
282	>	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
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	<	FIBLoaded: Boolean;
303	<	FCanTimeout         : Boolean;
302	>	FTransactionIntf: ITransaction;
303	>	FAfterDelete: TNotifyEvent;
304	>	FAfterEdit: TNotifyEvent;
305	>	FAfterExecQuery: TNotifyEvent;
306	>	FAfterInsert: TNotifyEvent;
307	>	FAfterPost: TNotifyEvent;
308	>	FAfterTransactionEnd: TNotifyEvent;
309	>	FBeforeTransactionEnd: TNotifyEvent;
310		FDatabases          : TList;
311	+	FOnStartTransaction: TNotifyEvent;
312		FSQLObjects         : TList;
313		FDefaultDatabase    : TIBDatabase;
287	–	FHandle             : TISC_TR_HANDLE;
288	–	FHandleIsShared     : Boolean;
314		FOnIdleTimer          : TNotifyEvent;
315		FStreamedActive     : Boolean;
316	<	FTPB                : PChar;
317	<	FTPBLength          : Short;
318	<	FTimer              : TTimer;
294	<	FDefaultAction      : TTransactionAction;
316	>	FTPB                : ITPB;
317	>	FTimer              : TFPTimer;
318	>	FDefaultAction      : TDefaultEndAction;
319		FTRParams           : TStrings;
320		FTRParamsChanged    : Boolean;
321		FInEndTransaction   : boolean;
322	+	FEndAction          : TTransactionAction;
323	+	procedure DoBeforeTransactionEnd;
324	+	procedure DoAfterTransactionEnd;
325	+	procedure DoOnStartTransaction;
326	+	procedure DoAfterExecQuery(Sender: TObject);
327	+	procedure DoAfterEdit(Sender: TObject);
328	+	procedure DoAfterDelete(Sender: TObject);
329	+	procedure DoAfterInsert(Sender: TObject);
330	+	procedure DoAfterPost(Sender: TObject);
331		procedure EnsureNotInTransaction;
332		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
333		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 305 | Line 338 | type
338		function GetIdleTimer: Integer;
339		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340		procedure SetActive(Value: Boolean);
308	–	procedure SetDefaultAction(Value: TTransactionAction);
341		procedure SetDefaultDatabase(Value: TIBDatabase);
342		procedure SetIdleTimer(Value: Integer);
343		procedure SetTRParams(Value: TStrings);
#	Line 318 | Line 350 | type
350
351		protected
352		procedure Loaded; override;
321	–	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;
327	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358		procedure Commit;
359		procedure CommitRetaining;
360		procedure Rollback;
#	Line 336 | Line 366 | type
366		function AddDatabase(db: TIBDatabase): Integer;
367		function FindDatabase(db: TIBDatabase): Integer;
368		function FindDefaultDatabase: TIBDatabase;
369	+	function GetEndAction: TTransactionAction;
370		procedure RemoveDatabase(Idx: Integer);
371		procedure RemoveDatabases;
372		procedure CheckDatabasesInList;
#	Line 344 | 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;
347	–	property Handle: TISC_TR_HANDLE read FHandle;
348	–	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	<	end;
389	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
390	>	write FBeforeTransactionEnd;
391	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
392	>	write FAfterTransactionEnd;
393	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
394	>	write FOnStartTransaction;
395	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
396	>	write FAfterExecQuery;
397	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
398	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
399	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
400	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
401	>	end;
402	>
403	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
404	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
405	>	var DBName: string) of object;
406
407		{ TIBBase }
408
#	Line 366 | Line 411 | type
411		connections. }
412		TIBBase = class(TObject)
413		protected
414	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
415		FDatabase: TIBDatabase;
416		FIndexInDatabase: Integer;
417		FTransaction: TIBTransaction;
#	Line 375 | Line 421 | type
421		FAfterDatabaseDisconnect: TNotifyEvent;
422		FAfterDatabaseConnect: TNotifyEvent;
423		FOnDatabaseFree: TNotifyEvent;
424	<	FBeforeTransactionEnd: TNotifyEvent;
424	>	FBeforeTransactionEnd: TTransactionEndEvent;
425		FAfterTransactionEnd: TNotifyEvent;
426		FOnTransactionFree: TNotifyEvent;
427
428	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
429	+	var DBName: string); virtual;
430		procedure DoAfterDatabaseConnect; virtual;
431		procedure DoBeforeDatabaseDisconnect; virtual;
432		procedure DoAfterDatabaseDisconnect; virtual;
433		procedure DoDatabaseFree; virtual;
434	<	procedure DoBeforeTransactionEnd; virtual;
434	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435		procedure DoAfterTransactionEnd; virtual;
436		procedure DoTransactionFree; virtual;
389	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
390	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
437		procedure SetDatabase(Value: TIBDatabase); virtual;
438		procedure SetTransaction(Value: TIBTransaction); virtual;
439		public
#	Line 395 | Line 441 | type
441		destructor Destroy; override;
442		procedure CheckDatabase; virtual;
443		procedure CheckTransaction; virtual;
444	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
445	+	procedure DoAfterEdit(Sender: TObject); virtual;
446	+	procedure DoAfterDelete(Sender: TObject); virtual;
447	+	procedure DoAfterInsert(Sender: TObject); virtual;
448	+	procedure DoAfterPost(Sender: TObject); virtual;
449	+	procedure HandleException(Sender: TObject);
450	+	procedure SetCursor;
451	+	procedure RestoreCursor;
452		public
453	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
454	+	write FBeforeDatabaseConnect;
455		property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
456		write FAfterDatabaseConnect;
457		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
#	Line 403 | Line 459 | type
459		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
460		write FAfterDatabaseDisconnect;
461		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
462	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
464		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465		property Database: TIBDatabase read FDatabase
466		write SetDatabase;
411	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467		property Owner: TObject read FOwner;
413	–	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;
480
481		{ TIBDatabase }
482
483	<	constructor TIBDatabase.Create(AOwner: TComponent);
430	<	{$ifdef WINDOWS}
431	<	var acp: uint;
432	<	{$endif}
483	>	constructor TIBDataBase.Create(AOwner: TComponent);
484		begin
485		inherited Create(AOwner);
435	–	FIBLoaded := False;
436	–	CheckIBLoaded;
437	–	FIBLoaded := True;
486		LoginPrompt := True;
487		FSQLObjects := TList.Create;
488		FTransactions := TList.Create;
489		FDBName := '';
490		FDBParams := TStringList.Create;
491	<	{$ifdef UNIX}
492	<	if csDesigning in ComponentState then
493	<	FDBParams.Add('lc_ctype=UTF-8');
494	<	{$else}
495	<	{$ifdef WINDOWS}
448	<	if csDesigning in ComponentState then
449	<	begin
450	<	acp := GetACP;
451	<	if (acp >= 1250) and (acp <= 1254) then
452	<	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
453	<	end;
454	<	{$endif}
455	<	{$endif}
491	>	FSQLHourGlass := true;
492	>	if (AOwner <> nil) and
493	>	(AOwner is TCustomApplication) and
494	>	TCustomApplication(AOWner).ConsoleApplication then
495	>	LoginPrompt := false;
496		FDBParamsChanged := True;
497		TStringList(FDBParams).OnChange := DBParamsChange;
498		TStringList(FDBParams).OnChanging := DBParamsChanging;
499		FDPB := nil;
460	–	FHandle := nil;
500		FUserNames := nil;
501		FInternalTransaction := TIBTransaction.Create(self);
502		FInternalTransaction.DefaultDatabase := Self;
503	<	FTimer := TTimer.Create(Self);
503	>	FTimer := TFPTimer.Create(Self);
504		FTimer.Enabled := False;
505		FTimer.Interval := 0;
506		FTimer.OnTimer := TimeoutConnection;
#	Line 472 | 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;
493	<	FSQLObjects.Free;
494	<	FUserNames.Free;
495	<	FTransactions.Free;
496	<	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
536	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
502	<	RaiseError: Boolean): ISC_STATUS;
503	<	begin
504	<	result := ErrCode;
505	<	FCanTimeout := False;
506	<	if RaiseError and (ErrCode > 0) then
507	<	IBDataBaseError;
508	<	end;
509	<
510	<	procedure TIBDatabase.CheckActive;
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
544	<	procedure TIBDatabase.EnsureInactive;
544	>	procedure TIBDataBase.EnsureInactive;
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;
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;
559	>	procedure TIBDataBase.CheckDatabaseName;
560		begin
561	<	if (FDBName = '') then
561	>	if (Trim(FDBName) = '') then
562		IBError(ibxeDatabaseNameMissing, [nil]);
563		end;
564
565	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
565	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
566		begin
567		result := 0;
568		if (ds.Owner is TIBCustomDataSet) then
#	Line 549 | Line 575 | begin
575		FSQLObjects[result] := ds;
576		end;
577
578	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
578	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
579		begin
580		result := FindTransaction(TR);
581		if result <> -1 then
#	Line 566 | Line 592 | begin
592		FTransactions[result] := TR;
593		end;
594
595	<	procedure TIBDatabase.DoDisconnect;
595	>	procedure TIBDataBase.DoDisconnect;
596		begin
597		if Connected then
598		InternalClose(False);
599		FDBSQLDialect := 1;
600		end;
601
602	<	procedure TIBDatabase.CreateDatabase;
577	<	var
578	<	tr_handle: TISC_TR_HANDLE;
602	>	procedure TIBDataBase.CreateDatabase;
603		begin
604		CheckInactive;
605	<	tr_handle := nil;
606	<	Call(
607	<	isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
608	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
609	<	Params.Text), SQLDialect, nil),
610	<	True);
605	>	CheckDatabaseName;
606	>	FCreateDatabase := true;
607	>	Connected := true;
608	>	end;
609	>
610	>	procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
611	>	begin
612	>	CheckInactive;
613	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
614	>	FDBName := Attachment.GetConnectString;
615	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
616	>	OnCreateDatabase(self);
617		end;
618
619	<	procedure TIBDatabase.DropDatabase;
619	>	procedure TIBDataBase.DropDatabase;
620		begin
621		CheckActive;
622	<	Call(isc_drop_database(StatusVector, @FHandle), True);
622	>	FAttachment.DropDatabase;
623	>	FAttachment := nil;
624		end;
625
626	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
626	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
627		begin
628		FDBParamsChanged := True;
629		end;
630
631	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
631	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
632		begin
633		EnsureInactive;
634		CheckInactive;
635		end;
636
637	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
637	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
638		var
639		i: Integer;
640		begin
#	Line 616 | Line 647 | begin
647		end;
648		end;
649
650	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
650	>	function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
651		var
652		i: Integer;
653		begin
#	Line 634 | Line 665 | begin
665		end;
666		end;
667
668	<	procedure TIBDatabase.ForceClose;
668	>	procedure TIBDataBase.ForceClose;
669		begin
670		if Connected then
671		InternalClose(True);
672		end;
673
674	<	function TIBDatabase.GetConnected: Boolean;
674	>	function TIBDataBase.GetConnected: Boolean;
675		begin
676	<	result := FHandle <> nil;
676	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
677		end;
678
679	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
679	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
680		begin
681		result := FSQLObjects[Index];
682		end;
683
684	<	function TIBDatabase.GetSQLObjectCount: Integer;
684	>	function TIBDataBase.GetSQLObjectCount: Integer;
685		var
686		i: Integer;
687		begin
#	Line 659 | Line 690 | begin
690		Inc(result);
691		end;
692
693	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
663	<	var
664	<	ConstIdx, EqualsIdx: Integer;
665	<	begin
666	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
667	<	begin
668	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
669	<	if ConstIdx = -1 then
670	<	result := ''
671	<	else
672	<	begin
673	<	result := Params[ConstIdx];
674	<	EqualsIdx := Pos('=', result); {mbcs ok}
675	<	if EqualsIdx = 0 then
676	<	result := ''
677	<	else
678	<	result := Copy(result, EqualsIdx + 1, Length(result));
679	<	end;
680	<	end
681	<	else
682	<	result := '';
683	<	end;
684	<
685	<	function TIBDatabase.GetIdleTimer: Integer;
693	>	function TIBDataBase.GetIdleTimer: Integer;
694		begin
695		result := FTimer.Interval;
696		end;
697
698	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
698	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
699		begin
700		result := FTransactions[Index];
701		end;
702
703	<	function TIBDatabase.GetTransactionCount: Integer;
703	>	function TIBDataBase.GetTransactionCount: Integer;
704		var
705		i: Integer;
706		begin
#	Line 702 | Line 710 | begin
710		Inc(result);
711		end;
712
713	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
713	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
714		var
715		i, pos_of_str: Integer;
716		begin
#	Line 718 | Line 726 | begin
726		end;
727		end;
728
729	<	procedure TIBDatabase.InternalClose(Force: Boolean);
729	>	procedure TIBDataBase.InternalClose(Force: Boolean);
730		var
731		i: Integer;
732		begin
#	Line 747 | Line 755 | begin
755		end;
756		end;
757
758	<	if (not HandleIsShared) and
759	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
752	<	(not Force) then
753	<	IBDataBaseError
754	<	else
755	<	begin
756	<	FHandle := nil;
757	<	FHandleIsShared := False;
758	<	end;
758	>	FAttachment.Disconnect(Force);
759	>	FAttachment := nil;
760
761		if not (csDesigning in ComponentState) then
762		MonitorHook.DBDisconnect(Self);
#	Line 787 | Line 788 | begin
788		(FDefaultTransaction.FStreamedActive) and
789		(not FDefaultTransaction.InTransaction) then
790		FDefaultTransaction.StartTransaction;
791	<	FStreamedConnected := False;
791	>	StreamedConnected := False;
792		end;
793		except
794		if csDesigning in ComponentState then
795	<	Application.HandleException(Self)
795	>	HandleException(Self)
796		else
797		raise;
798		end;
799		end;
800
801	<	procedure TIBDatabase.Notification( AComponent: TComponent;
802	<	Operation: TOperation);
801	>	procedure TIBDataBase.HandleException(Sender: TObject);
802	>	var aParent: TComponent;
803	>	begin
804	>	aParent := Owner;
805	>	while aParent <> nil do
806	>	begin
807	>	if aParent is TCustomApplication then
808	>	begin
809	>	TCustomApplication(aParent).HandleException(Sender);
810	>	Exit;
811	>	end;
812	>	aParent := aParent.Owner;
813	>	end;
814	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
815	>	end;
816	>
817	>	procedure TIBDataBase.Notification(AComponent: TComponent;
818	>	Operation: TOperation);
819		var
820		i: Integer;
821		begin
#	Line 812 | Line 829 | begin
829		end;
830		end;
831
832	<	function TIBDatabase.Login: Boolean;
832	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
833		var
834		IndexOfUser, IndexOfPassword: Integer;
835		Username, Password, OldPassword: String;
#	Line 848 | Line 865 | begin
865		LoginParams.Assign(Params);
866		FOnLogin(Self, LoginParams);
867		Params.Assign (LoginParams);
868	+	aDatabaseName := FDBName;
869		HidePassword;
870		finally
871		LoginParams.Free;
872		end;
873		end
874		else
875	+	if assigned(IBGUIInterface) then
876		begin
877		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
878		if IndexOfUser <> -1 then
#	Line 868 | Line 887 | begin
887		Length(Params[IndexOfPassword]));
888		OldPassword := password;
889		end;
890	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
890	>
891	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
892		if result then
893		begin
894	<	if IndexOfUser = -1 then
895	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
896	<	else
897	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
894	>	if Username <> '' then
895	>	begin
896	>	if IndexOfUser = -1 then
897	>	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
898	>	else
899	>	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
900		'=' + Username;
901	+	end
902	+	else
903	+	if IndexOfUser <> -1 then
904	+	Params.Delete(IndexOfUser);
905		if (Password = OldPassword) then
906		FHiddenPassword := ''
907		else
#	Line 885 | Line 911 | begin
911		HidePassword;
912		end;
913		end;
914	<	end;
914	>	end
915	>	else
916	>	if LoginPrompt then
917	>	IBError(ibxeNoLoginDialog,[]);
918		finally
919		FLoginCalled := false
920		end;
921		end;
922
923	<	procedure TIBDatabase.DoConnect;
923	>	procedure TIBDataBase.DoConnect;
924		var
896	–	DPB: String;
925		TempDBParams: TStrings;
926		I: integer;
927	<
927	>	aDBName: string;
928	>	Status: IStatus;
929	>	CharSetID: integer;
930	>	CharSetName: AnsiString;
931		begin
932		CheckInactive;
933		CheckDatabaseName;
#	Line 906 | Line 937 | begin
937		FDBParamsChanged := True;
938		end;
939		{ Use builtin login prompt if requested }
940	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
940	>	aDBName := FDBName;
941	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
942		IBError(ibxeOperationCancelled, [nil]);
943	<	{ Generate a new DPB if necessary }
944	<	if (FDBParamsChanged) then
945	<	begin
946	<	FDBParamsChanged := False;
947	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
948	<	GenerateDPB(FDBParams, DPB, FDPBLength)
949	<	else
950	<	begin
951	<	TempDBParams := TStringList.Create;
952	<	try
953	<	TempDBParams.Assign(FDBParams);
954	<	TempDBParams.Add('password=' + FHiddenPassword);
955	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
956	<	finally
957	<	TempDBParams.Free;
958	<	end;
959	<	end;
960	<	IBAlloc(FDPB, 0, FDPBLength);
961	<	Move(DPB[1], FDPB[0], FDPBLength);
962	<	end;
963	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
964	<	PChar(FDBName), @FHandle,
965	<	FDPBLength, FDPB), False) > 0 then
966	<	begin
967	<	FHandle := nil;
968	<	IBDataBaseError;
943	>
944	>	TempDBParams := TStringList.Create;
945	>	try
946	>	TempDBParams.Assign(FDBParams);
947	>	{$ifdef UNIX}
948	>	{See below for WINDOWS UseDefaultSystemCodePage}
949	>	if UseDefaultSystemCodePage then
950	>	TempDBParams.Values['lc_ctype'] :='UTF8';
951	>	{$endif}
952	>	{Opportunity to override defaults}
953	>	for i := 0 to FSQLObjects.Count - 1 do
954	>	begin
955	>	if FSQLObjects[i] <> nil then
956	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
957	>	end;
958	>
959	>	repeat
960	>	{ Generate a new DPB if necessary }
961	>	if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
962	>	begin
963	>	FDBParamsChanged := False;
964	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
965	>	FDPB := GenerateDPB(TempDBParams)
966	>	else
967	>	begin
968	>	TempDBParams.Values['password'] := FHiddenPassword;
969	>	FDPB := GenerateDPB(TempDBParams);
970	>	end;
971	>	end;
972	>
973	>	if FCreateDatabase then
974	>	begin
975	>	FCreateDatabase := false;
976	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
977	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
978	>	OnCreateDatabase(self);
979	>	end
980	>	else
981	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
982	>
983	>	if FAttachment = nil then
984	>	begin
985	>	Status := FirebirdAPI.GetStatus;
986	>	{$IFDEF UNIX}
987	>	if Pos(':',aDBName) = 0 then
988	>	begin
989	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
990	>	or
991	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
992	>	or
993	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
994	>	or
995	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
996	>	then
997	>	begin
998	>	aDBName := 'localhost:' + aDBName;
999	>	Continue;
1000	>	end
1001	>	end;
1002	>	{$ENDIF}
1003	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1004	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1005	>	FCreateDatabase := true
1006	>	else
1007	>	raise EIBInterBaseError.Create(Status);
1008	>	end;
1009	>
1010	>	if UseDefaultSystemCodePage and (FAttachment <> nil) then
1011	>	{Only now can we check the codepage in use by the Attachment.
1012	>	If not that required then re-open with required LCLType.}
1013	>	begin
1014	>	{$ifdef WINDOWS}
1015	>	if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1016	>	{$else}
1017	>	if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1018	>	{$endif}
1019	>	begin
1020	>	CharSetName := Attachment.GetCharsetName(CharSetID);
1021	>	if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1022	>	begin
1023	>	TempDBParams.Values['lc_ctype'] := CharSetName;
1024	>	FDBParamsChanged := True;
1025	>	FAttachment := nil;
1026	>	end
1027	>	end
1028	>	end;
1029	>
1030	>	until FAttachment <> nil;
1031	>
1032	>	finally
1033	>	TempDBParams.Free;
1034		end;
1035	+
1036	+	if not (csDesigning in ComponentState) then
1037	+	FDBName := aDBName; {Synchronise at run time}
1038		FDBSQLDialect := GetDBSQLDialect;
1039		ValidateClientSQLDialect;
1040		for i := 0 to FSQLObjects.Count - 1 do
#	Line 946 | Line 1046 | begin
1046		MonitorHook.DBConnect(Self);
1047		end;
1048
1049	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1049	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1050		var
1051		ds: TIBBase;
1052		begin
#	Line 960 | Line 1060 | begin
1060		end;
1061		end;
1062
1063	<	procedure TIBDatabase.RemoveSQLObjects;
1063	>	procedure TIBDataBase.RemoveSQLObjects;
1064		var
1065		i: Integer;
1066		begin
#	Line 972 | Line 1072 | begin
1072		end;
1073		end;
1074
1075	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1075	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1076		var
1077		TR: TIBTransaction;
1078		begin
#	Line 986 | Line 1086 | begin
1086		end;
1087		end;
1088
1089	<	procedure TIBDatabase.RemoveTransactions;
1089	>	procedure TIBDataBase.RemoveTransactions;
1090		var
1091		i: Integer;
1092		begin
#	Line 994 | Line 1094 | begin
1094		RemoveTransaction(i);
1095		end;
1096
1097	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1097	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1098		begin
1099		if FDBName <> Value then
1100		begin
#	Line 1004 | Line 1104 | begin
1104		end;
1105		end;
1106
1107	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1107	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1108		var
1109		ConstIdx: Integer;
1110		begin
#	Line 1023 | Line 1123 | begin
1123		end;
1124		end;
1125
1126	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1126	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1127		begin
1128		FDBParams.Assign(Value);
1129		end;
1130
1131	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1131	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1132		var
1133		i: Integer;
1134		begin
#	Line 1046 | Line 1146 | begin
1146		FDefaultTransaction := Value;
1147		end;
1148
1149	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1050	<	begin
1051	<	if HandleIsShared then
1052	<	Close
1053	<	else
1054	<	CheckInactive;
1055	<	FHandle := Value;
1056	<	FHandleIsShared := (Value <> nil);
1057	<	end;
1058	<
1059	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1149	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1150		begin
1151		if Value < 0 then
1152		IBError(ibxeTimeoutNegative, [nil])
#	Line 1075 | Line 1165 | begin
1165		end;
1166		end;
1167
1168	<	function TIBDatabase.TestConnected: Boolean;
1168	>	function TIBDataBase.TestConnected: Boolean;
1169		var
1170		DatabaseInfo: TIBDatabaseInfo;
1171		begin
#	Line 1096 | Line 1186 | begin
1186		end;
1187		end;
1188
1189	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1189	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1190		begin
1191		if Connected then
1192		begin
1193	<	if FCanTimeout then
1193	>	if not FAttachment.HasActivity then
1194		begin
1195		ForceClose;
1196		if Assigned(FOnIdleTimer) then
1197		FOnIdleTimer(Self);
1198		end
1109	–	else
1110	–	FCanTimeout := True;
1199		end;
1200		end;
1201
1202	<	function TIBDatabase.GetIsReadOnly: Boolean;
1202	>	function TIBDataBase.GetIsReadOnly: Boolean;
1203		var
1204		DatabaseInfo: TIBDatabaseInfo;
1205		begin
#	Line 1129 | Line 1217 | begin
1217		DatabaseInfo.Free;
1218		end;
1219
1220	<	function TIBDatabase.GetSQLDialect: Integer;
1220	>	function TIBDataBase.GetSQLDialect: Integer;
1221		begin
1222		Result := FSQLDialect;
1223		end;
1224
1225
1226	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1226	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1227		begin
1228		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1229	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1229	>	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1230		FSQLDialect := Value
1231		else
1232		IBError(ibxeSQLDialectInvalid, [nil]);
1233		end;
1234
1235	<	function TIBDatabase.GetDBSQLDialect: Integer;
1235	>	function TIBDataBase.GetDBSQLDialect: Integer;
1236		var
1237		DatabaseInfo: TIBDatabaseInfo;
1238		begin
#	Line 1154 | Line 1242 | begin
1242		DatabaseInfo.Free;
1243		end;
1244
1245	<	procedure TIBDatabase.ValidateClientSQLDialect;
1245	>	function TIBDataBase.GetDefaultCharSetID: integer;
1246	>	begin
1247	>	if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1248	>	Result := Attachment.GetDefaultCharSetID
1249	>	else
1250	>	Result := 0;
1251	>	end;
1252	>
1253	>	function TIBDataBase.GetDefaultCharSetName: AnsiString;
1254	>	begin
1255	>	if Attachment <> nil then
1256	>	Result := Attachment.GetCharsetName(DefaultCharSetID)
1257	>	else
1258	>	Result := '';
1259	>	end;
1260	>
1261	>	function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1262	>	begin
1263	>	if Attachment <> nil then
1264	>	Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1265	>	else
1266	>	Result := CP_NONE;
1267	>	end;
1268	>
1269	>	procedure TIBDataBase.ValidateClientSQLDialect;
1270		begin
1271		if (FDBSQLDialect < FSQLDialect) then
1272		begin
#	Line 1164 | Line 1276 | begin
1276		end;
1277		end;
1278
1279	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1279	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1280		var
1281		I: Integer;
1282		DS: TIBCustomDataSet;
#	Line 1190 | Line 1302 | begin
1302		TR.CommitRetaining;
1303		end;
1304
1305	<	procedure TIBDatabase.CloseDataSets;
1305	>	procedure TIBDataBase.CloseDataSets;
1306		var
1307		i: Integer;
1308		begin
#	Line 1199 | Line 1311 | begin
1311		DataSets[i].close;
1312		end;
1313
1314	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1314	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1315		begin
1316		if (Index >= 0) and (Index < FDataSets.Count) then
1317		Result := TDataSet(FDataSets[Index])
#	Line 1207 | Line 1319 | begin
1319		raise Exception.Create('Invalid Index to DataSets');
1320		end;
1321
1322	<	function TIBDatabase.GetDataSetCount : Longint;
1322	>	function TIBDataBase.GetDataSetCount: Longint;
1323		begin
1324		Result := FDataSets.Count;
1325		end;
#	Line 1228 | Line 1340 | begin
1340		inherited SetConnected(Value);
1341		end;
1342
1343	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1343	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1344		var
1345		Query: TIBSQL;
1346		begin
#	Line 1244 | Line 1356 | begin
1356		Query.Database := Self;
1357		Query.Transaction := FInternalTransaction;
1358		Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1359	<	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1359	>	'from RDB$RELATION_FIELDS R ' + {do not localize}
1360		'where R.RDB$RELATION_NAME = ' + {do not localize}
1361	<	'''' +
1362	<	FormatIdentifierValue(SQLDialect, TableName) +
1251	<	''' ' +
1252	<	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1361	>	'''' + ExtractIdentifier(SQLDialect, TableName) +
1362	>	''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1363		Query.Prepare;
1364		Query.ExecQuery;
1365		with List do
#	Line 1257 | Line 1367 | begin
1367		BeginUpdate;
1368		try
1369		Clear;
1370	<	while (not Query.EOF) and (Query.Next <> nil) do
1371	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1370	>	while (not Query.EOF) and Query.Next  do
1371	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1372		finally
1373		EndUpdate;
1374		end;
#	Line 1269 | Line 1379 | begin
1379		end;
1380		end;
1381
1382	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1382	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1383		var
1384		Query : TIBSQL;
1385		begin
#	Line 1297 | Line 1407 | begin
1407		BeginUpdate;
1408		try
1409		Clear;
1410	<	while (not Query.EOF) and (Query.Next <> nil) do
1411	<	List.Add(TrimRight(Query.Current[0].AsString));
1410	>	while (not Query.EOF) and Query.Next  do
1411	>	List.Add(TrimRight(Query.Fields[0].AsString));
1412		finally
1413		EndUpdate;
1414		end;
#	Line 1315 | Line 1425 | end;
1425		constructor TIBTransaction.Create(AOwner: TComponent);
1426		begin
1427		inherited Create(AOwner);
1318	–	FIBLoaded := False;
1319	–	CheckIBLoaded;
1320	–	FIBLoaded := True;
1321	–	CheckIBLoaded;
1428		FDatabases := TList.Create;
1429		FSQLObjects := TList.Create;
1324	–	FHandle := nil;
1430		FTPB := nil;
1326	–	FTPBLength := 0;
1431		FTRParams := TStringList.Create;
1432		FTRParamsChanged := True;
1433		TStringList(FTRParams).OnChange := TRParamsChange;
1434		TStringList(FTRParams).OnChanging := TRParamsChanging;
1435	<	FTimer := TTimer.Create(Self);
1435	>	FTimer := TFPTimer.Create(Self);
1436		FTimer.Enabled := False;
1437		FTimer.Interval := 0;
1438		FTimer.OnTimer := TimeoutTransaction;
#	Line 1339 | Line 1443 | destructor TIBTransaction.Destroy;
1443		var
1444		i: Integer;
1445		begin
1446	<	if FIBLoaded then
1447	<	begin
1448	<	if InTransaction then
1449	<	EndTransaction(FDefaultAction, True);
1450	<	for i := 0 to FSQLObjects.Count - 1 do
1451	<	if FSQLObjects[i] <> nil then
1452	<	SQLObjects[i].DoTransactionFree;
1453	<	RemoveSQLObjects;
1454	<	RemoveDatabases;
1455	<	FreeMem(FTPB);
1456	<	FTPB := nil;
1353	<	FTRParams.Free;
1354	<	FSQLObjects.Free;
1355	<	FDatabases.Free;
1356	<	end;
1446	>	if InTransaction then
1447	>	EndTransaction(FDefaultAction, True);
1448	>	for i := 0 to FSQLObjects.Count - 1 do
1449	>	if FSQLObjects[i] <> nil then
1450	>	SQLObjects[i].DoTransactionFree;
1451	>	RemoveSQLObjects;
1452	>	RemoveDatabases;
1453	>	FTPB := nil;
1454	>	FTRParams.Free;
1455	>	FSQLObjects.Free;
1456	>	FDatabases.Free;
1457		inherited Destroy;
1458		end;
1459
1360	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1361	–	RaiseError: Boolean): ISC_STATUS;
1362	–	var
1363	–	i: Integer;
1364	–	begin
1365	–	result := ErrCode;
1366	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1367	–	Databases[i].FCanTimeout := False;
1368	–	FCanTimeout := False;
1369	–	if RaiseError and (result > 0) then
1370	–	IBDataBaseError;
1371	–	end;
1372	–
1460		procedure TIBTransaction.CheckDatabasesInList;
1461		begin
1462		if GetDatabaseCount = 0 then
#	Line 1380 | Line 1467 | procedure TIBTransaction.CheckInTransact
1467		begin
1468		if FStreamedActive and (not InTransaction) then
1469		Loaded;
1470	<	if (FHandle = nil) then
1470	>	if (TransactionIntf = nil) then
1471		IBError(ibxeNotInTransaction, [nil]);
1472		end;
1473
1474	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1475	+	begin
1476	+	if Assigned(FBeforeTransactionEnd) then
1477	+	FBeforeTransactionEnd(self);
1478	+	end;
1479	+
1480	+	procedure TIBTransaction.DoAfterTransactionEnd;
1481	+	begin
1482	+	if Assigned(FAfterTransactionEnd) then
1483	+	FAfterTransactionEnd(self);
1484	+	end;
1485	+
1486	+	procedure TIBTransaction.DoOnStartTransaction;
1487	+	begin
1488	+	if assigned(FOnStartTransaction) then
1489	+	OnStartTransaction(self);
1490	+	end;
1491	+
1492	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1493	+	begin
1494	+	if assigned(FAfterExecQuery) then
1495	+	AfterExecQuery(Sender);
1496	+	end;
1497	+
1498	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1499	+	begin
1500	+	if assigned(FAfterEdit) then
1501	+	AfterEdit(Sender);
1502	+	end;
1503	+
1504	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1505	+	begin
1506	+	if assigned(FAfterDelete) then
1507	+	AfterDelete(Sender);
1508	+	end;
1509	+
1510	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1511	+	begin
1512	+	if assigned(FAfterInsert) then
1513	+	AfterInsert(Sender);
1514	+	end;
1515	+
1516	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1517	+	begin
1518	+	if assigned(FAfterPost) then
1519	+	AfterPost(Sender);
1520	+	end;
1521	+
1522		procedure TIBTransaction.EnsureNotInTransaction;
1523		begin
1524		if csDesigning in ComponentState then
1525		begin
1526	<	if FHandle <> nil then
1526	>	if TransactionIntf <> nil then
1527		Rollback;
1528		end;
1529		end;
1530
1531		procedure TIBTransaction.CheckNotInTransaction;
1532		begin
1533	<	if (FHandle <> nil) then
1533	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1534		IBError(ibxeInTransaction, [nil]);
1535		end;
1536
#	Line 1404 | Line 1539 | var
1539		i: Integer;
1540		NilFound: Boolean;
1541		begin
1542	+	EnsureNotInTransaction;
1543	+	CheckNotInTransaction;
1544	+	FTransactionIntf := nil;
1545	+
1546		i := FindDatabase(db);
1547		if i <> -1 then
1548		begin
#	Line 1454 | Line 1593 | end;
1593		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1594		Force: Boolean);
1595		var
1457	–	status: ISC_STATUS;
1596		i: Integer;
1597		begin
1598		CheckInTransaction;
1599		if FInEndTransaction then Exit;
1600		FInEndTransaction := true;
1601	+	FEndAction := Action;
1602		try
1603		case Action of
1604		TARollback, TACommit:
1605		begin
1606	<	if (HandleIsShared) and
1607	<	(Action <> FDefaultAction) and
1608	<	(not Force) then
1609	<	IBError(ibxeCantEndSharedTransaction, [nil]);
1606	>	try
1607	>	DoBeforeTransactionEnd;
1608	>	except on E: EIBInterBaseError do
1609	>	begin
1610	>	if not Force then
1611	>	raise;
1612	>	end;
1613	>	end;
1614	>
1615		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1616	<	SQLObjects[i].DoBeforeTransactionEnd;
1616	>	try
1617	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1618	>	except on E: EIBInterBaseError do
1619	>	begin
1620	>	if not Force then
1621	>	raise;
1622	>	end;
1623	>	end;
1624	>
1625		if InTransaction then
1626		begin
1627	<	if HandleIsShared then
1628	<	begin
1477	<	FHandle := nil;
1478	<	FHandleIsShared := False;
1479	<	status := 0;
1480	<	end
1481	<	else
1482	<	if (Action = TARollback) then
1483	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1484	<	else
1485	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1486	<	if ((Force) and (status > 0)) then
1487	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1488	<	if Force then
1489	<	FHandle := nil
1627	>	if (Action = TARollback) then
1628	>	FTransactionIntf.Rollback(Force)
1629		else
1630	<	if (status > 0) then
1631	<	IBDataBaseError;
1632	<	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1633	<	SQLObjects[i].DoAfterTransactionEnd;
1630	>	try
1631	>	FTransactionIntf.Commit;
1632	>	except on E: EIBInterBaseError do
1633	>	begin
1634	>	if Force then
1635	>	FTransactionIntf.Rollback(Force)
1636	>	else
1637	>	raise;
1638	>	end;
1639	>	end;
1640	>
1641	>	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642	>	try
1643	>	SQLObjects[i].DoAfterTransactionEnd;
1644	>	except on E: EIBInterBaseError do
1645	>	begin
1646	>	if not Force then
1647	>	raise;
1648	>	end;
1649	>	end;
1650	>	try
1651	>	DoAfterTransactionEnd;
1652	>	except on E: EIBInterBaseError do
1653	>	begin
1654	>	if not Force then
1655	>	raise;
1656	>	end;
1657	>	end;
1658		end;
1659		end;
1660		TACommitRetaining:
1661	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1661	>	FTransactionIntf.CommitRetaining;
1662	>
1663		TARollbackRetaining:
1664	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1664	>	FTransactionIntf.RollbackRetaining;
1665		end;
1666		if not (csDesigning in ComponentState) then
1667		begin
#	Line 1549 | Line 1713 | end;
1713
1714		function TIBTransaction.GetInTransaction: Boolean;
1715		begin
1716	<	result := (FHandle <> nil);
1716	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1717		end;
1718
1719		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1582 | Line 1746 | begin
1746		end;
1747		end;
1748
1749	+	function TIBTransaction.GetEndAction: TTransactionAction;
1750	+	begin
1751	+	if FInEndTransaction then
1752	+	Result := FEndAction
1753	+	else
1754	+	IBError(ibxeIB60feature, [nil])
1755	+	end;
1756	+
1757
1758		function TIBTransaction.GetIdleTimer: Integer;
1759		begin
#	Line 1597 | Line 1769 | procedure TIBTransaction.BeforeDatabaseD
1769		begin
1770		if InTransaction then
1771		EndTransaction(FDefaultAction, True);
1772	+	FTransactionIntf := nil;
1773		end;
1774
1775		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1605 | Line 1778 | var
1778		begin
1779		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1780		begin
1781	+	EnsureNotInTransaction;
1782	+	CheckNotInTransaction;
1783	+	FTransactionIntf := nil;
1784	+
1785		DB := Databases[Idx];
1786		FDatabases[Idx] := nil;
1787		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1617 | Line 1794 | procedure TIBTransaction.RemoveDatabases
1794		var
1795		i: Integer;
1796		begin
1797	+	EnsureNotInTransaction;
1798	+	CheckNotInTransaction;
1799	+	FTransactionIntf := nil;
1800	+
1801		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1802		RemoveDatabase(i);
1803		end;
#	Line 1663 | Line 1844 | begin
1844		Rollback;
1845		end;
1846
1666	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1667	–	begin
1668	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1669	–	IBError(ibxeIB60feature, [nil]);*)
1670	–	FDefaultAction := Value;
1671	–	end;
1672	–
1847		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1848		var
1849		i: integer;
#	Line 1687 | Line 1861 | begin
1861		for i := 0 to FSQLObjects.Count - 1 do
1862		if (FSQLObjects[i] <> nil) and
1863		(TIBBase(FSQLObjects[i]).Database = nil) then
1864	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1864	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1865		end;
1866		FDefaultDatabase := Value;
1867		end;
1868
1695	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1696	–	begin
1697	–	if (HandleIsShared) then
1698	–	EndTransaction(DefaultAction, True)
1699	–	else
1700	–	CheckNotInTransaction;
1701	–	FHandle := Value;
1702	–	FHandleIsShared := (Value <> nil);
1703	–	end;
1704	–
1869		procedure TIBTransaction.Notification( AComponent: TComponent;
1870		Operation: TOperation);
1871		var
#	Line 1743 | Line 1907 | end;
1907
1908		procedure TIBTransaction.StartTransaction;
1909		var
1746	–	pteb: PISC_TEB_ARRAY;
1747	–	TPB: String;
1910		i: Integer;
1911	+	Attachments: array of IAttachment;
1912	+	ValidDatabaseCount: integer;
1913		begin
1914		CheckNotInTransaction;
1915		CheckDatabasesInList;
1916	+	if TransactionIntf <> nil then
1917	+	begin
1918	+	TransactionIntf.Start(DefaultAction);
1919	+	Exit;
1920	+	end;
1921	+
1922		for i := 0 to FDatabases.Count - 1 do
1923		if  FDatabases[i] <> nil then
1924		begin
1925		with TIBDatabase(FDatabases[i]) do
1926		if not Connected then
1927	<	if FStreamedConnected then
1927	>	if StreamedConnected then
1928		begin
1929		Open;
1930	<	FStreamedConnected := False;
1930	>	StreamedConnected := False;
1931		end
1932		else
1933		IBError(ibxeDatabaseClosed, [nil]);
#	Line 1765 | Line 1935 | begin
1935		if FTRParamsChanged then
1936		begin
1937		FTRParamsChanged := False;
1938	<	GenerateTPB(FTRParams, TPB, FTPBLength);
1769	<	if FTPBLength > 0 then
1770	<	begin
1771	<	IBAlloc(FTPB, 0, FTPBLength);
1772	<	Move(TPB[1], FTPB[0], FTPBLength);
1773	<	end;
1938	>	FTPB :=  GenerateTPB(FTRParams);
1939		end;
1940
1941	<	pteb := nil;
1942	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1943	<	try
1944	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1945	<	begin
1946	<	pteb^[i].db_handle := @(Databases[i].Handle);
1947	<	pteb^[i].tpb_length := FTPBLength;
1948	<	pteb^[i].tpb_address := FTPB;
1949	<	end;
1950	<	if Call(isc_start_multiple(StatusVector, @FHandle,
1951	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1952	<	begin
1953	<	FHandle := nil;
1954	<	IBDataBaseError;
1790	<	end;
1791	<	if not (csDesigning in ComponentState) then
1792	<	MonitorHook.TRStart(Self);
1793	<	finally
1794	<	FreeMem(pteb);
1941	>	ValidDatabaseCount := 0;
1942	>	for i := 0 to DatabaseCount - 1 do
1943	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1944	>
1945	>	if ValidDatabaseCount = 1 then
1946	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1947	>	else
1948	>	begin
1949	>	SetLength(Attachments,ValidDatabaseCount);
1950	>	for i := 0 to DatabaseCount - 1 do
1951	>	if Databases[i] <> nil then
1952	>	Attachments[i] := Databases[i].Attachment;
1953	>
1954	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1955		end;
1956	+
1957	+	if not (csDesigning in ComponentState) then
1958	+	MonitorHook.TRStart(Self);
1959	+	DoOnStartTransaction;
1960		end;
1961
1962		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1963		begin
1964		if InTransaction then
1965		begin
1966	<	if FCanTimeout then
1966	>	if not TransactionIntf.HasActivity then
1967		begin
1968		EndTransaction(FDefaultAction, True);
1969		if Assigned(FOnIdleTimer) then
1970		FOnIdleTimer(Self);
1971		end
1808	–	else
1809	–	FCanTimeout := True;
1972		end;
1973		end;
1974
#	Line 1819 | Line 1981 | procedure TIBTransaction.TRParamsChangin
1981		begin
1982		EnsureNotInTransaction;
1983		CheckNotInTransaction;
1984	+	FTransactionIntf := nil;
1985		end;
1986
1987		{ TIBBase }
#	Line 1834 | Line 1997 | begin
1997		inherited Destroy;
1998		end;
1999
2000	+	procedure TIBBase.HandleException(Sender: TObject);
2001	+	begin
2002	+	if assigned(Database) then
2003	+	Database.HandleException(Sender)
2004	+	else
2005	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2006	+	end;
2007	+
2008	+	procedure TIBBase.SetCursor;
2009	+	begin
2010	+	if Assigned(Database) and not Database.SQLHourGlass then
2011	+	Exit;
2012	+	if assigned(IBGUIInterface) then
2013	+	IBGUIInterface.SetCursor;
2014	+	end;
2015	+
2016	+	procedure TIBBase.RestoreCursor;
2017	+	begin
2018	+	if Assigned(Database) and not Database.SQLHourGlass then
2019	+	Exit;
2020	+	if assigned(IBGUIInterface) then
2021	+	IBGUIInterface.RestoreCursor;
2022	+	end;
2023	+
2024		procedure TIBBase.CheckDatabase;
2025		begin
2026		if (FDatabase = nil) then
#	Line 1848 | Line 2035 | begin
2035		FTransaction.CheckInTransaction;
2036		end;
2037
2038	<	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2039	<	begin
1853	<	CheckDatabase;
1854	<	result := @FDatabase.Handle;
1855	<	end;
1856	<
1857	<	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2038	>	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2039	>	);
2040		begin
2041	<	CheckTransaction;
2042	<	result := @FTransaction.Handle;
2041	>	if assigned(FBeforeDatabaseConnect) then
2042	>	BeforeDatabaseConnect(self,DBParams,DBName);
2043		end;
2044
2045		procedure TIBBase.DoAfterDatabaseConnect;
#	Line 1886 | Line 2068 | begin
2068		SetTransaction(nil);
2069		end;
2070
2071	<	procedure TIBBase.DoBeforeTransactionEnd;
2071	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2072		begin
2073		if Assigned(BeforeTransactionEnd) then
2074	<	BeforeTransactionEnd(Self);
2074	>	BeforeTransactionEnd(Self,Action);
2075		end;
2076
2077		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1905 | Line 2087 | begin
2087		FTransaction := nil;
2088		end;
2089
2090	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2091	+	begin
2092	+	if FTransaction <> nil then
2093	+	FTransaction.DoAfterExecQuery(Sender);
2094	+	end;
2095	+
2096	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2097	+	begin
2098	+	if FTransaction <> nil then
2099	+	FTransaction.DoAfterEdit(Sender);
2100	+	end;
2101	+
2102	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2103	+	begin
2104	+	if FTransaction <> nil then
2105	+	FTransaction.DoAfterDelete(Sender);
2106	+	end;
2107	+
2108	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2109	+	begin
2110	+	if FTransaction <> nil then
2111	+	FTransaction.DoAfterInsert(Sender);
2112	+	end;
2113	+
2114	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2115	+	begin
2116	+	if FTransaction <> nil then
2117	+	FTransaction.DoAfterPost(Sender);
2118	+	end;
2119	+
2120		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2121		begin
2122		if (FDatabase <> nil) then
#	Line 1937 | Line 2149 | end;
2149		parameter buffer, and return it and its length
2150		in DPB and DPBLength, respectively. }
2151
2152	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2152	>	function GenerateDPB(sl: TStrings): IDPB;
2153		var
2154	<	i, j, pval: Integer;
2154	>	i, j: Integer;
2155		DPBVal: UShort;
2156		ParamName, ParamValue: string;
2157		begin
2158	<	{ The DPB is initially empty, with the exception that
1947	<	the DPB version must be the first byte of the string. }
1948	<	DPBLength := 1;
1949	<	DPB := Char(isc_dpb_version1);
2158	>	Result := FirebirdAPI.AllocateDPB;
2159
2160		{Iterate through the textual database parameters, constructing
2161		a DPB on-the-fly }
#	Line 1985 | Line 2194 | begin
2194		begin
2195		if DPBVal = isc_dpb_sql_dialect then
2196		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2197	<	DPB := DPB +
1989	<	Char(DPBVal) +
1990	<	Char(Length(ParamValue)) +
1991	<	ParamValue;
1992	<	Inc(DPBLength, 2 + Length(ParamValue));
2197	>	Result.Add(DPBVal).SetAsString(ParamValue);
2198		end;
2199	+
2200		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2201		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2202	<	begin
2203	<	DPB := DPB +
1998	<	Char(DPBVal) +
1999	<	#1 +
2000	<	Char(StrToInt(ParamValue));
2001	<	Inc(DPBLength, 3);
2002	<	end;
2202	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2203	>
2204		isc_dpb_sweep:
2205	<	begin
2206	<	DPB := DPB +
2006	<	Char(DPBVal) +
2007	<	#1 +
2008	<	Char(isc_dpb_records);
2009	<	Inc(DPBLength, 3);
2010	<	end;
2205	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2206	>
2207		isc_dpb_sweep_interval:
2208	<	begin
2209	<	pval := StrToInt(ParamValue);
2014	<	DPB := DPB +
2015	<	Char(DPBVal) +
2016	<	#4 +
2017	<	PChar(@pval)[0] +
2018	<	PChar(@pval)[1] +
2019	<	PChar(@pval)[2] +
2020	<	PChar(@pval)[3];
2021	<	Inc(DPBLength, 6);
2022	<	end;
2208	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2209	>
2210		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2211		isc_dpb_quit_log:
2212	<	begin
2026	<	DPB := DPB +
2027	<	Char(DPBVal) +
2028	<	#1 + #0;
2029	<	Inc(DPBLength, 3);
2030	<	end;
2212	>	Result.Add(DPBVal).SetAsByte(0);
2213		else
2214		begin
2215		if (DPBVal > 0) and
#	Line 2045 | Line 2227 | end;
2227		of the transaction parameters, generate a transaction
2228		parameter buffer, and return it and its length in
2229		TPB and TPBLength, respectively. }
2230	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2230	>	function GenerateTPB(sl: TStrings): ITPB;
2231		var
2232	<	i, j, TPBVal, ParamLength: Integer;
2232	>	i, j, TPBVal: Integer;
2233		ParamName, ParamValue: string;
2234		begin
2235	<	TPB := '';
2054	<	if (sl.Count = 0) then
2055	<	TPBLength := 0
2056	<	else
2057	<	begin
2058	<	TPBLength := sl.Count + 1;
2059	<	TPB := TPB + Char(isc_tpb_version3);
2060	<	end;
2235	>	Result := FirebirdAPI.AllocateTPB;
2236		for i := 0 to sl.Count - 1 do
2237		begin
2238		if (Trim(sl[i]) =  '') then
2064	–	begin
2065	–	Dec(TPBLength);
2239		Continue;
2240	<	end;
2240	>
2241		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2242		ParamName := LowerCase(sl[i]) {mbcs ok}
2243		else
#	Line 2088 | Line 2261 | begin
2261		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2262		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2263		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2264	<	TPB := TPB + Char(TPBVal);
2264	>	Result.Add(TPBVal);
2265	>
2266		isc_tpb_lock_read, isc_tpb_lock_write:
2267	<	begin
2268	<	TPB := TPB + Char(TPBVal);
2095	<	{ Now set the string parameter }
2096	<	ParamLength := Length(ParamValue);
2097	<	Inc(TPBLength, ParamLength + 1);
2098	<	TPB := TPB + Char(ParamLength) + ParamValue;
2099	<	end;
2267	>	Result.Add(TPBVal).SetAsString(ParamValue);
2268	>
2269		else
2270		begin
2271		if (TPBVal > 0) and

Diff Legend

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