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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 37 by tony, Mon Feb 15 14:44:25 2016 UTC

#	Line 43 | Line 43 | uses
43		{$ELSE}
44		unix,
45		{$ENDIF}
46	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47	<	IB, DBLoginDlg;
46	>	SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
47	>	IB, CustApp;
48
49		const
50		DPBPrefix = 'isc_dpb_';
#	Line 159 | Line 159 | type
159		FHiddenPassword: string;
160		FIBLoaded: Boolean;
161		FOnLogin: TIBDatabaseLoginEvent;
162	+	FSQLHourGlass: Boolean;
163		FTraceFlags: TTraceFlags;
164		FDBSQLDialect: Integer;
165		FSQLDialect: Integer;
#	Line 177 | Line 178 | type
178		FDefaultTransaction: TIBTransaction;
179		FInternalTransaction: TIBTransaction;
180		FStreamedConnected: Boolean;
181	<	FTimer: TTimer;
181	>	FTimer: TFPTimer;
182		FUserNames: TStringList;
183		FDataSets: TList;
184		FLoginCalled: boolean;
185	+	FCharSetSizes: array of integer;
186	+	FCharSetNames: array of string;
187		procedure EnsureInactive;
188		function GetDBSQLDialect: Integer;
189		function GetSQLDialect: Integer;
#	Line 195 | Line 198 | type
198		function GetTransaction(Index: Integer): TIBTransaction;
199		function GetTransactionCount: Integer;
200		function Login: Boolean;
201	+	procedure LoadCharSetInfo;
202		procedure SetDatabaseName(const Value: TIBFileName);
203		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
204		procedure SetDBParams(Value: TStrings);
#	Line 212 | Line 216 | type
216		procedure DoDisconnect; override;
217		function GetConnected: Boolean; override;
218		procedure CheckStreamConnect;
219	+	procedure HandleException(Sender: TObject);
220		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
221		function GetDataset(Index : longint) : TDataset; override;
222		function GetDataSetCount : Longint; override;
223	+	procedure ReadState(Reader: TReader); override;
224		procedure SetConnected (Value : boolean); override;
225		public
226		constructor Create(AOwner: TComponent); override;
#	Line 261 | Line 267 | type
267		write SetDefaultTransaction;
268		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
269		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
270	+	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
271		property DBSQLDialect : Integer read FDBSQLDialect;
272		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
273		property AfterConnect;
#	Line 278 | Line 285 | type
285
286		TIBTransaction = class(TComponent)
287		private
288	+	FAfterDelete: TNotifyEvent;
289	+	FAfterEdit: TNotifyEvent;
290	+	FAfterExecQuery: TNotifyEvent;
291	+	FAfterInsert: TNotifyEvent;
292	+	FAfterPost: TNotifyEvent;
293	+	FAfterTransactionEnd: TNotifyEvent;
294	+	FBeforeTransactionEnd: TNotifyEvent;
295		FIBLoaded: Boolean;
296		FCanTimeout         : Boolean;
297		FDatabases          : TList;
298	+	FOnStartTransaction: TNotifyEvent;
299		FSQLObjects         : TList;
300		FDefaultDatabase    : TIBDatabase;
301		FHandle             : TISC_TR_HANDLE;
#	Line 289 | Line 304 | type
304		FStreamedActive     : Boolean;
305		FTPB                : PChar;
306		FTPBLength          : Short;
307	<	FTimer              : TTimer;
307	>	FTimer              : TFPTimer;
308		FDefaultAction      : TTransactionAction;
309		FTRParams           : TStrings;
310		FTRParamsChanged    : Boolean;
311		FInEndTransaction   : boolean;
312	+	FEndAction          : TTransactionAction;
313	+	procedure DoBeforeTransactionEnd;
314	+	procedure DoAfterTransactionEnd;
315	+	procedure DoOnStartTransaction;
316	+	procedure DoAfterExecQuery(Sender: TObject);
317	+	procedure DoAfterEdit(Sender: TObject);
318	+	procedure DoAfterDelete(Sender: TObject);
319	+	procedure DoAfterInsert(Sender: TObject);
320	+	procedure DoAfterPost(Sender: TObject);
321		procedure EnsureNotInTransaction;
322		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
323		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 335 | Line 359 | type
359		function AddDatabase(db: TIBDatabase): Integer;
360		function FindDatabase(db: TIBDatabase): Integer;
361		function FindDefaultDatabase: TIBDatabase;
362	+	function GetEndAction: TTransactionAction;
363		procedure RemoveDatabase(Idx: Integer);
364		procedure RemoveDatabases;
365		procedure CheckDatabasesInList;
#	Line 356 | Line 381 | type
381		property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
382		property Params: TStrings read FTRParams write SetTRParams;
383		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
384	<	end;
384	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
385	>	write FBeforeTransactionEnd;
386	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
387	>	write FAfterTransactionEnd;
388	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
389	>	write FOnStartTransaction;
390	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
391	>	write FAfterExecQuery;
392	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
393	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
394	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
395	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
396	>	end;
397	>
398	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
399	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
400	>	var DBName: string) of object;
401
402		{ TIBBase }
403
#	Line 365 | Line 406 | type
406		connections. }
407		TIBBase = class(TObject)
408		protected
409	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
410		FDatabase: TIBDatabase;
411		FIndexInDatabase: Integer;
412		FTransaction: TIBTransaction;
#	Line 374 | Line 416 | type
416		FAfterDatabaseDisconnect: TNotifyEvent;
417		FAfterDatabaseConnect: TNotifyEvent;
418		FOnDatabaseFree: TNotifyEvent;
419	<	FBeforeTransactionEnd: TNotifyEvent;
419	>	FBeforeTransactionEnd: TTransactionEndEvent;
420		FAfterTransactionEnd: TNotifyEvent;
421		FOnTransactionFree: TNotifyEvent;
422
423	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
424	+	var DBName: string); virtual;
425		procedure DoAfterDatabaseConnect; virtual;
426		procedure DoBeforeDatabaseDisconnect; virtual;
427		procedure DoAfterDatabaseDisconnect; virtual;
428		procedure DoDatabaseFree; virtual;
429	<	procedure DoBeforeTransactionEnd; virtual;
429	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
430		procedure DoAfterTransactionEnd; virtual;
431		procedure DoTransactionFree; virtual;
432		function GetDBHandle: PISC_DB_HANDLE; virtual;
#	Line 394 | Line 438 | type
438		destructor Destroy; override;
439		procedure CheckDatabase; virtual;
440		procedure CheckTransaction; virtual;
441	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
442	+	procedure DoAfterEdit(Sender: TObject); virtual;
443	+	procedure DoAfterDelete(Sender: TObject); virtual;
444	+	procedure DoAfterInsert(Sender: TObject); virtual;
445	+	procedure DoAfterPost(Sender: TObject); virtual;
446	+	function GetCharSetSize(CharSetID: integer): integer;
447	+	function GetDefaultCharSetSize: integer;
448	+	function GetCharSetName(CharSetID: integer): string;
449	+	function GetDefaultCharSetName: string;
450	+	procedure HandleException(Sender: TObject);
451	+	procedure SetCursor;
452	+	procedure RestoreCursor;
453		public
454	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
455	+	write FBeforeDatabaseConnect;
456		property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
457		write FAfterDatabaseConnect;
458		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
#	Line 402 | Line 460 | type
460		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
461		write FAfterDatabaseDisconnect;
462		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
463	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
464		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
465		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
466		property Database: TIBDatabase read FDatabase
#	Line 420 | Line 478 | procedure GenerateTPB(sl: TStrings; var
478
479		implementation
480
481	<	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
481	>	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
482	>	typInfo;
483
484		{ TIBDatabase }
485
486	<	constructor TIBDatabase.Create(AOwner: TComponent);
486	>	constructor TIBDataBase.Create(AOwner: TComponent);
487	>	{$ifdef WINDOWS}
488	>	var acp: uint;
489	>	{$endif}
490		begin
491		inherited Create(AOwner);
492		FIBLoaded := False;
#	Line 435 | Line 497 | begin
497		FTransactions := TList.Create;
498		FDBName := '';
499		FDBParams := TStringList.Create;
500	+	FSQLHourGlass := true;
501	+	if (AOwner <> nil) and
502	+	(AOwner is TCustomApplication) and
503	+	TCustomApplication(AOWner).ConsoleApplication then
504	+	LoginPrompt := false;
505	+	{$ifdef UNIX}
506	+	if csDesigning in ComponentState then
507	+	FDBParams.Add('lc_ctype=UTF8');
508	+	{$else}
509	+	{$ifdef WINDOWS}
510	+	if csDesigning in ComponentState then
511	+	begin
512	+	acp := GetACP;
513	+	if (acp >= 1250) and (acp <= 1254) then
514	+	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515	+	end;
516	+	{$endif}
517	+	{$endif}
518		FDBParamsChanged := True;
519		TStringList(FDBParams).OnChange := DBParamsChange;
520		TStringList(FDBParams).OnChanging := DBParamsChanging;
#	Line 443 | Line 523 | begin
523		FUserNames := nil;
524		FInternalTransaction := TIBTransaction.Create(self);
525		FInternalTransaction.DefaultDatabase := Self;
526	<	FTimer := TTimer.Create(Self);
526	>	FTimer := TFPTimer.Create(Self);
527		FTimer.Enabled := False;
528		FTimer.Interval := 0;
529		FTimer.OnTimer := TimeoutConnection;
#	Line 454 | Line 534 | begin
534		CheckStreamConnect;
535		end;
536
537	<	destructor TIBDatabase.Destroy;
537	>	destructor TIBDataBase.Destroy;
538		var
539		i: Integer;
540		begin
#	Line 480 | Line 560 | begin
560		inherited Destroy;
561		end;
562
563	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
564	<	RaiseError: Boolean): ISC_STATUS;
563	>	function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
564	>	): ISC_STATUS;
565		begin
566		result := ErrCode;
567		FCanTimeout := False;
#	Line 489 | Line 569 | begin
569		IBDataBaseError;
570		end;
571
572	<	procedure TIBDatabase.CheckActive;
572	>	procedure TIBDataBase.CheckActive;
573		begin
574		if StreamedConnected and (not Connected) then
575		Loaded;
#	Line 497 | Line 577 | begin
577		IBError(ibxeDatabaseClosed, [nil]);
578		end;
579
580	<	procedure TIBDatabase.EnsureInactive;
580	>	procedure TIBDataBase.EnsureInactive;
581		begin
582		if csDesigning in ComponentState then
583		begin
#	Line 506 | Line 586 | begin
586		end
587		end;
588
589	<	procedure TIBDatabase.CheckInactive;
589	>	procedure TIBDataBase.CheckInactive;
590		begin
591		if FHandle <> nil then
592		IBError(ibxeDatabaseOpen, [nil]);
593		end;
594
595	<	procedure TIBDatabase.CheckDatabaseName;
595	>	procedure TIBDataBase.CheckDatabaseName;
596		begin
597	<	if (FDBName = '') then
597	>	if (Trim(FDBName) = '') then
598		IBError(ibxeDatabaseNameMissing, [nil]);
599		end;
600
601	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
601	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
602		begin
603		result := 0;
604		if (ds.Owner is TIBCustomDataSet) then
#	Line 531 | Line 611 | begin
611		FSQLObjects[result] := ds;
612		end;
613
614	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
614	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
615		begin
616		result := FindTransaction(TR);
617		if result <> -1 then
#	Line 548 | Line 628 | begin
628		FTransactions[result] := TR;
629		end;
630
631	<	procedure TIBDatabase.DoDisconnect;
631	>	procedure TIBDataBase.DoDisconnect;
632		begin
633		if Connected then
634		InternalClose(False);
635		FDBSQLDialect := 1;
636	+	SetLength(FCharSetSizes,0);
637	+	SetLength(FCharSetNames,0);
638		end;
639
640	<	procedure TIBDatabase.CreateDatabase;
640	>	procedure TIBDataBase.CreateDatabase;
641		var
642		tr_handle: TISC_TR_HANDLE;
643		begin
#	Line 568 | Line 650 | begin
650		True);
651		end;
652
653	<	procedure TIBDatabase.DropDatabase;
653	>	procedure TIBDataBase.DropDatabase;
654		begin
655		CheckActive;
656		Call(isc_drop_database(StatusVector, @FHandle), True);
657		end;
658
659	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
659	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
660		begin
661		FDBParamsChanged := True;
662		end;
663
664	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
664	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
665		begin
666		EnsureInactive;
667		CheckInactive;
668		end;
669
670	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
670	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
671		var
672		i: Integer;
673		begin
#	Line 598 | Line 680 | begin
680		end;
681		end;
682
683	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
683	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
684		var
685		i: Integer;
686		begin
#	Line 616 | Line 698 | begin
698		end;
699		end;
700
701	<	procedure TIBDatabase.ForceClose;
701	>	procedure TIBDataBase.ForceClose;
702		begin
703		if Connected then
704		InternalClose(True);
705		end;
706
707	<	function TIBDatabase.GetConnected: Boolean;
707	>	function TIBDataBase.GetConnected: Boolean;
708		begin
709		result := FHandle <> nil;
710		end;
711
712	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
712	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
713		begin
714		result := FSQLObjects[Index];
715		end;
716
717	<	function TIBDatabase.GetSQLObjectCount: Integer;
717	>	function TIBDataBase.GetSQLObjectCount: Integer;
718		var
719		i: Integer;
720		begin
#	Line 641 | Line 723 | begin
723		Inc(result);
724		end;
725
726	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
726	>	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
727		var
728		ConstIdx, EqualsIdx: Integer;
729		begin
#	Line 664 | Line 746 | begin
746		result := '';
747		end;
748
749	<	function TIBDatabase.GetIdleTimer: Integer;
749	>	function TIBDataBase.GetIdleTimer: Integer;
750		begin
751		result := FTimer.Interval;
752		end;
753
754	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
754	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
755		begin
756		result := FTransactions[Index];
757		end;
758
759	<	function TIBDatabase.GetTransactionCount: Integer;
759	>	function TIBDataBase.GetTransactionCount: Integer;
760		var
761		i: Integer;
762		begin
#	Line 684 | Line 766 | begin
766		Inc(result);
767		end;
768
769	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
769	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
770		var
771		i, pos_of_str: Integer;
772		begin
#	Line 700 | Line 782 | begin
782		end;
783		end;
784
785	<	procedure TIBDatabase.InternalClose(Force: Boolean);
785	>	procedure TIBDataBase.InternalClose(Force: Boolean);
786		var
787		i: Integer;
788		begin
#	Line 747 | Line 829 | begin
829		SQLObjects[i].DoAfterDatabaseDisconnect;
830		end;
831
832	+	procedure TIBDataBase.LoadCharSetInfo;
833	+	var Query: TIBSQL;
834	+	i: integer;
835	+	begin
836	+	if not FInternalTransaction.Active then
837	+	FInternalTransaction.StartTransaction;
838	+	Query := TIBSQL.Create(self);
839	+	try
840	+	Query.Database := Self;
841	+	Query.Transaction := FInternalTransaction;
842	+	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
843	+	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
844	+	Query.Prepare;
845	+	Query.ExecQuery;
846	+	if not Query.EOF then
847	+	begin
848	+	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
849	+	SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
850	+	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
851	+	repeat
852	+	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
853	+	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
854	+	FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
855	+	Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
856	+	Query.Next;
857	+	until Query.EOF;
858	+	end;
859	+	finally
860	+	Query.free;
861	+	FInternalTransaction.Commit;
862	+	end;
863	+	end;
864	+
865		procedure TIBDataBase.CheckStreamConnect;
866		var
867		i: integer;
#	Line 773 | Line 888 | begin
888		end;
889		except
890		if csDesigning in ComponentState then
891	<	Application.HandleException(Self)
891	>	HandleException(Self)
892		else
893		raise;
894		end;
895		end;
896
897	<	procedure TIBDatabase.Notification( AComponent: TComponent;
898	<	Operation: TOperation);
897	>	procedure TIBDataBase.HandleException(Sender: TObject);
898	>	var aParent: TComponent;
899	>	begin
900	>	aParent := Owner;
901	>	while aParent <> nil do
902	>	begin
903	>	if aParent is TCustomApplication then
904	>	begin
905	>	TCustomApplication(aParent).HandleException(Sender);
906	>	Exit;
907	>	end;
908	>	aParent := aParent.Owner;
909	>	end;
910	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
911	>	end;
912	>
913	>	procedure TIBDataBase.Notification(AComponent: TComponent;
914	>	Operation: TOperation);
915		var
916		i: Integer;
917		begin
#	Line 794 | Line 925 | begin
925		end;
926		end;
927
928	<	function TIBDatabase.Login: Boolean;
928	>	function TIBDataBase.Login: Boolean;
929		var
930		IndexOfUser, IndexOfPassword: Integer;
931		Username, Password, OldPassword: String;
#	Line 836 | Line 967 | begin
967		end;
968		end
969		else
970	+	if assigned(IBGUIInterface) then
971		begin
972		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
973		if IndexOfUser <> -1 then
#	Line 850 | Line 982 | begin
982		Length(Params[IndexOfPassword]));
983		OldPassword := password;
984		end;
985	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
985	>	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
986		if result then
987		begin
988		if IndexOfUser = -1 then
#	Line 867 | Line 999 | begin
999		HidePassword;
1000		end;
1001		end;
1002	<	end;
1002	>	end
1003	>	else
1004	>	if LoginPrompt then
1005	>	IBError(ibxeNoLoginDialog,[]);
1006		finally
1007		FLoginCalled := false
1008		end;
1009		end;
1010
1011	<	procedure TIBDatabase.DoConnect;
1011	>	procedure TIBDataBase.DoConnect;
1012		var
1013		DPB: String;
1014		TempDBParams: TStrings;
1015		I: integer;
1016	+	aDBName: string;
1017
1018	+	{Call error analysis}
1019	+	sqlcode: Long;
1020	+	IBErrorCode: Long;
1021	+	status_vector: PISC_STATUS;
1022		begin
1023		CheckInactive;
1024		CheckDatabaseName;
#	Line 890 | Line 1030 | begin
1030		{ Use builtin login prompt if requested }
1031		if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1032		IBError(ibxeOperationCancelled, [nil]);
1033	<	{ Generate a new DPB if necessary }
1034	<	if (FDBParamsChanged) then
1035	<	begin
1036	<	FDBParamsChanged := False;
1037	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1038	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1039	<	else
1033	>
1034	>	TempDBParams := TStringList.Create;
1035	>	try
1036	>	TempDBParams.Assign(FDBParams);
1037	>	aDBName := FDBName;
1038	>	{Opportunity to override defaults}
1039	>	for i := 0 to FSQLObjects.Count - 1 do
1040	>	begin
1041	>	if FSQLObjects[i] <> nil then
1042	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1043	>	end;
1044	>
1045	>	{ Generate a new DPB if necessary }
1046	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1047	>	begin
1048	>	FDBParamsChanged := False;
1049	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1050	>	GenerateDPB(TempDBParams, DPB, FDPBLength)
1051	>	else
1052	>	begin
1053	>	TempDBParams.Add('password=' + FHiddenPassword);
1054	>	GenerateDPB(TempDBParams, DPB, FDPBLength);
1055	>	end;
1056	>	IBAlloc(FDPB, 0, FDPBLength);
1057	>	Move(DPB[1], FDPB[0], FDPBLength);
1058	>	end;
1059	>	finally
1060	>	TempDBParams.Free;
1061	>	end;
1062	>	repeat
1063	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1064	>	PChar(aDBName), @FHandle,
1065	>	FDPBLength, FDPB), False) > 0 then
1066		begin
1067	<	TempDBParams := TStringList.Create;
1068	<	try
1069	<	TempDBParams.Assign(FDBParams);
1070	<	TempDBParams.Add('password=' + FHiddenPassword);
1071	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1072	<	finally
1073	<	TempDBParams.Free;
1067	>	{$IFDEF UNIX}
1068	>	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1069	>	begin
1070	>	status_vector := StatusVector;
1071	>	IBErrorCode := StatusVectorArray[1];
1072	>	sqlcode := isc_sqlcode(StatusVector);
1073	>
1074	>	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1075	>	or
1076	>	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1077	>	then
1078	>	begin
1079	>	aDBName := 'localhost:' + aDBName;
1080	>	Continue;
1081	>	end;
1082		end;
1083	+	{$ENDIF}
1084	+	FHandle := nil;
1085	+	IBDataBaseError;
1086		end;
1087	<	IBAlloc(FDPB, 0, FDPBLength);
1088	<	Move(DPB[1], FDPB[0], FDPBLength);
1089	<	end;
913	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
914	<	PChar(FDBName), @FHandle,
915	<	FDPBLength, FDPB), False) > 0 then
916	<	begin
917	<	FHandle := nil;
918	<	IBDataBaseError;
919	<	end;
1087	>	until FHandle <> nil;
1088	>	if not (csDesigning in ComponentState) then
1089	>	FDBName := aDBName; {Synchronise at run time}
1090		FDBSQLDialect := GetDBSQLDialect;
1091		ValidateClientSQLDialect;
1092		for i := 0 to FSQLObjects.Count - 1 do
#	Line 926 | Line 1096 | begin
1096		end;
1097		if not (csDesigning in ComponentState) then
1098		MonitorHook.DBConnect(Self);
1099	+	LoadCharSetInfo;
1100		end;
1101
1102	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1102	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1103		var
1104		ds: TIBBase;
1105		begin
#	Line 942 | Line 1113 | begin
1113		end;
1114		end;
1115
1116	<	procedure TIBDatabase.RemoveSQLObjects;
1116	>	procedure TIBDataBase.RemoveSQLObjects;
1117		var
1118		i: Integer;
1119		begin
#	Line 954 | Line 1125 | begin
1125		end;
1126		end;
1127
1128	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1128	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1129		var
1130		TR: TIBTransaction;
1131		begin
#	Line 968 | Line 1139 | begin
1139		end;
1140		end;
1141
1142	<	procedure TIBDatabase.RemoveTransactions;
1142	>	procedure TIBDataBase.RemoveTransactions;
1143		var
1144		i: Integer;
1145		begin
#	Line 976 | Line 1147 | begin
1147		RemoveTransaction(i);
1148		end;
1149
1150	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1150	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1151		begin
1152		if FDBName <> Value then
1153		begin
#	Line 986 | Line 1157 | begin
1157		end;
1158		end;
1159
1160	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1160	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1161		var
1162		ConstIdx: Integer;
1163		begin
#	Line 1005 | Line 1176 | begin
1176		end;
1177		end;
1178
1179	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1179	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1180		begin
1181		FDBParams.Assign(Value);
1182		end;
1183
1184	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1184	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1185		var
1186		i: Integer;
1187		begin
#	Line 1028 | Line 1199 | begin
1199		FDefaultTransaction := Value;
1200		end;
1201
1202	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1202	>	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1203		begin
1204		if HandleIsShared then
1205		Close
#	Line 1038 | Line 1209 | begin
1209		FHandleIsShared := (Value <> nil);
1210		end;
1211
1212	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1212	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1213		begin
1214		if Value < 0 then
1215		IBError(ibxeTimeoutNegative, [nil])
#	Line 1057 | Line 1228 | begin
1228		end;
1229		end;
1230
1231	<	function TIBDatabase.TestConnected: Boolean;
1231	>	function TIBDataBase.TestConnected: Boolean;
1232		var
1233		DatabaseInfo: TIBDatabaseInfo;
1234		begin
#	Line 1078 | Line 1249 | begin
1249		end;
1250		end;
1251
1252	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1252	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1253		begin
1254		if Connected then
1255		begin
#	Line 1093 | Line 1264 | begin
1264		end;
1265		end;
1266
1267	<	function TIBDatabase.GetIsReadOnly: Boolean;
1267	>	function TIBDataBase.GetIsReadOnly: Boolean;
1268		var
1269		DatabaseInfo: TIBDatabaseInfo;
1270		begin
#	Line 1111 | Line 1282 | begin
1282		DatabaseInfo.Free;
1283		end;
1284
1285	<	function TIBDatabase.GetSQLDialect: Integer;
1285	>	function TIBDataBase.GetSQLDialect: Integer;
1286		begin
1287		Result := FSQLDialect;
1288		end;
1289
1290
1291	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1291	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1292		begin
1293		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1294		if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
#	Line 1126 | Line 1297 | begin
1297		IBError(ibxeSQLDialectInvalid, [nil]);
1298		end;
1299
1300	<	function TIBDatabase.GetDBSQLDialect: Integer;
1300	>	function TIBDataBase.GetDBSQLDialect: Integer;
1301		var
1302		DatabaseInfo: TIBDatabaseInfo;
1303		begin
#	Line 1136 | Line 1307 | begin
1307		DatabaseInfo.Free;
1308		end;
1309
1310	<	procedure TIBDatabase.ValidateClientSQLDialect;
1310	>	procedure TIBDataBase.ValidateClientSQLDialect;
1311		begin
1312		if (FDBSQLDialect < FSQLDialect) then
1313		begin
#	Line 1146 | Line 1317 | begin
1317		end;
1318		end;
1319
1320	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1320	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1321		var
1322		I: Integer;
1323		DS: TIBCustomDataSet;
#	Line 1172 | Line 1343 | begin
1343		TR.CommitRetaining;
1344		end;
1345
1346	<	procedure TIBDatabase.CloseDataSets;
1346	>	procedure TIBDataBase.CloseDataSets;
1347		var
1348		i: Integer;
1349		begin
#	Line 1181 | Line 1352 | begin
1352		DataSets[i].close;
1353		end;
1354
1355	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1355	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1356		begin
1357		if (Index >= 0) and (Index < FDataSets.Count) then
1358		Result := TDataSet(FDataSets[Index])
#	Line 1189 | Line 1360 | begin
1360		raise Exception.Create('Invalid Index to DataSets');
1361		end;
1362
1363	<	function TIBDatabase.GetDataSetCount : Longint;
1363	>	function TIBDataBase.GetDataSetCount: Longint;
1364		begin
1365		Result := FDataSets.Count;
1366		end;
1367
1368	+	procedure TIBDataBase.ReadState(Reader: TReader);
1369	+	begin
1370	+	FDBParams.Clear;
1371	+	inherited ReadState(Reader);
1372	+	end;
1373	+
1374		procedure TIBDataBase.SetConnected(Value: boolean);
1375		begin
1376		if StreamedConnected and not AllowStreamedConnected then
#	Line 1204 | Line 1381 | begin
1381		inherited SetConnected(Value);
1382		end;
1383
1384	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1384	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1385		var
1386		Query: TIBSQL;
1387		begin
#	Line 1245 | Line 1422 | begin
1422		end;
1423		end;
1424
1425	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1425	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1426		var
1427		Query : TIBSQL;
1428		begin
#	Line 1304 | Line 1481 | begin
1481		FTRParamsChanged := True;
1482		TStringList(FTRParams).OnChange := TRParamsChange;
1483		TStringList(FTRParams).OnChanging := TRParamsChanging;
1484	<	FTimer := TTimer.Create(Self);
1484	>	FTimer := TFPTimer.Create(Self);
1485		FTimer.Enabled := False;
1486		FTimer.Interval := 0;
1487		FTimer.OnTimer := TimeoutTransaction;
#	Line 1360 | Line 1537 | begin
1537		IBError(ibxeNotInTransaction, [nil]);
1538		end;
1539
1540	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1541	+	begin
1542	+	if Assigned(FBeforeTransactionEnd) then
1543	+	FBeforeTransactionEnd(self);
1544	+	end;
1545	+
1546	+	procedure TIBTransaction.DoAfterTransactionEnd;
1547	+	begin
1548	+	if Assigned(FAfterTransactionEnd) then
1549	+	FAfterTransactionEnd(self);
1550	+	end;
1551	+
1552	+	procedure TIBTransaction.DoOnStartTransaction;
1553	+	begin
1554	+	if assigned(FOnStartTransaction) then
1555	+	OnStartTransaction(self);
1556	+	end;
1557	+
1558	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1559	+	begin
1560	+	if assigned(FAfterExecQuery) then
1561	+	AfterExecQuery(Sender);
1562	+	end;
1563	+
1564	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1565	+	begin
1566	+	if assigned(FAfterEdit) then
1567	+	AfterEdit(Sender);
1568	+	end;
1569	+
1570	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1571	+	begin
1572	+	if assigned(FAfterDelete) then
1573	+	AfterDelete(Sender);
1574	+	end;
1575	+
1576	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1577	+	begin
1578	+	if assigned(FAfterInsert) then
1579	+	AfterInsert(Sender);
1580	+	end;
1581	+
1582	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1583	+	begin
1584	+	if assigned(FAfterPost) then
1585	+	AfterPost(Sender);
1586	+	end;
1587	+
1588		procedure TIBTransaction.EnsureNotInTransaction;
1589		begin
1590		if csDesigning in ComponentState then
#	Line 1436 | Line 1661 | begin
1661		CheckInTransaction;
1662		if FInEndTransaction then Exit;
1663		FInEndTransaction := true;
1664	+	FEndAction := Action;
1665		try
1666		case Action of
1667		TARollback, TACommit:
#	Line 1444 | Line 1670 | begin
1670		(Action <> FDefaultAction) and
1671		(not Force) then
1672		IBError(ibxeCantEndSharedTransaction, [nil]);
1673	+	DoBeforeTransactionEnd;
1674		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1675	<	SQLObjects[i].DoBeforeTransactionEnd;
1675	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1676		if InTransaction then
1677		begin
1678		if HandleIsShared then
#	Line 1468 | Line 1695 | begin
1695		IBDataBaseError;
1696		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1697		SQLObjects[i].DoAfterTransactionEnd;
1698	+	DoAfterTransactionEnd;
1699		end;
1700		end;
1701		TACommitRetaining:
#	Line 1558 | Line 1786 | begin
1786		end;
1787		end;
1788
1789	+	function TIBTransaction.GetEndAction: TTransactionAction;
1790	+	begin
1791	+	if FInEndTransaction then
1792	+	Result := FEndAction
1793	+	else
1794	+	IBError(ibxeIB60feature, [nil])
1795	+	end;
1796	+
1797
1798		function TIBTransaction.GetIdleTimer: Integer;
1799		begin
#	Line 1663 | Line 1899 | begin
1899		for i := 0 to FSQLObjects.Count - 1 do
1900		if (FSQLObjects[i] <> nil) and
1901		(TIBBase(FSQLObjects[i]).Database = nil) then
1902	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1902	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1903		end;
1904		FDefaultDatabase := Value;
1905		end;
#	Line 1769 | Line 2005 | begin
2005		finally
2006		FreeMem(pteb);
2007		end;
2008	+	DoOnStartTransaction;
2009		end;
2010
2011		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
#	Line 1810 | Line 2047 | begin
2047		inherited Destroy;
2048		end;
2049
2050	+	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2051	+	begin
2052	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2053	+	Result := Database.FCharSetSizes[CharSetID]
2054	+	else
2055	+	Result := 1; {Unknown character set}
2056	+	end;
2057	+
2058	+	function TIBBase.GetDefaultCharSetSize: integer;
2059	+	var DefaultCharSetName: string;
2060	+	i: integer;
2061	+	begin
2062	+	DefaultCharSetName := GetDefaultCharSetName;
2063	+	Result := 4; {worse case}
2064	+	for i := 0 to Length(Database.FCharSetSizes) - 1 do
2065	+	if Database.FCharSetNames[i] = DefaultCharSetName then
2066	+	begin
2067	+	Result := Database.FCharSetSizes[i];
2068	+	break;
2069	+	end;
2070	+	end;
2071	+
2072	+	function TIBBase.GetCharSetName(CharSetID: integer): string;
2073	+	begin
2074	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2075	+	Result := Database.FCharSetNames[CharSetID]
2076	+	else
2077	+	Result := ''; {Unknown character set}
2078	+	end;
2079	+
2080	+	function TIBBase.GetDefaultCharSetName: string;
2081	+	begin
2082	+	Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2083	+	end;
2084	+
2085	+	procedure TIBBase.HandleException(Sender: TObject);
2086	+	begin
2087	+	if assigned(Database) then
2088	+	Database.HandleException(Sender)
2089	+	else
2090	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2091	+	end;
2092	+
2093	+	procedure TIBBase.SetCursor;
2094	+	begin
2095	+	if Assigned(Database) and not Database.SQLHourGlass then
2096	+	Exit;
2097	+	if assigned(IBGUIInterface) then
2098	+	IBGUIInterface.SetCursor;
2099	+	end;
2100	+
2101	+	procedure TIBBase.RestoreCursor;
2102	+	begin
2103	+	if Assigned(Database) and not Database.SQLHourGlass then
2104	+	Exit;
2105	+	if assigned(IBGUIInterface) then
2106	+	IBGUIInterface.RestoreCursor;
2107	+	end;
2108	+
2109		procedure TIBBase.CheckDatabase;
2110		begin
2111		if (FDatabase = nil) then
#	Line 1836 | Line 2132 | begin
2132		result := @FTransaction.Handle;
2133		end;
2134
2135	+	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2136	+	);
2137	+	begin
2138	+	if assigned(FBeforeDatabaseConnect) then
2139	+	BeforeDatabaseConnect(self,DBParams,DBName);
2140	+	end;
2141	+
2142		procedure TIBBase.DoAfterDatabaseConnect;
2143		begin
2144		if assigned(FAfterDatabaseConnect) then
#	Line 1862 | Line 2165 | begin
2165		SetTransaction(nil);
2166		end;
2167
2168	<	procedure TIBBase.DoBeforeTransactionEnd;
2168	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2169		begin
2170		if Assigned(BeforeTransactionEnd) then
2171	<	BeforeTransactionEnd(Self);
2171	>	BeforeTransactionEnd(Self,Action);
2172		end;
2173
2174		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1881 | Line 2184 | begin
2184		FTransaction := nil;
2185		end;
2186
2187	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2188	+	begin
2189	+	if FTransaction <> nil then
2190	+	FTransaction.DoAfterExecQuery(Sender);
2191	+	end;
2192	+
2193	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2194	+	begin
2195	+	if FTransaction <> nil then
2196	+	FTransaction.DoAfterEdit(Sender);
2197	+	end;
2198	+
2199	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2200	+	begin
2201	+	if FTransaction <> nil then
2202	+	FTransaction.DoAfterDelete(Sender);
2203	+	end;
2204	+
2205	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2206	+	begin
2207	+	if FTransaction <> nil then
2208	+	FTransaction.DoAfterInsert(Sender);
2209	+	end;
2210	+
2211	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2212	+	begin
2213	+	if FTransaction <> nil then
2214	+	FTransaction.DoAfterPost(Sender);
2215	+	end;
2216	+
2217		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2218		begin
2219		if (FDatabase <> nil) then

Diff Legend

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