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 43 by tony, Thu Sep 22 17:10:15 2016 UTC

#	Line 35 | Line 35 | unit IBDatabase;
35
36		{$Mode Delphi}
37
38	+	{$IF FPC_FULLVERSION >= 20700 }
39	+	{$codepage UTF8}
40	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
41	+	{$ENDIF}
42	+
43		interface
44
45		uses
#	Line 43 | Line 48 | uses
48		{$ELSE}
49		unix,
50		{$ENDIF}
51	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
52	<	IB, DBLoginDlg;
51	>	SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
52	>	IB, CustApp;
53
54		const
55		DPBPrefix = 'isc_dpb_';
#	Line 159 | Line 164 | type
164		FHiddenPassword: string;
165		FIBLoaded: Boolean;
166		FOnLogin: TIBDatabaseLoginEvent;
167	+	FSQLHourGlass: Boolean;
168		FTraceFlags: TTraceFlags;
169		FDBSQLDialect: Integer;
170		FSQLDialect: Integer;
#	Line 177 | Line 183 | type
183		FDefaultTransaction: TIBTransaction;
184		FInternalTransaction: TIBTransaction;
185		FStreamedConnected: Boolean;
186	<	FTimer: TTimer;
186	>	FTimer: TFPTimer;
187		FUserNames: TStringList;
188		FDataSets: TList;
189		FLoginCalled: boolean;
190	+	FDefaultCharSetName: RawByteString;
191	+	FDefaultCharSetID: integer;
192	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
193	+	FDefaultCodePage: TSystemCodePage;
194	+	{$ENDIF}
195	+	FUseDefaultSystemCodePage: boolean;
196		procedure EnsureInactive;
197		function GetDBSQLDialect: Integer;
198		function GetSQLDialect: Integer;
#	Line 194 | Line 206 | type
206		function GetIdleTimer: Integer;
207		function GetTransaction(Index: Integer): TIBTransaction;
208		function GetTransactionCount: Integer;
209	<	function Login: Boolean;
209	>	function Login(var aDatabaseName: string): Boolean;
210		procedure SetDatabaseName(const Value: TIBFileName);
211		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
212		procedure SetDBParams(Value: TStrings);
#	Line 212 | Line 224 | type
224		procedure DoDisconnect; override;
225		function GetConnected: Boolean; override;
226		procedure CheckStreamConnect;
227	+	procedure HandleException(Sender: TObject);
228		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
229		function GetDataset(Index : longint) : TDataset; override;
230		function GetDataSetCount : Longint; override;
231	+	procedure ReadState(Reader: TReader); override;
232		procedure SetConnected (Value : boolean); override;
233		public
234		constructor Create(AOwner: TComponent); override;
#	Line 249 | Line 263 | type
263		property TransactionCount: Integer read GetTransactionCount;
264		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265		property InternalTransaction: TIBTransaction read FInternalTransaction;
266	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267	+	property DefaultCharSetID: integer read FDefaultCharSetID;
268	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
269	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
270	+	{$ENDIF}
271
272		published
273		property Connected;
#	Line 261 | Line 280 | type
280		write SetDefaultTransaction;
281		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
282		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
283	+	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
284		property DBSQLDialect : Integer read FDBSQLDialect;
285		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
286	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
287	+	write FUseDefaultSystemCodePage;
288		property AfterConnect;
289		property AfterDisconnect;
290		property BeforeConnect;
#	Line 278 | Line 300 | type
300
301		TIBTransaction = class(TComponent)
302		private
303	+	FAfterDelete: TNotifyEvent;
304	+	FAfterEdit: TNotifyEvent;
305	+	FAfterExecQuery: TNotifyEvent;
306	+	FAfterInsert: TNotifyEvent;
307	+	FAfterPost: TNotifyEvent;
308	+	FAfterTransactionEnd: TNotifyEvent;
309	+	FBeforeTransactionEnd: TNotifyEvent;
310		FIBLoaded: Boolean;
311		FCanTimeout         : Boolean;
312		FDatabases          : TList;
313	+	FOnStartTransaction: TNotifyEvent;
314		FSQLObjects         : TList;
315		FDefaultDatabase    : TIBDatabase;
316		FHandle             : TISC_TR_HANDLE;
#	Line 289 | Line 319 | type
319		FStreamedActive     : Boolean;
320		FTPB                : PChar;
321		FTPBLength          : Short;
322	<	FTimer              : TTimer;
322	>	FTimer              : TFPTimer;
323		FDefaultAction      : TTransactionAction;
324		FTRParams           : TStrings;
325		FTRParamsChanged    : Boolean;
326		FInEndTransaction   : boolean;
327	+	FEndAction          : TTransactionAction;
328	+	procedure DoBeforeTransactionEnd;
329	+	procedure DoAfterTransactionEnd;
330	+	procedure DoOnStartTransaction;
331	+	procedure DoAfterExecQuery(Sender: TObject);
332	+	procedure DoAfterEdit(Sender: TObject);
333	+	procedure DoAfterDelete(Sender: TObject);
334	+	procedure DoAfterInsert(Sender: TObject);
335	+	procedure DoAfterPost(Sender: TObject);
336		procedure EnsureNotInTransaction;
337		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
338		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 335 | Line 374 | type
374		function AddDatabase(db: TIBDatabase): Integer;
375		function FindDatabase(db: TIBDatabase): Integer;
376		function FindDefaultDatabase: TIBDatabase;
377	+	function GetEndAction: TTransactionAction;
378		procedure RemoveDatabase(Idx: Integer);
379		procedure RemoveDatabases;
380		procedure CheckDatabasesInList;
#	Line 356 | Line 396 | type
396		property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
397		property Params: TStrings read FTRParams write SetTRParams;
398		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
399	<	end;
399	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
400	>	write FBeforeTransactionEnd;
401	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
402	>	write FAfterTransactionEnd;
403	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
404	>	write FOnStartTransaction;
405	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
406	>	write FAfterExecQuery;
407	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
408	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
409	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
410	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
411	>	end;
412	>
413	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
414	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
415	>	var DBName: string) of object;
416
417		{ TIBBase }
418
#	Line 365 | Line 421 | type
421		connections. }
422		TIBBase = class(TObject)
423		protected
424	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
425		FDatabase: TIBDatabase;
426		FIndexInDatabase: Integer;
427		FTransaction: TIBTransaction;
#	Line 374 | Line 431 | type
431		FAfterDatabaseDisconnect: TNotifyEvent;
432		FAfterDatabaseConnect: TNotifyEvent;
433		FOnDatabaseFree: TNotifyEvent;
434	<	FBeforeTransactionEnd: TNotifyEvent;
434	>	FBeforeTransactionEnd: TTransactionEndEvent;
435		FAfterTransactionEnd: TNotifyEvent;
436		FOnTransactionFree: TNotifyEvent;
437
438	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
439	+	var DBName: string); virtual;
440		procedure DoAfterDatabaseConnect; virtual;
441		procedure DoBeforeDatabaseDisconnect; virtual;
442		procedure DoAfterDatabaseDisconnect; virtual;
443		procedure DoDatabaseFree; virtual;
444	<	procedure DoBeforeTransactionEnd; virtual;
444	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
445		procedure DoAfterTransactionEnd; virtual;
446		procedure DoTransactionFree; virtual;
447		function GetDBHandle: PISC_DB_HANDLE; virtual;
#	Line 394 | Line 453 | type
453		destructor Destroy; override;
454		procedure CheckDatabase; virtual;
455		procedure CheckTransaction; virtual;
456	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
457	+	procedure DoAfterEdit(Sender: TObject); virtual;
458	+	procedure DoAfterDelete(Sender: TObject); virtual;
459	+	procedure DoAfterInsert(Sender: TObject); virtual;
460	+	procedure DoAfterPost(Sender: TObject); virtual;
461	+	function GetDefaultCharSetName: RawByteString;
462	+	function GetDefaultCharSetID: cardinal;
463	+	procedure HandleException(Sender: TObject);
464	+	procedure SetCursor;
465	+	procedure RestoreCursor;
466		public
467	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
468	+	write FBeforeDatabaseConnect;
469		property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
470		write FAfterDatabaseConnect;
471		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
#	Line 402 | Line 473 | type
473		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
474		write FAfterDatabaseDisconnect;
475		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
476	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
476	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
477		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
478		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
479		property Database: TIBDatabase read FDatabase
#	Line 420 | Line 491 | procedure GenerateTPB(sl: TStrings; var
491
492		implementation
493
494	<	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
494	>	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
495	>	typInfo, IBCodePage;
496
497		{ TIBDatabase }
498
499	<	constructor TIBDatabase.Create(AOwner: TComponent);
499	>	constructor TIBDataBase.Create(AOwner: TComponent);
500		begin
501		inherited Create(AOwner);
502		FIBLoaded := False;
#	Line 435 | Line 507 | begin
507		FTransactions := TList.Create;
508		FDBName := '';
509		FDBParams := TStringList.Create;
510	+	FSQLHourGlass := true;
511	+	if (AOwner <> nil) and
512	+	(AOwner is TCustomApplication) and
513	+	TCustomApplication(AOWner).ConsoleApplication then
514	+	LoginPrompt := false;
515	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
516	+	FDefaultCodePage := CP_NONE;
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	+	FDefaultCharSetName := '';
637	+	FDefaultCharSetID := 0;
638	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
639	+	FDefaultCodePage := CP_NONE;
640	+	{$ENDIF}
641		end;
642
643	<	procedure TIBDatabase.CreateDatabase;
643	>	procedure TIBDataBase.CreateDatabase;
644		var
645		tr_handle: TISC_TR_HANDLE;
646		begin
#	Line 568 | Line 653 | begin
653		True);
654		end;
655
656	<	procedure TIBDatabase.DropDatabase;
656	>	procedure TIBDataBase.DropDatabase;
657		begin
658		CheckActive;
659		Call(isc_drop_database(StatusVector, @FHandle), True);
660		end;
661
662	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
662	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
663		begin
664		FDBParamsChanged := True;
665		end;
666
667	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
667	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
668		begin
669		EnsureInactive;
670		CheckInactive;
671		end;
672
673	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
673	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
674		var
675		i: Integer;
676		begin
#	Line 598 | Line 683 | begin
683		end;
684		end;
685
686	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
686	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
687		var
688		i: Integer;
689		begin
#	Line 616 | Line 701 | begin
701		end;
702		end;
703
704	<	procedure TIBDatabase.ForceClose;
704	>	procedure TIBDataBase.ForceClose;
705		begin
706		if Connected then
707		InternalClose(True);
708		end;
709
710	<	function TIBDatabase.GetConnected: Boolean;
710	>	function TIBDataBase.GetConnected: Boolean;
711		begin
712		result := FHandle <> nil;
713		end;
714
715	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
715	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
716		begin
717		result := FSQLObjects[Index];
718		end;
719
720	<	function TIBDatabase.GetSQLObjectCount: Integer;
720	>	function TIBDataBase.GetSQLObjectCount: Integer;
721		var
722		i: Integer;
723		begin
#	Line 641 | Line 726 | begin
726		Inc(result);
727		end;
728
729	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
729	>	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
730		var
731		ConstIdx, EqualsIdx: Integer;
732		begin
#	Line 664 | Line 749 | begin
749		result := '';
750		end;
751
752	<	function TIBDatabase.GetIdleTimer: Integer;
752	>	function TIBDataBase.GetIdleTimer: Integer;
753		begin
754		result := FTimer.Interval;
755		end;
756
757	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
757	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
758		begin
759		result := FTransactions[Index];
760		end;
761
762	<	function TIBDatabase.GetTransactionCount: Integer;
762	>	function TIBDataBase.GetTransactionCount: Integer;
763		var
764		i: Integer;
765		begin
#	Line 684 | Line 769 | begin
769		Inc(result);
770		end;
771
772	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
772	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
773		var
774		i, pos_of_str: Integer;
775		begin
#	Line 700 | Line 785 | begin
785		end;
786		end;
787
788	<	procedure TIBDatabase.InternalClose(Force: Boolean);
788	>	procedure TIBDataBase.InternalClose(Force: Boolean);
789		var
790		i: Integer;
791		begin
#	Line 773 | Line 858 | begin
858		end;
859		except
860		if csDesigning in ComponentState then
861	<	Application.HandleException(Self)
861	>	HandleException(Self)
862		else
863		raise;
864		end;
865		end;
866
867	<	procedure TIBDatabase.Notification( AComponent: TComponent;
868	<	Operation: TOperation);
867	>	procedure TIBDataBase.HandleException(Sender: TObject);
868	>	var aParent: TComponent;
869	>	begin
870	>	aParent := Owner;
871	>	while aParent <> nil do
872	>	begin
873	>	if aParent is TCustomApplication then
874	>	begin
875	>	TCustomApplication(aParent).HandleException(Sender);
876	>	Exit;
877	>	end;
878	>	aParent := aParent.Owner;
879	>	end;
880	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
881	>	end;
882	>
883	>	procedure TIBDataBase.Notification(AComponent: TComponent;
884	>	Operation: TOperation);
885		var
886		i: Integer;
887		begin
#	Line 794 | Line 895 | begin
895		end;
896		end;
897
898	<	function TIBDatabase.Login: Boolean;
898	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
899		var
900		IndexOfUser, IndexOfPassword: Integer;
901		Username, Password, OldPassword: String;
#	Line 830 | Line 931 | begin
931		LoginParams.Assign(Params);
932		FOnLogin(Self, LoginParams);
933		Params.Assign (LoginParams);
934	+	aDatabaseName := FDBName;
935		HidePassword;
936		finally
937		LoginParams.Free;
938		end;
939		end
940		else
941	+	if assigned(IBGUIInterface) then
942		begin
943		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
944		if IndexOfUser <> -1 then
#	Line 850 | Line 953 | begin
953		Length(Params[IndexOfPassword]));
954		OldPassword := password;
955		end;
956	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
956	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
957		if result then
958		begin
959		if IndexOfUser = -1 then
#	Line 867 | Line 970 | begin
970		HidePassword;
971		end;
972		end;
973	<	end;
973	>	end
974	>	else
975	>	if LoginPrompt then
976	>	IBError(ibxeNoLoginDialog,[]);
977		finally
978		FLoginCalled := false
979		end;
980		end;
981
982	<	procedure TIBDatabase.DoConnect;
982	>	procedure TIBDataBase.DoConnect;
983		var
984		DPB: String;
985		TempDBParams: TStrings;
986		I: integer;
987	+	aDBName: string;
988
989	+	{Call error analysis}
990	+	sqlcode: Long;
991	+	IBErrorCode: Long;
992	+	status_vector: PISC_STATUS;
993	+	CharSetID: integer;
994		begin
995		CheckInactive;
996		CheckDatabaseName;
#	Line 888 | Line 1000 | begin
1000		FDBParamsChanged := True;
1001		end;
1002		{ Use builtin login prompt if requested }
1003	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1003	>	aDBName := FDBName;
1004	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1005		IBError(ibxeOperationCancelled, [nil]);
1006	<	{ Generate a new DPB if necessary }
1007	<	if (FDBParamsChanged) then
1008	<	begin
1009	<	FDBParamsChanged := False;
1010	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1011	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1012	<	else
1006	>
1007	>	TempDBParams := TStringList.Create;
1008	>	try
1009	>	TempDBParams.Assign(FDBParams);
1010	>	if UseDefaultSystemCodePage then
1011	>	begin
1012	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1013	>	{$ifdef WINDOWS}
1014	>	if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then
1015	>	TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1016	>	else
1017	>	{$else}
1018	>	if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1019	>	TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1020	>	else
1021	>	{$endif}
1022	>	{$ENDIF}
1023	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1024	>	end;
1025	>	{Opportunity to override defaults}
1026	>	for i := 0 to FSQLObjects.Count - 1 do
1027	>	begin
1028	>	if FSQLObjects[i] <> nil then
1029	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1030	>	end;
1031	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1032	>	if FDefaultCharSetName <> '' then
1033	>	TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1034	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1035	>	TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036	>	{$ENDIF}
1037	>	{ Generate a new DPB if necessary }
1038	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1039	>	begin
1040	>	FDBParamsChanged := False;
1041	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1042	>	GenerateDPB(TempDBParams, DPB, FDPBLength)
1043	>	else
1044	>	begin
1045	>	TempDBParams.Add('password=' + FHiddenPassword);
1046	>	GenerateDPB(TempDBParams, DPB, FDPBLength);
1047	>	end;
1048	>	IBAlloc(FDPB, 0, FDPBLength);
1049	>	Move(DPB[1], FDPB[0], FDPBLength);
1050	>	end;
1051	>	finally
1052	>	TempDBParams.Free;
1053	>	end;
1054	>	repeat
1055	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1056	>	PChar(aDBName), @FHandle,
1057	>	FDPBLength, FDPB), False) > 0 then
1058		begin
1059	<	TempDBParams := TStringList.Create;
1060	<	try
1061	<	TempDBParams.Assign(FDBParams);
1062	<	TempDBParams.Add('password=' + FHiddenPassword);
1063	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1064	<	finally
1065	<	TempDBParams.Free;
1059	>	{$IFDEF UNIX}
1060	>	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1061	>	begin
1062	>	status_vector := StatusVector;
1063	>	IBErrorCode := StatusVectorArray[1];
1064	>	sqlcode := isc_sqlcode(StatusVector);
1065	>
1066	>	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1067	>	or
1068	>	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1069	>	then
1070	>	begin
1071	>	aDBName := 'localhost:' + aDBName;
1072	>	Continue;
1073	>	end;
1074		end;
1075	+	{$ENDIF}
1076	+	FHandle := nil;
1077	+	IBDataBaseError;
1078		end;
1079	<	IBAlloc(FDPB, 0, FDPBLength);
1080	<	Move(DPB[1], FDPB[0], FDPBLength);
1081	<	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;
1079	>	until FHandle <> nil;
1080	>	if not (csDesigning in ComponentState) then
1081	>	FDBName := aDBName; {Synchronise at run time}
1082		FDBSQLDialect := GetDBSQLDialect;
1083		ValidateClientSQLDialect;
1084		for i := 0 to FSQLObjects.Count - 1 do
#	Line 928 | Line 1090 | begin
1090		MonitorHook.DBConnect(Self);
1091		end;
1092
1093	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1093	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1094		var
1095		ds: TIBBase;
1096		begin
#	Line 942 | Line 1104 | begin
1104		end;
1105		end;
1106
1107	<	procedure TIBDatabase.RemoveSQLObjects;
1107	>	procedure TIBDataBase.RemoveSQLObjects;
1108		var
1109		i: Integer;
1110		begin
#	Line 954 | Line 1116 | begin
1116		end;
1117		end;
1118
1119	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1119	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1120		var
1121		TR: TIBTransaction;
1122		begin
#	Line 968 | Line 1130 | begin
1130		end;
1131		end;
1132
1133	<	procedure TIBDatabase.RemoveTransactions;
1133	>	procedure TIBDataBase.RemoveTransactions;
1134		var
1135		i: Integer;
1136		begin
#	Line 976 | Line 1138 | begin
1138		RemoveTransaction(i);
1139		end;
1140
1141	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1141	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1142		begin
1143		if FDBName <> Value then
1144		begin
#	Line 986 | Line 1148 | begin
1148		end;
1149		end;
1150
1151	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1151	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1152		var
1153		ConstIdx: Integer;
1154		begin
#	Line 1005 | Line 1167 | begin
1167		end;
1168		end;
1169
1170	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1170	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1171		begin
1172		FDBParams.Assign(Value);
1173		end;
1174
1175	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1175	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1176		var
1177		i: Integer;
1178		begin
#	Line 1028 | Line 1190 | begin
1190		FDefaultTransaction := Value;
1191		end;
1192
1193	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1193	>	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1194		begin
1195		if HandleIsShared then
1196		Close
#	Line 1038 | Line 1200 | begin
1200		FHandleIsShared := (Value <> nil);
1201		end;
1202
1203	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1203	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1204		begin
1205		if Value < 0 then
1206		IBError(ibxeTimeoutNegative, [nil])
#	Line 1057 | Line 1219 | begin
1219		end;
1220		end;
1221
1222	<	function TIBDatabase.TestConnected: Boolean;
1222	>	function TIBDataBase.TestConnected: Boolean;
1223		var
1224		DatabaseInfo: TIBDatabaseInfo;
1225		begin
#	Line 1078 | Line 1240 | begin
1240		end;
1241		end;
1242
1243	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1243	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1244		begin
1245		if Connected then
1246		begin
#	Line 1093 | Line 1255 | begin
1255		end;
1256		end;
1257
1258	<	function TIBDatabase.GetIsReadOnly: Boolean;
1258	>	function TIBDataBase.GetIsReadOnly: Boolean;
1259		var
1260		DatabaseInfo: TIBDatabaseInfo;
1261		begin
#	Line 1111 | Line 1273 | begin
1273		DatabaseInfo.Free;
1274		end;
1275
1276	<	function TIBDatabase.GetSQLDialect: Integer;
1276	>	function TIBDataBase.GetSQLDialect: Integer;
1277		begin
1278		Result := FSQLDialect;
1279		end;
1280
1281
1282	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1282	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1283		begin
1284		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1285		if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
#	Line 1126 | Line 1288 | begin
1288		IBError(ibxeSQLDialectInvalid, [nil]);
1289		end;
1290
1291	<	function TIBDatabase.GetDBSQLDialect: Integer;
1291	>	function TIBDataBase.GetDBSQLDialect: Integer;
1292		var
1293		DatabaseInfo: TIBDatabaseInfo;
1294		begin
#	Line 1136 | Line 1298 | begin
1298		DatabaseInfo.Free;
1299		end;
1300
1301	<	procedure TIBDatabase.ValidateClientSQLDialect;
1301	>	procedure TIBDataBase.ValidateClientSQLDialect;
1302		begin
1303		if (FDBSQLDialect < FSQLDialect) then
1304		begin
#	Line 1146 | Line 1308 | begin
1308		end;
1309		end;
1310
1311	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1311	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1312		var
1313		I: Integer;
1314		DS: TIBCustomDataSet;
#	Line 1172 | Line 1334 | begin
1334		TR.CommitRetaining;
1335		end;
1336
1337	<	procedure TIBDatabase.CloseDataSets;
1337	>	procedure TIBDataBase.CloseDataSets;
1338		var
1339		i: Integer;
1340		begin
#	Line 1181 | Line 1343 | begin
1343		DataSets[i].close;
1344		end;
1345
1346	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1346	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1347		begin
1348		if (Index >= 0) and (Index < FDataSets.Count) then
1349		Result := TDataSet(FDataSets[Index])
#	Line 1189 | Line 1351 | begin
1351		raise Exception.Create('Invalid Index to DataSets');
1352		end;
1353
1354	<	function TIBDatabase.GetDataSetCount : Longint;
1354	>	function TIBDataBase.GetDataSetCount: Longint;
1355		begin
1356		Result := FDataSets.Count;
1357		end;
1358
1359	+	procedure TIBDataBase.ReadState(Reader: TReader);
1360	+	begin
1361	+	FDBParams.Clear;
1362	+	inherited ReadState(Reader);
1363	+	end;
1364	+
1365		procedure TIBDataBase.SetConnected(Value: boolean);
1366		begin
1367		if StreamedConnected and not AllowStreamedConnected then
#	Line 1204 | Line 1372 | begin
1372		inherited SetConnected(Value);
1373		end;
1374
1375	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1375	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1376		var
1377		Query: TIBSQL;
1378		begin
#	Line 1245 | Line 1413 | begin
1413		end;
1414		end;
1415
1416	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1416	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1417		var
1418		Query : TIBSQL;
1419		begin
#	Line 1304 | Line 1472 | begin
1472		FTRParamsChanged := True;
1473		TStringList(FTRParams).OnChange := TRParamsChange;
1474		TStringList(FTRParams).OnChanging := TRParamsChanging;
1475	<	FTimer := TTimer.Create(Self);
1475	>	FTimer := TFPTimer.Create(Self);
1476		FTimer.Enabled := False;
1477		FTimer.Interval := 0;
1478		FTimer.OnTimer := TimeoutTransaction;
#	Line 1360 | Line 1528 | begin
1528		IBError(ibxeNotInTransaction, [nil]);
1529		end;
1530
1531	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1532	+	begin
1533	+	if Assigned(FBeforeTransactionEnd) then
1534	+	FBeforeTransactionEnd(self);
1535	+	end;
1536	+
1537	+	procedure TIBTransaction.DoAfterTransactionEnd;
1538	+	begin
1539	+	if Assigned(FAfterTransactionEnd) then
1540	+	FAfterTransactionEnd(self);
1541	+	end;
1542	+
1543	+	procedure TIBTransaction.DoOnStartTransaction;
1544	+	begin
1545	+	if assigned(FOnStartTransaction) then
1546	+	OnStartTransaction(self);
1547	+	end;
1548	+
1549	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1550	+	begin
1551	+	if assigned(FAfterExecQuery) then
1552	+	AfterExecQuery(Sender);
1553	+	end;
1554	+
1555	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1556	+	begin
1557	+	if assigned(FAfterEdit) then
1558	+	AfterEdit(Sender);
1559	+	end;
1560	+
1561	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1562	+	begin
1563	+	if assigned(FAfterDelete) then
1564	+	AfterDelete(Sender);
1565	+	end;
1566	+
1567	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1568	+	begin
1569	+	if assigned(FAfterInsert) then
1570	+	AfterInsert(Sender);
1571	+	end;
1572	+
1573	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1574	+	begin
1575	+	if assigned(FAfterPost) then
1576	+	AfterPost(Sender);
1577	+	end;
1578	+
1579		procedure TIBTransaction.EnsureNotInTransaction;
1580		begin
1581		if csDesigning in ComponentState then
#	Line 1436 | Line 1652 | begin
1652		CheckInTransaction;
1653		if FInEndTransaction then Exit;
1654		FInEndTransaction := true;
1655	+	FEndAction := Action;
1656		try
1657		case Action of
1658		TARollback, TACommit:
#	Line 1444 | Line 1661 | begin
1661		(Action <> FDefaultAction) and
1662		(not Force) then
1663		IBError(ibxeCantEndSharedTransaction, [nil]);
1664	+	DoBeforeTransactionEnd;
1665		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1666	<	SQLObjects[i].DoBeforeTransactionEnd;
1666	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1667		if InTransaction then
1668		begin
1669		if HandleIsShared then
#	Line 1468 | Line 1686 | begin
1686		IBDataBaseError;
1687		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1688		SQLObjects[i].DoAfterTransactionEnd;
1689	+	DoAfterTransactionEnd;
1690		end;
1691		end;
1692		TACommitRetaining:
#	Line 1558 | Line 1777 | begin
1777		end;
1778		end;
1779
1780	+	function TIBTransaction.GetEndAction: TTransactionAction;
1781	+	begin
1782	+	if FInEndTransaction then
1783	+	Result := FEndAction
1784	+	else
1785	+	IBError(ibxeIB60feature, [nil])
1786	+	end;
1787	+
1788
1789		function TIBTransaction.GetIdleTimer: Integer;
1790		begin
#	Line 1663 | Line 1890 | begin
1890		for i := 0 to FSQLObjects.Count - 1 do
1891		if (FSQLObjects[i] <> nil) and
1892		(TIBBase(FSQLObjects[i]).Database = nil) then
1893	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1893	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1894		end;
1895		FDefaultDatabase := Value;
1896		end;
#	Line 1769 | Line 1996 | begin
1996		finally
1997		FreeMem(pteb);
1998		end;
1999	+	DoOnStartTransaction;
2000		end;
2001
2002		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
#	Line 1810 | Line 2038 | begin
2038		inherited Destroy;
2039		end;
2040
2041	+	function TIBBase.GetDefaultCharSetName: RawByteString;
2042	+	begin
2043	+	Result := Database.FDefaultCharSetName;
2044	+	end;
2045	+
2046	+	function TIBBase.GetDefaultCharSetID: cardinal;
2047	+	begin
2048	+	Result := Database.DefaultCharSetID;
2049	+	end;
2050	+
2051	+	procedure TIBBase.HandleException(Sender: TObject);
2052	+	begin
2053	+	if assigned(Database) then
2054	+	Database.HandleException(Sender)
2055	+	else
2056	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2057	+	end;
2058	+
2059	+	procedure TIBBase.SetCursor;
2060	+	begin
2061	+	if Assigned(Database) and not Database.SQLHourGlass then
2062	+	Exit;
2063	+	if assigned(IBGUIInterface) then
2064	+	IBGUIInterface.SetCursor;
2065	+	end;
2066	+
2067	+	procedure TIBBase.RestoreCursor;
2068	+	begin
2069	+	if Assigned(Database) and not Database.SQLHourGlass then
2070	+	Exit;
2071	+	if assigned(IBGUIInterface) then
2072	+	IBGUIInterface.RestoreCursor;
2073	+	end;
2074	+
2075		procedure TIBBase.CheckDatabase;
2076		begin
2077		if (FDatabase = nil) then
#	Line 1836 | Line 2098 | begin
2098		result := @FTransaction.Handle;
2099		end;
2100
2101	+	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2102	+	);
2103	+	begin
2104	+	if assigned(FBeforeDatabaseConnect) then
2105	+	BeforeDatabaseConnect(self,DBParams,DBName);
2106	+	end;
2107	+
2108		procedure TIBBase.DoAfterDatabaseConnect;
2109		begin
2110		if assigned(FAfterDatabaseConnect) then
#	Line 1862 | Line 2131 | begin
2131		SetTransaction(nil);
2132		end;
2133
2134	<	procedure TIBBase.DoBeforeTransactionEnd;
2134	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2135		begin
2136		if Assigned(BeforeTransactionEnd) then
2137	<	BeforeTransactionEnd(Self);
2137	>	BeforeTransactionEnd(Self,Action);
2138		end;
2139
2140		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1881 | Line 2150 | begin
2150		FTransaction := nil;
2151		end;
2152
2153	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2154	+	begin
2155	+	if FTransaction <> nil then
2156	+	FTransaction.DoAfterExecQuery(Sender);
2157	+	end;
2158	+
2159	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2160	+	begin
2161	+	if FTransaction <> nil then
2162	+	FTransaction.DoAfterEdit(Sender);
2163	+	end;
2164	+
2165	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2166	+	begin
2167	+	if FTransaction <> nil then
2168	+	FTransaction.DoAfterDelete(Sender);
2169	+	end;
2170	+
2171	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2172	+	begin
2173	+	if FTransaction <> nil then
2174	+	FTransaction.DoAfterInsert(Sender);
2175	+	end;
2176	+
2177	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2178	+	begin
2179	+	if FTransaction <> nil then
2180	+	FTransaction.DoAfterPost(Sender);
2181	+	end;
2182	+
2183		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2184		begin
2185		if (FDatabase <> nil) then

Diff Legend

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