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 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 31 by tony, Tue Jul 14 15:31:25 2015 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		procedure EnsureInactive;
187		function GetDBSQLDialect: Integer;
188		function GetSQLDialect: Integer;
#	Line 195 | Line 197 | type
197		function GetTransaction(Index: Integer): TIBTransaction;
198		function GetTransactionCount: Integer;
199		function Login: Boolean;
200	+	procedure LoadCharSetInfo;
201		procedure SetDatabaseName(const Value: TIBFileName);
202		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
203		procedure SetDBParams(Value: TStrings);
#	Line 212 | Line 215 | type
215		procedure DoDisconnect; override;
216		function GetConnected: Boolean; override;
217		procedure CheckStreamConnect;
218	+	procedure HandleException(Sender: TObject);
219		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
220		function GetDataset(Index : longint) : TDataset; override;
221		function GetDataSetCount : Longint; override;
#	Line 262 | Line 266 | type
266		write SetDefaultTransaction;
267		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
268		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
269	+	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
270		property DBSQLDialect : Integer read FDBSQLDialect;
271		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
272		property AfterConnect;
#	Line 279 | Line 284 | type
284
285		TIBTransaction = class(TComponent)
286		private
287	+	FAfterDelete: TNotifyEvent;
288	+	FAfterEdit: TNotifyEvent;
289	+	FAfterExecQuery: TNotifyEvent;
290	+	FAfterInsert: TNotifyEvent;
291	+	FAfterPost: TNotifyEvent;
292		FAfterTransactionEnd: TNotifyEvent;
293		FBeforeTransactionEnd: TNotifyEvent;
294		FIBLoaded: Boolean;
295		FCanTimeout         : Boolean;
296		FDatabases          : TList;
297	+	FOnStartTransaction: TNotifyEvent;
298		FSQLObjects         : TList;
299		FDefaultDatabase    : TIBDatabase;
300		FHandle             : TISC_TR_HANDLE;
#	Line 292 | Line 303 | type
303		FStreamedActive     : Boolean;
304		FTPB                : PChar;
305		FTPBLength          : Short;
306	<	FTimer              : TTimer;
306	>	FTimer              : TFPTimer;
307		FDefaultAction      : TTransactionAction;
308		FTRParams           : TStrings;
309		FTRParamsChanged    : Boolean;
#	Line 300 | Line 311 | type
311		FEndAction          : TTransactionAction;
312		procedure DoBeforeTransactionEnd;
313		procedure DoAfterTransactionEnd;
314	+	procedure DoOnStartTransaction;
315	+	procedure DoAfterExecQuery(Sender: TObject);
316	+	procedure DoAfterEdit(Sender: TObject);
317	+	procedure DoAfterDelete(Sender: TObject);
318	+	procedure DoAfterInsert(Sender: TObject);
319	+	procedure DoAfterPost(Sender: TObject);
320		procedure EnsureNotInTransaction;
321		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
322		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 367 | Line 384 | type
384		write FBeforeTransactionEnd;
385		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
386		write FAfterTransactionEnd;
387	+	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
388	+	write FOnStartTransaction;
389	+	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
390	+	write FAfterExecQuery;
391	+	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
392	+	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
393	+	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
394	+	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
395		end;
396
397	+	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
398	+	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
399	+	var DBName: string) of object;
400	+
401		{ TIBBase }
402
403		{ Virtually all components in IB are "descendents" of TIBBase.
#	Line 376 | Line 405 | type
405		connections. }
406		TIBBase = class(TObject)
407		protected
408	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
409		FDatabase: TIBDatabase;
410		FIndexInDatabase: Integer;
411		FTransaction: TIBTransaction;
#	Line 385 | Line 415 | type
415		FAfterDatabaseDisconnect: TNotifyEvent;
416		FAfterDatabaseConnect: TNotifyEvent;
417		FOnDatabaseFree: TNotifyEvent;
418	<	FBeforeTransactionEnd: TNotifyEvent;
418	>	FBeforeTransactionEnd: TTransactionEndEvent;
419		FAfterTransactionEnd: TNotifyEvent;
420		FOnTransactionFree: TNotifyEvent;
421
422	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
423	+	var DBName: string); virtual;
424		procedure DoAfterDatabaseConnect; virtual;
425		procedure DoBeforeDatabaseDisconnect; virtual;
426		procedure DoAfterDatabaseDisconnect; virtual;
427		procedure DoDatabaseFree; virtual;
428	<	procedure DoBeforeTransactionEnd; virtual;
428	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
429		procedure DoAfterTransactionEnd; virtual;
430		procedure DoTransactionFree; virtual;
431		function GetDBHandle: PISC_DB_HANDLE; virtual;
#	Line 405 | Line 437 | type
437		destructor Destroy; override;
438		procedure CheckDatabase; virtual;
439		procedure CheckTransaction; virtual;
440	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
441	+	procedure DoAfterEdit(Sender: TObject); virtual;
442	+	procedure DoAfterDelete(Sender: TObject); virtual;
443	+	procedure DoAfterInsert(Sender: TObject); virtual;
444	+	procedure DoAfterPost(Sender: TObject); virtual;
445	+	function GetCharSetSize(CharSetID: integer): integer;
446	+	procedure HandleException(Sender: TObject);
447	+	procedure SetCursor;
448	+	procedure RestoreCursor;
449		public
450	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
451	+	write FBeforeDatabaseConnect;
452		property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
453		write FAfterDatabaseConnect;
454		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
#	Line 413 | Line 456 | type
456		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
457		write FAfterDatabaseDisconnect;
458		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
459	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
459	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
460		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
461		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
462		property Database: TIBDatabase read FDatabase
#	Line 450 | Line 493 | begin
493		FTransactions := TList.Create;
494		FDBName := '';
495		FDBParams := TStringList.Create;
496	+	FSQLHourGlass := true;
497	+	if (AOwner <> nil) and
498	+	(AOwner is TCustomApplication) and
499	+	TCustomApplication(AOWner).ConsoleApplication then
500	+	LoginPrompt := false;
501		{$ifdef UNIX}
502		if csDesigning in ComponentState then
503		FDBParams.Add('lc_ctype=UTF-8');
#	Line 471 | Line 519 | begin
519		FUserNames := nil;
520		FInternalTransaction := TIBTransaction.Create(self);
521		FInternalTransaction.DefaultDatabase := Self;
522	<	FTimer := TTimer.Create(Self);
522	>	FTimer := TFPTimer.Create(Self);
523		FTimer.Enabled := False;
524		FTimer.Interval := 0;
525		FTimer.OnTimer := TimeoutConnection;
#	Line 581 | Line 629 | begin
629		if Connected then
630		InternalClose(False);
631		FDBSQLDialect := 1;
632	+	SetLength(FCharSetSizes,0);
633		end;
634
635		procedure TIBDataBase.CreateDatabase;
#	Line 775 | Line 824 | begin
824		SQLObjects[i].DoAfterDatabaseDisconnect;
825		end;
826
827	+	procedure TIBDataBase.LoadCharSetInfo;
828	+	var Query: TIBSQL;
829	+	i: integer;
830	+	begin
831	+	if not FInternalTransaction.Active then
832	+	FInternalTransaction.StartTransaction;
833	+	Query := TIBSQL.Create(self);
834	+	try
835	+	Query.Database := Self;
836	+	Query.Transaction := FInternalTransaction;
837	+	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
838	+	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
839	+	Query.Prepare;
840	+	Query.ExecQuery;
841	+	if not Query.EOF then
842	+	begin
843	+	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
844	+	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
845	+	repeat
846	+	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
847	+	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
848	+	Query.Next;
849	+	until Query.EOF;
850	+	end;
851	+	finally
852	+	Query.free;
853	+	FInternalTransaction.Commit;
854	+	end;
855	+	end;
856	+
857		procedure TIBDataBase.CheckStreamConnect;
858		var
859		i: integer;
#	Line 801 | Line 880 | begin
880		end;
881		except
882		if csDesigning in ComponentState then
883	<	Application.HandleException(Self)
883	>	HandleException(Self)
884		else
885		raise;
886		end;
887		end;
888
889	+	procedure TIBDataBase.HandleException(Sender: TObject);
890	+	var aParent: TComponent;
891	+	begin
892	+	aParent := Owner;
893	+	while aParent <> nil do
894	+	begin
895	+	if aParent is TCustomApplication then
896	+	begin
897	+	TCustomApplication(aParent).HandleException(Sender);
898	+	Exit;
899	+	end;
900	+	aParent := aParent.Owner;
901	+	end;
902	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
903	+	end;
904	+
905		procedure TIBDataBase.Notification(AComponent: TComponent;
906		Operation: TOperation);
907		var
#	Line 864 | Line 959 | begin
959		end;
960		end
961		else
962	+	if assigned(IBGUIInterface) then
963		begin
964		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
965		if IndexOfUser <> -1 then
#	Line 878 | Line 974 | begin
974		Length(Params[IndexOfPassword]));
975		OldPassword := password;
976		end;
977	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
977	>	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
978		if result then
979		begin
980		if IndexOfUser = -1 then
#	Line 895 | Line 991 | begin
991		HidePassword;
992		end;
993		end;
994	<	end;
994	>	end
995	>	else
996	>	if LoginPrompt then
997	>	IBError(ibxeNoLoginDialog,[]);
998		finally
999		FLoginCalled := false
1000		end;
#	Line 906 | Line 1005 | var
1005		DPB: String;
1006		TempDBParams: TStrings;
1007		I: integer;
1008	<
1008	>	aDBName: string;
1009		begin
1010		CheckInactive;
1011		CheckDatabaseName;
#	Line 918 | Line 1017 | begin
1017		{ Use builtin login prompt if requested }
1018		if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1019		IBError(ibxeOperationCancelled, [nil]);
1020	<	{ Generate a new DPB if necessary }
1021	<	if (FDBParamsChanged) then
1022	<	begin
1023	<	FDBParamsChanged := False;
1024	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1025	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1026	<	else
1027	<	begin
1028	<	TempDBParams := TStringList.Create;
1029	<	try
1030	<	TempDBParams.Assign(FDBParams);
1031	<	TempDBParams.Add('password=' + FHiddenPassword);
1032	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1033	<	finally
1034	<	TempDBParams.Free;
1035	<	end;
1036	<	end;
1037	<	IBAlloc(FDPB, 0, FDPBLength);
1038	<	Move(DPB[1], FDPB[0], FDPBLength);
1020	>
1021	>	TempDBParams := TStringList.Create;
1022	>	try
1023	>	TempDBParams.Assign(FDBParams);
1024	>	aDBName := FDBName;
1025	>	{Opportuning 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	>
1032	>	{ Generate a new DPB if necessary }
1033	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1034	>	begin
1035	>	FDBParamsChanged := False;
1036	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1037	>	GenerateDPB(TempDBParams, DPB, FDPBLength)
1038	>	else
1039	>	begin
1040	>	TempDBParams.Add('password=' + FHiddenPassword);
1041	>	GenerateDPB(TempDBParams, DPB, FDPBLength);
1042	>	end;
1043	>	IBAlloc(FDPB, 0, FDPBLength);
1044	>	Move(DPB[1], FDPB[0], FDPBLength);
1045	>	end;
1046	>	finally
1047	>	TempDBParams.Free;
1048		end;
1049	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
1050	<	PChar(FDBName), @FHandle,
1049	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1050	>	PChar(aDBName), @FHandle,
1051		FDPBLength, FDPB), False) > 0 then
1052		begin
1053		FHandle := nil;
1054		IBDataBaseError;
1055		end;
1056	+	if not (csDesigning in ComponentState) then
1057	+	FDBName := aDBName; {Synchronise at run time}
1058		FDBSQLDialect := GetDBSQLDialect;
1059		ValidateClientSQLDialect;
1060		for i := 0 to FSQLObjects.Count - 1 do
#	Line 954 | Line 1064 | begin
1064		end;
1065		if not (csDesigning in ComponentState) then
1066		MonitorHook.DBConnect(Self);
1067	+	LoadCharSetInfo;
1068		end;
1069
1070		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 1338 | Line 1449 | begin
1449		FTRParamsChanged := True;
1450		TStringList(FTRParams).OnChange := TRParamsChange;
1451		TStringList(FTRParams).OnChanging := TRParamsChanging;
1452	<	FTimer := TTimer.Create(Self);
1452	>	FTimer := TFPTimer.Create(Self);
1453		FTimer.Enabled := False;
1454		FTimer.Interval := 0;
1455		FTimer.OnTimer := TimeoutTransaction;
#	Line 1406 | Line 1517 | begin
1517		FAfterTransactionEnd(self);
1518		end;
1519
1520	+	procedure TIBTransaction.DoOnStartTransaction;
1521	+	begin
1522	+	if assigned(FOnStartTransaction) then
1523	+	OnStartTransaction(self);
1524	+	end;
1525	+
1526	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1527	+	begin
1528	+	if assigned(FAfterExecQuery) then
1529	+	AfterExecQuery(Sender);
1530	+	end;
1531	+
1532	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1533	+	begin
1534	+	if assigned(FAfterEdit) then
1535	+	AfterEdit(Sender);
1536	+	end;
1537	+
1538	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1539	+	begin
1540	+	if assigned(FAfterDelete) then
1541	+	AfterDelete(Sender);
1542	+	end;
1543	+
1544	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1545	+	begin
1546	+	if assigned(FAfterInsert) then
1547	+	AfterInsert(Sender);
1548	+	end;
1549	+
1550	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1551	+	begin
1552	+	if assigned(FAfterPost) then
1553	+	AfterPost(Sender);
1554	+	end;
1555	+
1556		procedure TIBTransaction.EnsureNotInTransaction;
1557		begin
1558		if csDesigning in ComponentState then
#	Line 1493 | Line 1640 | begin
1640		IBError(ibxeCantEndSharedTransaction, [nil]);
1641		DoBeforeTransactionEnd;
1642		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1643	<	SQLObjects[i].DoBeforeTransactionEnd;
1643	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1644		if InTransaction then
1645		begin
1646		if HandleIsShared then
#	Line 1826 | Line 1973 | begin
1973		finally
1974		FreeMem(pteb);
1975		end;
1976	+	DoOnStartTransaction;
1977		end;
1978
1979		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
#	Line 1867 | Line 2015 | begin
2015		inherited Destroy;
2016		end;
2017
2018	+	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2019	+	begin
2020	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2021	+	Result := Database.FCharSetSizes[CharSetID]
2022	+	else
2023	+	Result := 1; {Unknown character set}
2024	+	end;
2025	+
2026	+	procedure TIBBase.HandleException(Sender: TObject);
2027	+	begin
2028	+	if assigned(Database) then
2029	+	Database.HandleException(Sender)
2030	+	else
2031	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2032	+	end;
2033	+
2034	+	procedure TIBBase.SetCursor;
2035	+	begin
2036	+	if Assigned(Database) and not Database.SQLHourGlass then
2037	+	Exit;
2038	+	if assigned(IBGUIInterface) then
2039	+	IBGUIInterface.SetCursor;
2040	+	end;
2041	+
2042	+	procedure TIBBase.RestoreCursor;
2043	+	begin
2044	+	if Assigned(Database) and not Database.SQLHourGlass then
2045	+	Exit;
2046	+	if assigned(IBGUIInterface) then
2047	+	IBGUIInterface.RestoreCursor;
2048	+	end;
2049	+
2050		procedure TIBBase.CheckDatabase;
2051		begin
2052		if (FDatabase = nil) then
#	Line 1893 | Line 2073 | begin
2073		result := @FTransaction.Handle;
2074		end;
2075
2076	+	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2077	+	);
2078	+	begin
2079	+	if assigned(FBeforeDatabaseConnect) then
2080	+	BeforeDatabaseConnect(self,DBParams,DBName);
2081	+	end;
2082	+
2083		procedure TIBBase.DoAfterDatabaseConnect;
2084		begin
2085		if assigned(FAfterDatabaseConnect) then
#	Line 1919 | Line 2106 | begin
2106		SetTransaction(nil);
2107		end;
2108
2109	<	procedure TIBBase.DoBeforeTransactionEnd;
2109	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2110		begin
2111		if Assigned(BeforeTransactionEnd) then
2112	<	BeforeTransactionEnd(Self);
2112	>	BeforeTransactionEnd(Self,Action);
2113		end;
2114
2115		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1938 | Line 2125 | begin
2125		FTransaction := nil;
2126		end;
2127
2128	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2129	+	begin
2130	+	if FTransaction <> nil then
2131	+	FTransaction.DoAfterExecQuery(Sender);
2132	+	end;
2133	+
2134	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2135	+	begin
2136	+	if FTransaction <> nil then
2137	+	FTransaction.DoAfterEdit(Sender);
2138	+	end;
2139	+
2140	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2141	+	begin
2142	+	if FTransaction <> nil then
2143	+	FTransaction.DoAfterDelete(Sender);
2144	+	end;
2145	+
2146	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2147	+	begin
2148	+	if FTransaction <> nil then
2149	+	FTransaction.DoAfterInsert(Sender);
2150	+	end;
2151	+
2152	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2153	+	begin
2154	+	if FTransaction <> nil then
2155	+	FTransaction.DoAfterPost(Sender);
2156	+	end;
2157	+
2158		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2159		begin
2160		if (FDatabase <> nil) then
#	Line 2147 | Line 2364 | end.
2364
2365
2366
2367	<
2367	>

Diff Legend

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