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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
27	+	{    IBX For Lazarus (Firebird Express)                                  }
28	+	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	+	{    Portions created by MWA Software are copyright McCallum Whyman      }
30	+	{    Associates Ltd 2011                                                 }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBDatabase;
35
36		{$Mode Delphi}
37
38	+	{$codepage UTF8}
39	+
40		interface
41
42		uses
43	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
39	<	{$DEFINE HAS_SQLMONITOR}
43	>	{$IFDEF WINDOWS }
44		Windows,
45	+	{$ELSE}
46	+	unix,
47		{$ENDIF}
48	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
43	<	IB, DBLoginDlg;
48	>	SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49
50		const
51		DPBPrefix = 'isc_dpb_';
#	Line 111 | 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 135 | 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 151 | 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;
161	–	FCanTimeout: Boolean;
187		FSQLObjects: TList;
188		FTransactions: TList;
189		FDBName: TIBFileName;
190		FDBParams: TStrings;
191		FDBParamsChanged: Boolean;
167	–	FDPB: PChar;
168	–	FDPBLength: Short;
169	–	FHandle: TISC_DB_HANDLE;
170	–	FHandleIsShared: Boolean;
192		FOnIdleTimer: TNotifyEvent;
193		FDefaultTransaction: TIBTransaction;
194		FInternalTransaction: TIBTransaction;
195	<	FStreamedConnected: Boolean;
175	<	FTimer: TTimer;
195	>	FTimer: TFPTimer;
196		FUserNames: TStringList;
197		FDataSets: TList;
198	+	FLoginCalled: boolean;
199	+	FUseDefaultSystemCodePage: boolean;
200		procedure EnsureInactive;
201		function GetDBSQLDialect: Integer;
202		function GetSQLDialect: Integer;
#	Line 184 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
187	–	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 205 | Line 226 | type
226		procedure DoConnect; override;
227		procedure DoDisconnect; override;
228		function GetConnected: Boolean; override;
229	<	procedure Loaded; 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;
234	<
234	>	procedure ReadState(Reader: TReader); override;
235	>	procedure SetConnected (Value : boolean); override;
236		public
237		constructor Create(AOwner: TComponent); override;
238		destructor Destroy; override;
#	Line 225 | Line 248 | type
248		function IndexOfDBConst(st: String): Integer;
249		function TestConnected: Boolean;
250		procedure CheckDatabaseName;
228	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
251		function AddTransaction(TR: TIBTransaction): Integer;
252		function FindTransaction(TR: TIBTransaction): Integer;
253		function FindDefaultTransaction(): TIBTransaction;
254		procedure RemoveTransaction(Idx: Integer);
255		procedure RemoveTransactions;
234	–	procedure SetHandle(Value: TISC_DB_HANDLE);
256
257	<	property Handle: TISC_DB_HANDLE read FHandle;
257	>	property Attachment: IAttachment read FAttachment;
258	>	property DBSQLDialect : Integer read FDBSQLDialect;
259		property IsReadOnly: Boolean read GetIsReadOnly;
238	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
239	–	write SetDBParamByDPB;
260		property SQLObjectCount: Integer read GetSQLObjectCount;
261		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
242	–	property HandleIsShared: Boolean read FHandleIsShared;
262		property TransactionCount: Integer read GetTransactionCount;
263		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
264		property InternalTransaction: TIBTransaction read FInternalTransaction;
265	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
266	+	property DefaultCharSetID: integer read FDefaultCharSetID;
267	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
268
269		published
270		property Connected;
271	<	property StreamedConnected;
271	>	property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
272	>	property AllowStreamedConnected: boolean read FAllowStreamedConnected
273	>	write FAllowStreamedConnected;
274		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
275		property Params: TStrings read FDBParams write SetDBParams;
276		property LoginPrompt default True;
#	Line 254 | Line 278 | type
278		write SetDefaultTransaction;
279		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
280		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
281	<	property DBSQLDialect : Integer read FDBSQLDialect;
281	>	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
282		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
283	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
284	+	write FUseDefaultSystemCodePage;
285		property AfterConnect;
286		property AfterDisconnect;
287		property BeforeConnect;
288		property BeforeDisconnect;
289	+	property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
290		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
291		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
292		property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
293		end;
294
295	<	{ TIBTransaction }
295	>	TDefaultEndAction = TARollback..TACommit;
296
297	<	TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
297	>	{ TIBTransaction }
298
299		TIBTransaction = class(TComponent)
300		private
301	<	FIBLoaded: Boolean;
302	<	FCanTimeout         : Boolean;
301	>	FTransactionIntf: ITransaction;
302	>	FAfterDelete: TNotifyEvent;
303	>	FAfterEdit: TNotifyEvent;
304	>	FAfterExecQuery: TNotifyEvent;
305	>	FAfterInsert: TNotifyEvent;
306	>	FAfterPost: TNotifyEvent;
307	>	FAfterTransactionEnd: TNotifyEvent;
308	>	FBeforeTransactionEnd: TNotifyEvent;
309		FDatabases          : TList;
310	+	FOnStartTransaction: TNotifyEvent;
311		FSQLObjects         : TList;
312		FDefaultDatabase    : TIBDatabase;
279	–	FHandle             : TISC_TR_HANDLE;
280	–	FHandleIsShared     : Boolean;
313		FOnIdleTimer          : TNotifyEvent;
314		FStreamedActive     : Boolean;
315	<	FTPB                : PChar;
316	<	FTPBLength          : Short;
317	<	FTimer              : TTimer;
286	<	FDefaultAction      : TTransactionAction;
315	>	FTPB                : ITPB;
316	>	FTimer              : TFPTimer;
317	>	FDefaultAction      : TDefaultEndAction;
318		FTRParams           : TStrings;
319		FTRParamsChanged    : Boolean;
320	+	FInEndTransaction   : boolean;
321	+	FEndAction          : TTransactionAction;
322	+	procedure DoBeforeTransactionEnd;
323	+	procedure DoAfterTransactionEnd;
324	+	procedure DoOnStartTransaction;
325	+	procedure DoAfterExecQuery(Sender: TObject);
326	+	procedure DoAfterEdit(Sender: TObject);
327	+	procedure DoAfterDelete(Sender: TObject);
328	+	procedure DoAfterInsert(Sender: TObject);
329	+	procedure DoAfterPost(Sender: TObject);
330		procedure EnsureNotInTransaction;
331		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
332		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 296 | Line 337 | type
337		function GetIdleTimer: Integer;
338		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
339		procedure SetActive(Value: Boolean);
299	–	procedure SetDefaultAction(Value: TTransactionAction);
340		procedure SetDefaultDatabase(Value: TIBDatabase);
341		procedure SetIdleTimer(Value: Integer);
342		procedure SetTRParams(Value: TStrings);
#	Line 309 | Line 349 | type
349
350		protected
351		procedure Loaded; override;
312	–	procedure SetHandle(Value: TISC_TR_HANDLE);
352		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
353
354		public
355		constructor Create(AOwner: TComponent); override;
356		destructor Destroy; override;
318	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
357		procedure Commit;
358		procedure CommitRetaining;
359		procedure Rollback;
#	Line 327 | Line 365 | type
365		function AddDatabase(db: TIBDatabase): Integer;
366		function FindDatabase(db: TIBDatabase): Integer;
367		function FindDefaultDatabase: TIBDatabase;
368	+	function GetEndAction: TTransactionAction;
369		procedure RemoveDatabase(Idx: Integer);
370		procedure RemoveDatabases;
371		procedure CheckDatabasesInList;
#	Line 335 | Line 374 | type
374		property Databases[Index: Integer]: TIBDatabase read GetDatabase;
375		property SQLObjectCount: Integer read GetSQLObjectCount;
376		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
338	–	property Handle: TISC_TR_HANDLE read FHandle;
339	–	property HandleIsShared: Boolean read FHandleIsShared;
377		property InTransaction: Boolean read GetInTransaction;
378	<	property TPB: PChar read FTPB;
379	<	property TPBLength: Short read FTPBLength;
378	>	property TransactionIntf: ITransaction read FTransactionIntf;
379	>	property TPB: ITPB read FTPB;
380		published
381		property Active: Boolean read GetInTransaction write SetActive;
382		property DefaultDatabase: TIBDatabase read FDefaultDatabase
383		write SetDefaultDatabase;
384		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
385	<	property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
385	>	property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
386		property Params: TStrings read FTRParams write SetTRParams;
387		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
388	<	end;
388	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
389	>	write FBeforeTransactionEnd;
390	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
391	>	write FAfterTransactionEnd;
392	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
393	>	write FOnStartTransaction;
394	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
395	>	write FAfterExecQuery;
396	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
397	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
398	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
399	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
400	>	end;
401	>
402	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
403	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
404	>	var DBName: string) of object;
405
406		{ TIBBase }
407
#	Line 357 | Line 410 | type
410		connections. }
411		TIBBase = class(TObject)
412		protected
413	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
414		FDatabase: TIBDatabase;
415		FIndexInDatabase: Integer;
416		FTransaction: TIBTransaction;
#	Line 364 | Line 418 | type
418		FOwner: TObject;
419		FBeforeDatabaseDisconnect: TNotifyEvent;
420		FAfterDatabaseDisconnect: TNotifyEvent;
421	+	FAfterDatabaseConnect: TNotifyEvent;
422		FOnDatabaseFree: TNotifyEvent;
423	<	FBeforeTransactionEnd: TNotifyEvent;
423	>	FBeforeTransactionEnd: TTransactionEndEvent;
424		FAfterTransactionEnd: TNotifyEvent;
425		FOnTransactionFree: TNotifyEvent;
426
427	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
428	+	var DBName: string); virtual;
429	+	procedure DoAfterDatabaseConnect; virtual;
430		procedure DoBeforeDatabaseDisconnect; virtual;
431		procedure DoAfterDatabaseDisconnect; virtual;
432		procedure DoDatabaseFree; virtual;
433	<	procedure DoBeforeTransactionEnd; virtual;
433	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
434		procedure DoAfterTransactionEnd; virtual;
435		procedure DoTransactionFree; virtual;
378	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
379	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
436		procedure SetDatabase(Value: TIBDatabase); virtual;
437		procedure SetTransaction(Value: TIBTransaction); virtual;
438		public
#	Line 384 | Line 440 | type
440		destructor Destroy; override;
441		procedure CheckDatabase; virtual;
442		procedure CheckTransaction; virtual;
443	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
444	+	procedure DoAfterEdit(Sender: TObject); virtual;
445	+	procedure DoAfterDelete(Sender: TObject); virtual;
446	+	procedure DoAfterInsert(Sender: TObject); virtual;
447	+	procedure DoAfterPost(Sender: TObject); virtual;
448	+	procedure HandleException(Sender: TObject);
449	+	procedure SetCursor;
450	+	procedure RestoreCursor;
451		public
452	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
453	+	write FBeforeDatabaseConnect;
454	+	property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
455	+	write FAfterDatabaseConnect;
456		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
457		write FBeforeDatabaseDisconnect;
458		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
459		write FAfterDatabaseDisconnect;
460		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
461	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
461	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
463		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
464		property Database: TIBDatabase read FDatabase
465		write SetDatabase;
398	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
466		property Owner: TObject read FOwner;
400	–	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
467		property Transaction: TIBTransaction read FTransaction
468		write SetTransaction;
469		end;
470
471	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
472	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
471	>	function GenerateDPB(sl: TStrings): IDPB;
472	>	function GenerateTPB(sl: TStrings): ITPB;
473
474
475		implementation
476
477	<	uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
477	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478	>	typInfo, FBMessages, IBErrorCodes;
479
480		{ TIBDatabase }
481
482	<	constructor TIBDatabase.Create(AOwner: TComponent);
482	>	constructor TIBDataBase.Create(AOwner: TComponent);
483		begin
484		inherited Create(AOwner);
418	–	FIBLoaded := False;
419	–	CheckIBLoaded;
420	–	FIBLoaded := True;
485		LoginPrompt := True;
486		FSQLObjects := TList.Create;
487		FTransactions := TList.Create;
488		FDBName := '';
489		FDBParams := TStringList.Create;
490	+	FSQLHourGlass := true;
491	+	if (AOwner <> nil) and
492	+	(AOwner is TCustomApplication) and
493	+	TCustomApplication(AOWner).ConsoleApplication then
494	+	LoginPrompt := false;
495		FDBParamsChanged := True;
496		TStringList(FDBParams).OnChange := DBParamsChange;
497		TStringList(FDBParams).OnChanging := DBParamsChanging;
498		FDPB := nil;
430	–	FHandle := nil;
499		FUserNames := nil;
500		FInternalTransaction := TIBTransaction.Create(self);
501		FInternalTransaction.DefaultDatabase := Self;
502	<	FTimer := TTimer.Create(Self);
502	>	FTimer := TFPTimer.Create(Self);
503		FTimer.Enabled := False;
504		FTimer.Interval := 0;
505		FTimer.OnTimer := TimeoutConnection;
#	Line 439 | Line 507 | begin
507		FSQLDialect := 3;
508		FTraceFlags := [];
509		FDataSets := TList.Create;
510	+	CheckStreamConnect;
511		end;
512
513	<	destructor TIBDatabase.Destroy;
513	>	destructor TIBDataBase.Destroy;
514		var
515		i: Integer;
516		begin
517	<	if FIBLoaded then
518	<	begin
519	<	IdleTimer := 0;
520	<	if FHandle <> nil then
521	<	ForceClose;
522	<	for i := 0 to FSQLObjects.Count - 1 do
523	<	if FSQLObjects[i] <> nil then
524	<	SQLObjects[i].DoDatabaseFree;
525	<	RemoveSQLObjects;
526	<	RemoveTransactions;
527	<	FInternalTransaction.Free;
528	<	FreeMem(FDPB);
529	<	FDPB := nil;
530	<	FDBParams.Free;
462	<	FSQLObjects.Free;
463	<	FUserNames.Free;
464	<	FTransactions.Free;
465	<	end;
517	>	IdleTimer := 0;
518	>	if FAttachment <> nil then
519	>	ForceClose;
520	>	for i := 0 to FSQLObjects.Count - 1 do
521	>	if FSQLObjects[i] <> nil then
522	>	SQLObjects[i].DoDatabaseFree;
523	>	RemoveSQLObjects;
524	>	RemoveTransactions;
525	>	FInternalTransaction.Free;
526	>	FDPB := nil;
527	>	FDBParams.Free;
528	>	FSQLObjects.Free;
529	>	FUserNames.Free;
530	>	FTransactions.Free;
531		FDataSets.Free;
532		inherited Destroy;
533		end;
534
535	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
471	<	RaiseError: Boolean): ISC_STATUS;
472	<	begin
473	<	result := ErrCode;
474	<	FCanTimeout := False;
475	<	if RaiseError and (ErrCode > 0) then
476	<	IBDataBaseError;
477	<	end;
478	<
479	<	procedure TIBDatabase.CheckActive;
535	>	procedure TIBDataBase.CheckActive;
536		begin
537		if StreamedConnected and (not Connected) then
538		Loaded;
539	<	if FHandle = nil then
539	>	if FAttachment = nil then
540		IBError(ibxeDatabaseClosed, [nil]);
541		end;
542
543	<	procedure TIBDatabase.EnsureInactive;
543	>	procedure TIBDataBase.EnsureInactive;
544		begin
545		if csDesigning in ComponentState then
546		begin
547	<	if FHandle <> nil then
547	>	if FAttachment <> nil then
548		Close;
549		end
550		end;
551
552	<	procedure TIBDatabase.CheckInactive;
552	>	procedure TIBDataBase.CheckInactive;
553		begin
554	<	if FHandle <> nil then
554	>	if FAttachment <> nil then
555		IBError(ibxeDatabaseOpen, [nil]);
556		end;
557
558	<	procedure TIBDatabase.CheckDatabaseName;
558	>	procedure TIBDataBase.CheckDatabaseName;
559		begin
560	<	if (FDBName = '') then
560	>	if (Trim(FDBName) = '') then
561		IBError(ibxeDatabaseNameMissing, [nil]);
562		end;
563
564	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
564	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
565		begin
566		result := 0;
567		if (ds.Owner is TIBCustomDataSet) then
568	<	{$IFDEF LINUX}
513	<	FDataSets.Add(TDataSet(ds.Owner));
514	<	{$ELSE}
515	<	RegisterClient(TDataSet(ds.Owner));
516	<	{$ENDIF}
568	>	FDataSets.Add(ds.Owner);
569		while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
570		Inc(result);
571		if (result = FSQLObjects.Count) then
#	Line 522 | Line 574 | begin
574		FSQLObjects[result] := ds;
575		end;
576
577	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
577	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
578		begin
579		result := FindTransaction(TR);
580		if result <> -1 then
#	Line 539 | Line 591 | begin
591		FTransactions[result] := TR;
592		end;
593
594	<	procedure TIBDatabase.DoDisconnect;
594	>	procedure TIBDataBase.DoDisconnect;
595		begin
596		if Connected then
597		InternalClose(False);
598		FDBSQLDialect := 1;
599	+	FDefaultCharSetName := '';
600	+	FDefaultCharSetID := 0;
601	+	FDefaultCodePage := CP_NONE;
602		end;
603
604	<	procedure TIBDatabase.CreateDatabase;
550	<	var
551	<	tr_handle: TISC_TR_HANDLE;
604	>	procedure TIBDataBase.CreateDatabase;
605		begin
606		CheckInactive;
607	<	tr_handle := nil;
608	<	Call(
609	<	isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
557	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
558	<	Params.Text), SQLDialect, nil),
559	<	True);
607	>	CheckDatabaseName;
608	>	FCreateDatabase := true;
609	>	Connected := true;
610		end;
611
612	<	procedure TIBDatabase.DropDatabase;
612	>	procedure TIBDataBase.DropDatabase;
613		begin
614		CheckActive;
615	<	Call(isc_drop_database(StatusVector, @FHandle), True);
615	>	FAttachment.DropDatabase;
616	>	FAttachment := nil;
617		end;
618
619	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
619	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
620		begin
621		FDBParamsChanged := True;
622		end;
623
624	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
624	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
625		begin
626		EnsureInactive;
627		CheckInactive;
628		end;
629
630	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
630	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
631		var
632		i: Integer;
633		begin
#	Line 589 | Line 640 | begin
640		end;
641		end;
642
643	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
643	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
644		var
645		i: Integer;
646		begin
#	Line 607 | Line 658 | begin
658		end;
659		end;
660
661	<	procedure TIBDatabase.ForceClose;
661	>	procedure TIBDataBase.ForceClose;
662		begin
663		if Connected then
664		InternalClose(True);
665		end;
666
667	<	function TIBDatabase.GetConnected: Boolean;
667	>	function TIBDataBase.GetConnected: Boolean;
668		begin
669	<	result := FHandle <> nil;
669	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
670		end;
671
672	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
672	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
673		begin
674		result := FSQLObjects[Index];
675		end;
676
677	<	function TIBDatabase.GetSQLObjectCount: Integer;
677	>	function TIBDataBase.GetSQLObjectCount: Integer;
678		var
679		i: Integer;
680		begin
#	Line 632 | Line 683 | begin
683		Inc(result);
684		end;
685
686	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
636	<	var
637	<	ConstIdx, EqualsIdx: Integer;
638	<	begin
639	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
640	<	begin
641	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
642	<	if ConstIdx = -1 then
643	<	result := ''
644	<	else
645	<	begin
646	<	result := Params[ConstIdx];
647	<	EqualsIdx := Pos('=', result); {mbcs ok}
648	<	if EqualsIdx = 0 then
649	<	result := ''
650	<	else
651	<	result := Copy(result, EqualsIdx + 1, Length(result));
652	<	end;
653	<	end
654	<	else
655	<	result := '';
656	<	end;
657	<
658	<	function TIBDatabase.GetIdleTimer: Integer;
686	>	function TIBDataBase.GetIdleTimer: Integer;
687		begin
688		result := FTimer.Interval;
689		end;
690
691	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
691	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
692		begin
693		result := FTransactions[Index];
694		end;
695
696	<	function TIBDatabase.GetTransactionCount: Integer;
696	>	function TIBDataBase.GetTransactionCount: Integer;
697		var
698		i: Integer;
699		begin
#	Line 675 | Line 703 | begin
703		Inc(result);
704		end;
705
706	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
706	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
707		var
708		i, pos_of_str: Integer;
709		begin
#	Line 691 | Line 719 | begin
719		end;
720		end;
721
722	<	procedure TIBDatabase.InternalClose(Force: Boolean);
722	>	procedure TIBDataBase.InternalClose(Force: Boolean);
723		var
724		i: Integer;
725		begin
#	Line 720 | Line 748 | begin
748		end;
749		end;
750
751	<	if (not HandleIsShared) and
752	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
725	<	(not Force) then
726	<	IBDataBaseError
727	<	else
728	<	begin
729	<	FHandle := nil;
730	<	FHandleIsShared := False;
731	<	end;
751	>	FAttachment.Disconnect(Force);
752	>	FAttachment := nil;
753
733	–	{$IFDEF HAS_SQLMONITOR}
754		if not (csDesigning in ComponentState) then
755		MonitorHook.DBDisconnect(Self);
736	–	{$ENDIF}
756
757		for i := 0 to FSQLObjects.Count - 1 do
758		if FSQLObjects[i] <> nil then
759		SQLObjects[i].DoAfterDatabaseDisconnect;
760		end;
761
762	<	procedure TIBDatabase.Loaded;
762	>	procedure TIBDataBase.CheckStreamConnect;
763		var
764		i: integer;
765		begin
766		try
767	<	if StreamedConnected and (not Connected) then
767	>	if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
768		begin
750	–	inherited Loaded;
769		for i := 0 to FTransactions.Count - 1 do
770		if  FTransactions[i] <> nil then
771		begin
#	Line 763 | Line 781 | begin
781		(FDefaultTransaction.FStreamedActive) and
782		(not FDefaultTransaction.InTransaction) then
783		FDefaultTransaction.StartTransaction;
784	<	FStreamedConnected := False;
784	>	StreamedConnected := False;
785		end;
786		except
787		if csDesigning in ComponentState then
788	<	Application.HandleException(Self)
788	>	HandleException(Self)
789		else
790		raise;
791		end;
792		end;
793
794	<	procedure TIBDatabase.Notification( AComponent: TComponent;
795	<	Operation: TOperation);
794	>	procedure TIBDataBase.HandleException(Sender: TObject);
795	>	var aParent: TComponent;
796	>	begin
797	>	aParent := Owner;
798	>	while aParent <> nil do
799	>	begin
800	>	if aParent is TCustomApplication then
801	>	begin
802	>	TCustomApplication(aParent).HandleException(Sender);
803	>	Exit;
804	>	end;
805	>	aParent := aParent.Owner;
806	>	end;
807	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
808	>	end;
809	>
810	>	procedure TIBDataBase.Notification(AComponent: TComponent;
811	>	Operation: TOperation);
812		var
813		i: Integer;
814		begin
#	Line 788 | Line 822 | begin
822		end;
823		end;
824
825	<	function TIBDatabase.Login: Boolean;
825	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
826		var
827		IndexOfUser, IndexOfPassword: Integer;
828		Username, Password, OldPassword: String;
#	Line 812 | Line 846 | var
846		end;
847
848		begin
849	<	if Assigned(FOnLogin) then
849	>	Result := false;
850	>	if FLoginCalled then Exit;
851	>	FLoginCalled := true;
852	>	try
853	>	if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
854		begin
855		result := True;
856		LoginParams := TStringList.Create;
#	Line 820 | Line 858 | begin
858		LoginParams.Assign(Params);
859		FOnLogin(Self, LoginParams);
860		Params.Assign (LoginParams);
861	+	aDatabaseName := FDBName;
862		HidePassword;
863		finally
864		LoginParams.Free;
865		end;
866		end
867		else
868	+	if assigned(IBGUIInterface) then
869		begin
870		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
871		if IndexOfUser <> -1 then
#	Line 840 | Line 880 | begin
880		Length(Params[IndexOfPassword]));
881		OldPassword := password;
882		end;
883	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
883	>
884	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
885		if result then
886		begin
887	<	if IndexOfUser = -1 then
888	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
889	<	else
890	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
887	>	if Username <> '' then
888	>	begin
889	>	if IndexOfUser = -1 then
890	>	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
891	>	else
892	>	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
893		'=' + Username;
894	+	end
895	+	else
896	+	if IndexOfUser <> -1 then
897	+	Params.Delete(IndexOfUser);
898		if (Password = OldPassword) then
899		FHiddenPassword := ''
900		else
#	Line 857 | Line 904 | begin
904		HidePassword;
905		end;
906		end;
907	+	end
908	+	else
909	+	if LoginPrompt then
910	+	IBError(ibxeNoLoginDialog,[]);
911	+	finally
912	+	FLoginCalled := false
913		end;
914		end;
915
916	<	procedure TIBDatabase.DoConnect;
916	>	procedure TIBDataBase.DoConnect;
917		var
865	–	DPB: String;
918		TempDBParams: TStrings;
919	<
919	>	I: integer;
920	>	aDBName: string;
921	>	Status: IStatus;
922	>	CharSetID: integer;
923		begin
924		CheckInactive;
925		CheckDatabaseName;
#	Line 874 | Line 929 | begin
929		FDBParamsChanged := True;
930		end;
931		{ Use builtin login prompt if requested }
932	<	if LoginPrompt and not Login then
932	>	aDBName := FDBName;
933	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
934		IBError(ibxeOperationCancelled, [nil]);
935	<	{ Generate a new DPB if necessary }
936	<	if (FDBParamsChanged) then
937	<	begin
938	<	FDBParamsChanged := False;
939	<	if (not LoginPrompt) or (FHiddenPassword = '') then
940	<	GenerateDPB(FDBParams, DPB, FDPBLength)
935	>
936	>	TempDBParams := TStringList.Create;
937	>	try
938	>	TempDBParams.Assign(FDBParams);
939	>	if UseDefaultSystemCodePage then
940	>	begin
941	>	{$ifdef WINDOWS}
942	>	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
943	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
944	>	{$else}
945	>	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946	>	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
947	>	{$endif}
948	>	else
949	>	TempDBParams.Values['lc_ctype'] :='UTF8';
950	>	end;
951	>	{Opportunity to override defaults}
952	>	for i := 0 to FSQLObjects.Count - 1 do
953	>	begin
954	>	if FSQLObjects[i] <> nil then
955	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
956	>	end;
957	>
958	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
959	>	if FDefaultCharSetName <> '' then
960	>	FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
961	>	FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
962	>	{ Generate a new DPB if necessary }
963	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
964	>	begin
965	>	FDBParamsChanged := False;
966	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
967	>	FDPB := GenerateDPB(TempDBParams)
968	>	else
969	>	begin
970	>	TempDBParams.Add('password=' + FHiddenPassword);
971	>	FDPB := GenerateDPB(TempDBParams);
972	>	end;
973	>	end;
974	>	finally
975	>	TempDBParams.Free;
976	>	end;
977	>
978	>	repeat
979	>	if FCreateDatabase then
980	>	begin
981	>	FCreateDatabase := false;
982	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
983	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
984	>	OnCreateDatabase(self);
985	>	end
986		else
987	+	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
988	+	if FAttachment = nil then
989		begin
990	<	TempDBParams := TStringList.Create;
991	<	try
992	<	TempDBParams.Assign(FDBParams);
993	<	TempDBParams.Add('password=' + FHiddenPassword);
994	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
995	<	finally
996	<	TempDBParams.Free;
990	>	Status := FirebirdAPI.GetStatus;
991	>	{$IFDEF UNIX}
992	>	if Pos(':',aDBName) = 0 then
993	>	begin
994	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
995	>	or
996	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
997	>	or
998	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
999	>	or
1000	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1001	>	then
1002	>	begin
1003	>	aDBName := 'localhost:' + aDBName;
1004	>	Continue;
1005	>	end
1006		end;
1007	+	{$ENDIF}
1008	+	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1009	+	and CreateIfNotExists and not (csDesigning in ComponentState) then
1010	+	FCreateDatabase := true
1011	+	else
1012	+	raise EIBInterBaseError.Create(Status);
1013		end;
1014	<	IBAlloc(FDPB, 0, FDPBLength);
1015	<	Move(DPB[1], FDPB[0], FDPBLength);
1016	<	end;
899	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
900	<	PChar(FDBName), @FHandle,
901	<	FDPBLength, FDPB), False) > 0 then
902	<	begin
903	<	FHandle := nil;
904	<	IBDataBaseError;
905	<	end;
1014	>	until FAttachment <> nil;
1015	>	if not (csDesigning in ComponentState) then
1016	>	FDBName := aDBName; {Synchronise at run time}
1017		FDBSQLDialect := GetDBSQLDialect;
1018		ValidateClientSQLDialect;
1019	<	{$IFDEF HAS_SQLMONITOR}
1019	>	for i := 0 to FSQLObjects.Count - 1 do
1020	>	begin
1021	>	if FSQLObjects[i] <> nil then
1022	>	SQLObjects[i].DoAfterDatabaseConnect;
1023	>	end;
1024		if not (csDesigning in ComponentState) then
1025		MonitorHook.DBConnect(Self);
911	–	{$ENDIF}
1026		end;
1027
1028	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1028	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1029		var
1030		ds: TIBBase;
1031		begin
#	Line 921 | Line 1035 | begin
1035		FSQLObjects[Idx] := nil;
1036		ds.Database := nil;
1037		if (ds.owner is TDataSet) then
924	–	{$IFDEF LINUX}
1038		FDataSets.Remove(TDataSet(ds.Owner));
926	–	{$ELSE}
927	–	UnregisterClient(TDataSet(ds.Owner));
928	–	{$ENDIF}
1039		end;
1040		end;
1041
1042	<	procedure TIBDatabase.RemoveSQLObjects;
1042	>	procedure TIBDataBase.RemoveSQLObjects;
1043		var
1044		i: Integer;
1045		begin
#	Line 937 | Line 1047 | begin
1047		begin
1048		RemoveSQLObject(i);
1049		if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940	–	{$IFDEF LINUX}
1050		FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942	–	{$ELSE}
943	–	UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944	–	{$ENDIF}
1051		end;
1052		end;
1053
1054	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1054	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1055		var
1056		TR: TIBTransaction;
1057		begin
#	Line 959 | Line 1065 | begin
1065		end;
1066		end;
1067
1068	<	procedure TIBDatabase.RemoveTransactions;
1068	>	procedure TIBDataBase.RemoveTransactions;
1069		var
1070		i: Integer;
1071		begin
#	Line 967 | Line 1073 | begin
1073		RemoveTransaction(i);
1074		end;
1075
1076	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1076	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1077		begin
1078		if FDBName <> Value then
1079		begin
#	Line 977 | Line 1083 | begin
1083		end;
1084		end;
1085
1086	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1086	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1087		var
1088		ConstIdx: Integer;
1089		begin
#	Line 996 | Line 1102 | begin
1102		end;
1103		end;
1104
1105	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1105	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1106		begin
1107		FDBParams.Assign(Value);
1108		end;
1109
1110	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1110	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1111		var
1112		i: Integer;
1113		begin
#	Line 1019 | Line 1125 | begin
1125		FDefaultTransaction := Value;
1126		end;
1127
1128	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1023	<	begin
1024	<	if HandleIsShared then
1025	<	Close
1026	<	else
1027	<	CheckInactive;
1028	<	FHandle := Value;
1029	<	FHandleIsShared := (Value <> nil);
1030	<	end;
1031	<
1032	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1128	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1129		begin
1130		if Value < 0 then
1131		IBError(ibxeTimeoutNegative, [nil])
#	Line 1048 | Line 1144 | begin
1144		end;
1145		end;
1146
1147	<	function TIBDatabase.TestConnected: Boolean;
1147	>	function TIBDataBase.TestConnected: Boolean;
1148		var
1149		DatabaseInfo: TIBDatabaseInfo;
1150		begin
#	Line 1069 | Line 1165 | begin
1165		end;
1166		end;
1167
1168	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1168	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1169		begin
1170		if Connected then
1171		begin
1172	<	if FCanTimeout then
1172	>	if not FAttachment.HasActivity then
1173		begin
1174		ForceClose;
1175		if Assigned(FOnIdleTimer) then
1176		FOnIdleTimer(Self);
1177		end
1082	–	else
1083	–	FCanTimeout := True;
1178		end;
1179		end;
1180
1181	<	function TIBDatabase.GetIsReadOnly: Boolean;
1181	>	function TIBDataBase.GetIsReadOnly: Boolean;
1182		var
1183		DatabaseInfo: TIBDatabaseInfo;
1184		begin
#	Line 1102 | Line 1196 | begin
1196		DatabaseInfo.Free;
1197		end;
1198
1199	<	function TIBDatabase.GetSQLDialect: Integer;
1199	>	function TIBDataBase.GetSQLDialect: Integer;
1200		begin
1201		Result := FSQLDialect;
1202		end;
1203
1204	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1204	>
1205	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1206		begin
1207		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1208	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1208	>	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1209		FSQLDialect := Value
1210		else
1211		IBError(ibxeSQLDialectInvalid, [nil]);
1212		end;
1213
1214	<	function TIBDatabase.GetDBSQLDialect: Integer;
1214	>	function TIBDataBase.GetDBSQLDialect: Integer;
1215		var
1216		DatabaseInfo: TIBDatabaseInfo;
1217		begin
#	Line 1126 | Line 1221 | begin
1221		DatabaseInfo.Free;
1222		end;
1223
1224	<	procedure TIBDatabase.ValidateClientSQLDialect;
1224	>	procedure TIBDataBase.ValidateClientSQLDialect;
1225		begin
1226		if (FDBSQLDialect < FSQLDialect) then
1227		begin
#	Line 1136 | Line 1231 | begin
1231		end;
1232		end;
1233
1234	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1234	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1235		var
1236		I: Integer;
1237		DS: TIBCustomDataSet;
#	Line 1162 | Line 1257 | begin
1257		TR.CommitRetaining;
1258		end;
1259
1260	<	procedure TIBDatabase.CloseDataSets;
1260	>	procedure TIBDataBase.CloseDataSets;
1261		var
1262		i: Integer;
1263		begin
#	Line 1171 | Line 1266 | begin
1266		DataSets[i].close;
1267		end;
1268
1269	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1269	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1270		begin
1271		if (Index >= 0) and (Index < FDataSets.Count) then
1272		Result := TDataSet(FDataSets[Index])
#	Line 1179 | Line 1274 | begin
1274		raise Exception.Create('Invalid Index to DataSets');
1275		end;
1276
1277	<	function TIBDatabase.GetDataSetCount : Longint;
1277	>	function TIBDataBase.GetDataSetCount: Longint;
1278		begin
1279		Result := FDataSets.Count;
1280		end;
1281
1282	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1282	>	procedure TIBDataBase.ReadState(Reader: TReader);
1283	>	begin
1284	>	FDBParams.Clear;
1285	>	inherited ReadState(Reader);
1286	>	end;
1287	>
1288	>	procedure TIBDataBase.SetConnected(Value: boolean);
1289	>	begin
1290	>	if StreamedConnected and not AllowStreamedConnected then
1291	>	begin
1292	>	StreamedConnected := false;
1293	>	Value := false
1294	>	end;
1295	>	inherited SetConnected(Value);
1296	>	end;
1297	>
1298	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1299		var
1300		Query: TIBSQL;
1301		begin
#	Line 1213 | Line 1324 | begin
1324		BeginUpdate;
1325		try
1326		Clear;
1327	<	while (not Query.EOF) and (Query.Next <> nil) do
1328	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1327	>	while (not Query.EOF) and Query.Next  do
1328	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1329		finally
1330		EndUpdate;
1331		end;
#	Line 1225 | Line 1336 | begin
1336		end;
1337		end;
1338
1339	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1339	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1340		var
1341		Query : TIBSQL;
1342		begin
#	Line 1253 | Line 1364 | begin
1364		BeginUpdate;
1365		try
1366		Clear;
1367	<	while (not Query.EOF) and (Query.Next <> nil) do
1368	<	List.Add(TrimRight(Query.Current[0].AsString));
1367	>	while (not Query.EOF) and Query.Next  do
1368	>	List.Add(TrimRight(Query.Fields[0].AsString));
1369		finally
1370		EndUpdate;
1371		end;
#	Line 1271 | Line 1382 | end;
1382		constructor TIBTransaction.Create(AOwner: TComponent);
1383		begin
1384		inherited Create(AOwner);
1274	–	FIBLoaded := False;
1275	–	CheckIBLoaded;
1276	–	FIBLoaded := True;
1277	–	CheckIBLoaded;
1385		FDatabases := TList.Create;
1386		FSQLObjects := TList.Create;
1280	–	FHandle := nil;
1387		FTPB := nil;
1282	–	FTPBLength := 0;
1388		FTRParams := TStringList.Create;
1389		FTRParamsChanged := True;
1390		TStringList(FTRParams).OnChange := TRParamsChange;
1391		TStringList(FTRParams).OnChanging := TRParamsChanging;
1392	<	FTimer := TTimer.Create(Self);
1392	>	FTimer := TFPTimer.Create(Self);
1393		FTimer.Enabled := False;
1394		FTimer.Interval := 0;
1395		FTimer.OnTimer := TimeoutTransaction;
#	Line 1295 | Line 1400 | destructor TIBTransaction.Destroy;
1400		var
1401		i: Integer;
1402		begin
1403	<	if FIBLoaded then
1404	<	begin
1405	<	if InTransaction then
1406	<	EndTransaction(FDefaultAction, True);
1407	<	for i := 0 to FSQLObjects.Count - 1 do
1408	<	if FSQLObjects[i] <> nil then
1409	<	SQLObjects[i].DoTransactionFree;
1410	<	RemoveSQLObjects;
1411	<	RemoveDatabases;
1412	<	FreeMem(FTPB);
1413	<	FTPB := nil;
1309	<	FTRParams.Free;
1310	<	FSQLObjects.Free;
1311	<	FDatabases.Free;
1312	<	end;
1403	>	if InTransaction then
1404	>	EndTransaction(FDefaultAction, True);
1405	>	for i := 0 to FSQLObjects.Count - 1 do
1406	>	if FSQLObjects[i] <> nil then
1407	>	SQLObjects[i].DoTransactionFree;
1408	>	RemoveSQLObjects;
1409	>	RemoveDatabases;
1410	>	FTPB := nil;
1411	>	FTRParams.Free;
1412	>	FSQLObjects.Free;
1413	>	FDatabases.Free;
1414		inherited Destroy;
1415		end;
1416
1316	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1317	–	RaiseError: Boolean): ISC_STATUS;
1318	–	var
1319	–	i: Integer;
1320	–	begin
1321	–	result := ErrCode;
1322	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1323	–	Databases[i].FCanTimeout := False;
1324	–	FCanTimeout := False;
1325	–	if RaiseError and (result > 0) then
1326	–	IBDataBaseError;
1327	–	end;
1328	–
1417		procedure TIBTransaction.CheckDatabasesInList;
1418		begin
1419		if GetDatabaseCount = 0 then
#	Line 1336 | Line 1424 | procedure TIBTransaction.CheckInTransact
1424		begin
1425		if FStreamedActive and (not InTransaction) then
1426		Loaded;
1427	<	if (FHandle = nil) then
1427	>	if (TransactionIntf = nil) then
1428		IBError(ibxeNotInTransaction, [nil]);
1429		end;
1430
1431	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1432	+	begin
1433	+	if Assigned(FBeforeTransactionEnd) then
1434	+	FBeforeTransactionEnd(self);
1435	+	end;
1436	+
1437	+	procedure TIBTransaction.DoAfterTransactionEnd;
1438	+	begin
1439	+	if Assigned(FAfterTransactionEnd) then
1440	+	FAfterTransactionEnd(self);
1441	+	end;
1442	+
1443	+	procedure TIBTransaction.DoOnStartTransaction;
1444	+	begin
1445	+	if assigned(FOnStartTransaction) then
1446	+	OnStartTransaction(self);
1447	+	end;
1448	+
1449	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1450	+	begin
1451	+	if assigned(FAfterExecQuery) then
1452	+	AfterExecQuery(Sender);
1453	+	end;
1454	+
1455	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1456	+	begin
1457	+	if assigned(FAfterEdit) then
1458	+	AfterEdit(Sender);
1459	+	end;
1460	+
1461	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1462	+	begin
1463	+	if assigned(FAfterDelete) then
1464	+	AfterDelete(Sender);
1465	+	end;
1466	+
1467	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1468	+	begin
1469	+	if assigned(FAfterInsert) then
1470	+	AfterInsert(Sender);
1471	+	end;
1472	+
1473	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1474	+	begin
1475	+	if assigned(FAfterPost) then
1476	+	AfterPost(Sender);
1477	+	end;
1478	+
1479		procedure TIBTransaction.EnsureNotInTransaction;
1480		begin
1481		if csDesigning in ComponentState then
1482		begin
1483	<	if FHandle <> nil then
1483	>	if TransactionIntf <> nil then
1484		Rollback;
1485		end;
1486		end;
1487
1488		procedure TIBTransaction.CheckNotInTransaction;
1489		begin
1490	<	if (FHandle <> nil) then
1490	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1491		IBError(ibxeInTransaction, [nil]);
1492		end;
1493
#	Line 1360 | Line 1496 | var
1496		i: Integer;
1497		NilFound: Boolean;
1498		begin
1499	+	EnsureNotInTransaction;
1500	+	CheckNotInTransaction;
1501	+	FTransactionIntf := nil;
1502	+
1503		i := FindDatabase(db);
1504		if i <> -1 then
1505		begin
#	Line 1410 | Line 1550 | end;
1550		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1551		Force: Boolean);
1552		var
1413	–	status: ISC_STATUS;
1553		i: Integer;
1554		begin
1555		CheckInTransaction;
1556	+	if FInEndTransaction then Exit;
1557	+	FInEndTransaction := true;
1558	+	FEndAction := Action;
1559	+	try
1560		case Action of
1561		TARollback, TACommit:
1562		begin
1563	<	if (HandleIsShared) and
1421	<	(Action <> FDefaultAction) and
1422	<	(not Force) then
1423	<	IBError(ibxeCantEndSharedTransaction, [nil]);
1563	>	DoBeforeTransactionEnd;
1564		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1565	<	SQLObjects[i].DoBeforeTransactionEnd;
1565	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1566		if InTransaction then
1567		begin
1568	<	if HandleIsShared then
1569	<	begin
1430	<	FHandle := nil;
1431	<	FHandleIsShared := False;
1432	<	status := 0;
1433	<	end
1434	<	else
1435	<	if (Action = TARollback) then
1436	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1437	<	else
1438	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1439	<	if ((Force) and (status > 0)) then
1440	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1441	<	if Force then
1442	<	FHandle := nil
1568	>	if (Action = TARollback) then
1569	>	FTransactionIntf.Rollback(Force)
1570		else
1571	<	if (status > 0) then
1572	<	IBDataBaseError;
1571	>	try
1572	>	FTransactionIntf.Commit;
1573	>	except on E: EIBInterBaseError do
1574	>	begin
1575	>	if Force then
1576	>	FTransactionIntf.Rollback(Force)
1577	>	else
1578	>	raise;
1579	>	end;
1580	>	end;
1581	>
1582		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1583		SQLObjects[i].DoAfterTransactionEnd;
1584	+	DoAfterTransactionEnd;
1585		end;
1586		end;
1587		TACommitRetaining:
1588	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1588	>	FTransactionIntf.CommitRetaining;
1589	>
1590		TARollbackRetaining:
1591	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1591	>	FTransactionIntf.RollbackRetaining;
1592		end;
1455	–	{$IFDEF HAS_SQLMONITOR}
1593		if not (csDesigning in ComponentState) then
1594		begin
1595		case Action of
#	Line 1466 | Line 1603 | begin
1603		MonitorHook.TRRollbackRetaining(Self);
1604		end;
1605		end;
1606	<	{$ENDIF}
1606	>	finally
1607	>	FInEndTransaction := false
1608	>	end;
1609		end;
1610
1611		function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
#	Line 1501 | Line 1640 | end;
1640
1641		function TIBTransaction.GetInTransaction: Boolean;
1642		begin
1643	<	result := (FHandle <> nil);
1643	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1644		end;
1645
1646		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1534 | Line 1673 | begin
1673		end;
1674		end;
1675
1676	+	function TIBTransaction.GetEndAction: TTransactionAction;
1677	+	begin
1678	+	if FInEndTransaction then
1679	+	Result := FEndAction
1680	+	else
1681	+	IBError(ibxeIB60feature, [nil])
1682	+	end;
1683	+
1684
1685		function TIBTransaction.GetIdleTimer: Integer;
1686		begin
#	Line 1549 | Line 1696 | procedure TIBTransaction.BeforeDatabaseD
1696		begin
1697		if InTransaction then
1698		EndTransaction(FDefaultAction, True);
1699	+	FTransactionIntf := nil;
1700		end;
1701
1702		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1557 | Line 1705 | var
1705		begin
1706		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1707		begin
1708	+	EnsureNotInTransaction;
1709	+	CheckNotInTransaction;
1710	+	FTransactionIntf := nil;
1711	+
1712		DB := Databases[Idx];
1713		FDatabases[Idx] := nil;
1714		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1569 | Line 1721 | procedure TIBTransaction.RemoveDatabases
1721		var
1722		i: Integer;
1723		begin
1724	+	EnsureNotInTransaction;
1725	+	CheckNotInTransaction;
1726	+	FTransactionIntf := nil;
1727	+
1728		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1729		RemoveDatabase(i);
1730		end;
#	Line 1615 | Line 1771 | begin
1771		Rollback;
1772		end;
1773
1618	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1619	–	begin
1620	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1621	–	IBError(ibxeIB60feature, [nil]);*)
1622	–	FDefaultAction := Value;
1623	–	end;
1624	–
1774		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1775		var
1776		i: integer;
#	Line 1639 | Line 1788 | begin
1788		for i := 0 to FSQLObjects.Count - 1 do
1789		if (FSQLObjects[i] <> nil) and
1790		(TIBBase(FSQLObjects[i]).Database = nil) then
1791	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1791	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1792		end;
1793		FDefaultDatabase := Value;
1794		end;
1795
1647	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1648	–	begin
1649	–	if (HandleIsShared) then
1650	–	EndTransaction(DefaultAction, True)
1651	–	else
1652	–	CheckNotInTransaction;
1653	–	FHandle := Value;
1654	–	FHandleIsShared := (Value <> nil);
1655	–	end;
1656	–
1796		procedure TIBTransaction.Notification( AComponent: TComponent;
1797		Operation: TOperation);
1798		var
#	Line 1695 | Line 1834 | end;
1834
1835		procedure TIBTransaction.StartTransaction;
1836		var
1698	–	pteb: PISC_TEB_ARRAY;
1699	–	TPB: String;
1837		i: Integer;
1838	+	Attachments: array of IAttachment;
1839	+	ValidDatabaseCount: integer;
1840		begin
1841		CheckNotInTransaction;
1842		CheckDatabasesInList;
1843	+	if TransactionIntf <> nil then
1844	+	begin
1845	+	TransactionIntf.Start(DefaultAction);
1846	+	Exit;
1847	+	end;
1848	+
1849		for i := 0 to FDatabases.Count - 1 do
1850		if  FDatabases[i] <> nil then
1851		begin
1852		with TIBDatabase(FDatabases[i]) do
1853		if not Connected then
1854	<	if FStreamedConnected then
1854	>	if StreamedConnected then
1855		begin
1856		Open;
1857	<	FStreamedConnected := False;
1857	>	StreamedConnected := False;
1858		end
1859		else
1860		IBError(ibxeDatabaseClosed, [nil]);
#	Line 1717 | Line 1862 | begin
1862		if FTRParamsChanged then
1863		begin
1864		FTRParamsChanged := False;
1865	<	GenerateTPB(FTRParams, TPB, FTPBLength);
1721	<	if FTPBLength > 0 then
1722	<	begin
1723	<	IBAlloc(FTPB, 0, FTPBLength);
1724	<	Move(TPB[1], FTPB[0], FTPBLength);
1725	<	end;
1865	>	FTPB :=  GenerateTPB(FTRParams);
1866		end;
1867
1868	<	pteb := nil;
1869	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1870	<	try
1871	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1872	<	begin
1873	<	pteb^[i].db_handle := @(Databases[i].Handle);
1874	<	pteb^[i].tpb_length := FTPBLength;
1875	<	pteb^[i].tpb_address := FTPB;
1876	<	end;
1877	<	if Call(isc_start_multiple(StatusVector, @FHandle,
1878	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1879	<	begin
1880	<	FHandle := nil;
1881	<	IBDataBaseError;
1742	<	end;
1743	<	{$IFDEF HAS_SQLMONITOR}
1744	<	if not (csDesigning in ComponentState) then
1745	<	MonitorHook.TRStart(Self);
1746	<	{$ENDIF}
1747	<	finally
1748	<	FreeMem(pteb);
1868	>	ValidDatabaseCount := 0;
1869	>	for i := 0 to DatabaseCount - 1 do
1870	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1871	>
1872	>	if ValidDatabaseCount = 1 then
1873	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1874	>	else
1875	>	begin
1876	>	SetLength(Attachments,ValidDatabaseCount);
1877	>	for i := 0 to DatabaseCount - 1 do
1878	>	if Databases[i] <> nil then
1879	>	Attachments[i] := Databases[i].Attachment;
1880	>
1881	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1882		end;
1883	+
1884	+	if not (csDesigning in ComponentState) then
1885	+	MonitorHook.TRStart(Self);
1886	+	DoOnStartTransaction;
1887		end;
1888
1889		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1890		begin
1891		if InTransaction then
1892		begin
1893	<	if FCanTimeout then
1893	>	if not TransactionIntf.HasActivity then
1894		begin
1895		EndTransaction(FDefaultAction, True);
1896		if Assigned(FOnIdleTimer) then
1897		FOnIdleTimer(Self);
1898		end
1762	–	else
1763	–	FCanTimeout := True;
1899		end;
1900		end;
1901
#	Line 1773 | Line 1908 | procedure TIBTransaction.TRParamsChangin
1908		begin
1909		EnsureNotInTransaction;
1910		CheckNotInTransaction;
1911	+	FTransactionIntf := nil;
1912		end;
1913
1914		{ TIBBase }
#	Line 1788 | Line 1924 | begin
1924		inherited Destroy;
1925		end;
1926
1927	+	procedure TIBBase.HandleException(Sender: TObject);
1928	+	begin
1929	+	if assigned(Database) then
1930	+	Database.HandleException(Sender)
1931	+	else
1932	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
1933	+	end;
1934	+
1935	+	procedure TIBBase.SetCursor;
1936	+	begin
1937	+	if Assigned(Database) and not Database.SQLHourGlass then
1938	+	Exit;
1939	+	if assigned(IBGUIInterface) then
1940	+	IBGUIInterface.SetCursor;
1941	+	end;
1942	+
1943	+	procedure TIBBase.RestoreCursor;
1944	+	begin
1945	+	if Assigned(Database) and not Database.SQLHourGlass then
1946	+	Exit;
1947	+	if assigned(IBGUIInterface) then
1948	+	IBGUIInterface.RestoreCursor;
1949	+	end;
1950	+
1951		procedure TIBBase.CheckDatabase;
1952		begin
1953		if (FDatabase = nil) then
#	Line 1802 | Line 1962 | begin
1962		FTransaction.CheckInTransaction;
1963		end;
1964
1965	<	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
1965	>	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1966	>	);
1967		begin
1968	<	CheckDatabase;
1969	<	result := @FDatabase.Handle;
1968	>	if assigned(FBeforeDatabaseConnect) then
1969	>	BeforeDatabaseConnect(self,DBParams,DBName);
1970		end;
1971
1972	<	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
1972	>	procedure TIBBase.DoAfterDatabaseConnect;
1973		begin
1974	<	CheckTransaction;
1975	<	result := @FTransaction.Handle;
1974	>	if assigned(FAfterDatabaseConnect) then
1975	>	AfterDatabaseConnect(self);
1976		end;
1977
1978		procedure TIBBase.DoBeforeDatabaseDisconnect;
#	Line 1834 | Line 1995 | begin
1995		SetTransaction(nil);
1996		end;
1997
1998	<	procedure TIBBase.DoBeforeTransactionEnd;
1998	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
1999		begin
2000		if Assigned(BeforeTransactionEnd) then
2001	<	BeforeTransactionEnd(Self);
2001	>	BeforeTransactionEnd(Self,Action);
2002		end;
2003
2004		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1853 | Line 2014 | begin
2014		FTransaction := nil;
2015		end;
2016
2017	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2018	+	begin
2019	+	if FTransaction <> nil then
2020	+	FTransaction.DoAfterExecQuery(Sender);
2021	+	end;
2022	+
2023	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2024	+	begin
2025	+	if FTransaction <> nil then
2026	+	FTransaction.DoAfterEdit(Sender);
2027	+	end;
2028	+
2029	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2030	+	begin
2031	+	if FTransaction <> nil then
2032	+	FTransaction.DoAfterDelete(Sender);
2033	+	end;
2034	+
2035	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2036	+	begin
2037	+	if FTransaction <> nil then
2038	+	FTransaction.DoAfterInsert(Sender);
2039	+	end;
2040	+
2041	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2042	+	begin
2043	+	if FTransaction <> nil then
2044	+	FTransaction.DoAfterPost(Sender);
2045	+	end;
2046	+
2047		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2048		begin
2049		if (FDatabase <> nil) then
#	Line 1885 | Line 2076 | end;
2076		parameter buffer, and return it and its length
2077		in DPB and DPBLength, respectively. }
2078
2079	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2079	>	function GenerateDPB(sl: TStrings): IDPB;
2080		var
2081	<	i, j, pval: Integer;
2081	>	i, j: Integer;
2082		DPBVal: UShort;
2083		ParamName, ParamValue: string;
2084		begin
2085	<	{ The DPB is initially empty, with the exception that
1895	<	the DPB version must be the first byte of the string. }
1896	<	DPBLength := 1;
1897	<	DPB := Char(isc_dpb_version1);
2085	>	Result := FirebirdAPI.AllocateDPB;
2086
2087		{Iterate through the textual database parameters, constructing
2088		a DPB on-the-fly }
#	Line 1933 | Line 2121 | begin
2121		begin
2122		if DPBVal = isc_dpb_sql_dialect then
2123		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2124	<	DPB := DPB +
1937	<	Char(DPBVal) +
1938	<	Char(Length(ParamValue)) +
1939	<	ParamValue;
1940	<	Inc(DPBLength, 2 + Length(ParamValue));
2124	>	Result.Add(DPBVal).SetAsString(ParamValue);
2125		end;
2126	+
2127		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2128		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2129	<	begin
2130	<	DPB := DPB +
1946	<	Char(DPBVal) +
1947	<	#1 +
1948	<	Char(StrToInt(ParamValue));
1949	<	Inc(DPBLength, 3);
1950	<	end;
2129	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2130	>
2131		isc_dpb_sweep:
2132	<	begin
2133	<	DPB := DPB +
1954	<	Char(DPBVal) +
1955	<	#1 +
1956	<	Char(isc_dpb_records);
1957	<	Inc(DPBLength, 3);
1958	<	end;
2132	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2133	>
2134		isc_dpb_sweep_interval:
2135	<	begin
2136	<	pval := StrToInt(ParamValue);
1962	<	DPB := DPB +
1963	<	Char(DPBVal) +
1964	<	#4 +
1965	<	PChar(@pval)[0] +
1966	<	PChar(@pval)[1] +
1967	<	PChar(@pval)[2] +
1968	<	PChar(@pval)[3];
1969	<	Inc(DPBLength, 6);
1970	<	end;
2135	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2136	>
2137		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2138		isc_dpb_quit_log:
2139	<	begin
1974	<	DPB := DPB +
1975	<	Char(DPBVal) +
1976	<	#1 + #0;
1977	<	Inc(DPBLength, 3);
1978	<	end;
2139	>	Result.Add(DPBVal).SetAsByte(0);
2140		else
2141		begin
2142		if (DPBVal > 0) and
#	Line 1993 | Line 2154 | end;
2154		of the transaction parameters, generate a transaction
2155		parameter buffer, and return it and its length in
2156		TPB and TPBLength, respectively. }
2157	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2157	>	function GenerateTPB(sl: TStrings): ITPB;
2158		var
2159	<	i, j, TPBVal, ParamLength: Integer;
2159	>	i, j, TPBVal: Integer;
2160		ParamName, ParamValue: string;
2161		begin
2162	<	TPB := '';
2002	<	if (sl.Count = 0) then
2003	<	TPBLength := 0
2004	<	else
2005	<	begin
2006	<	TPBLength := sl.Count + 1;
2007	<	TPB := TPB + Char(isc_tpb_version3);
2008	<	end;
2162	>	Result := FirebirdAPI.AllocateTPB;
2163		for i := 0 to sl.Count - 1 do
2164		begin
2165		if (Trim(sl[i]) =  '') then
2012	–	begin
2013	–	Dec(TPBLength);
2166		Continue;
2167	<	end;
2167	>
2168		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2169		ParamName := LowerCase(sl[i]) {mbcs ok}
2170		else
#	Line 2036 | Line 2188 | begin
2188		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2189		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2190		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2191	<	TPB := TPB + Char(TPBVal);
2191	>	Result.Add(TPBVal);
2192	>
2193		isc_tpb_lock_read, isc_tpb_lock_write:
2194	<	begin
2195	<	TPB := TPB + Char(TPBVal);
2043	<	{ Now set the string parameter }
2044	<	ParamLength := Length(ParamValue);
2045	<	Inc(TPBLength, ParamLength + 1);
2046	<	TPB := TPB + Char(ParamLength) + ParamValue;
2047	<	end;
2194	>	Result.Add(TPBVal).SetAsString(ParamValue);
2195	>
2196		else
2197		begin
2198		if (TPBVal > 0) and

Diff Legend

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