ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBDatabaseInfo.pas

Comparing ibx/trunk/runtime/IBDatabaseInfo.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 25 | Line 25
25		{    IBX For Lazarus (Firebird Express)                                  }
26		{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
27		{    Portions created by MWA Software are copyright McCallum Whyman      }
28	<	{    Associates Ltd 2011                                                 }
28	>	{    Associates Ltd 2011 - 2018                                               }
29		{                                                                        }
30		{************************************************************************}
31
#	Line 40 | Line 40 | uses
40
41		type
42
43	+	{ TIBDatabaseInfo }
44	+
45		TIBDatabaseInfo = class(TComponent)
46	+	private
47	+	function GetDateDBCreated: TDateTime;
48	+	function GetEncrypted: boolean;
49	+	function GetEncryptionKeyName: string;
50	+	function GetPagesFree: Long;
51	+	function GetPagesUsed: Long;
52	+	function GetTransactionCount: Long;
53		protected
45	–	FIBLoaded: Boolean;
54		FDatabase: TIBDatabase;
55		FUserNames   : TStringList;
56		FBackoutCount: TStringList;
#	Line 53 | Line 61 | type
61		FReadIdxCount: TStringList;
62		FReadSeqCount: TStringList;
63		FUpdateCount: TStringList;
64	+	procedure CheckDatabase;
65		function GetAllocation: Long;
66		function GetBaseLevel: Long;
67		function GetDBFileName: String;
#	Line 82 | Line 91 | type
91		function GetReadIdxCount: TStringList;
92		function GetReadSeqCount: TStringList;
93		function GetUpdateCount: TStringList;
94	<	function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
94	>	function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
95		function GetReadOnly: Long;
96		function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
97		function GetDBSQLDialect: Long;
#	Line 90 | Line 99 | type
99		constructor Create(AOwner: TComponent); override;
100		destructor Destroy; override;
101		function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
102	+	function GetDatabasePage(PageNo: integer): string;
103		property Allocation: Long read GetAllocation;
104		property BaseLevel: Long read GetBaseLevel;
105	+	property DateDBCreated: TDateTime read GetDateDBCreated;
106		property DBFileName: String read GetDBFileName;
107		property DBSiteName: String read GetDBSiteName;
108		property DBImplementationNo: Long read GetDBImplementationNo;
109		property DBImplementationClass: Long read GetDBImplementationClass;
110	+	property Encrypted: boolean read GetEncrypted;
111	+	property EncryptionKeyName: string read GetEncryptionKeyName;
112		property NoReserve: Long read GetNoReserve;
113		property ODSMinorVersion: Long read GetODSMinorVersion;
114		property ODSMajorVersion: Long read GetODSMajorVersion;
#	Line 111 | Line 124 | type
124		property Marks: Long read GetMarks;
125		property Reads: Long read GetReads;
126		property Writes: Long read GetWrites;
127	+	property TransactionCount: Long read GetTransactionCount;
128		property BackoutCount: TStringList read GetBackoutCount;
129		property DeleteCount: TStringList read GetDeleteCount;
130		property ExpungeCount: TStringList read GetExpungeCount;
#	Line 120 | Line 134 | type
134		property ReadSeqCount: TStringList read GetReadSeqCount;
135		property UpdateCount: TStringList read GetUpdateCount;
136		property DBSQLDialect : Long read GetDBSQLDialect;
137	+	property PagesUsed: Long read GetPagesUsed;
138	+	property PagesFree: Long read GetPagesFree;
139		property ReadOnly: Long read GetReadOnly;
140		published
141		property Database: TIBDatabase read FDatabase write FDatabase;
#	Line 135 | Line 151 | uses
151		constructor TIBDatabaseInfo.Create(AOwner: TComponent);
152		begin
153		inherited Create(AOwner);
138	–	FIBLoaded := False;
139	–	CheckIBLoaded;
140	–	FIBLoaded := True;
154		FUserNames := TStringList.Create;
155		FBackoutCount                        := nil;
156		FDeleteCount                         := nil;
#	Line 151 | Line 164 | end;
164
165		destructor TIBDatabaseInfo.Destroy;
166		begin
167	<	if FIBLoaded then
168	<	begin
169	<	FUserNames.Free;
170	<	FBackoutCount.Free;
171	<	FDeleteCount.Free;
172	<	FExpungeCount.Free;
173	<	FInsertCount.Free;
174	<	FPurgeCount.Free;
175	<	FReadIdxCount.Free;
163	<	FReadSeqCount.Free;
164	<	FUpdateCount.Free;
165	<	end;
167	>	if assigned(FUserNames) then FUserNames.Free;
168	>	if assigned(FBackoutCount) then FBackoutCount.Free;
169	>	if assigned(FDeleteCount) then FDeleteCount.Free;
170	>	if assigned(FExpungeCount) then FExpungeCount.Free;
171	>	if assigned(FInsertCount) then FInsertCount.Free;
172	>	if assigned(FPurgeCount) then FPurgeCount.Free;
173	>	if assigned(FReadIdxCount) then FReadIdxCount.Free;
174	>	if assigned(FReadSeqCount) then FReadSeqCount.Free;
175	>	if assigned(FUpdateCount) then FUpdateCount.Free;
176		inherited Destroy;
177		end;
178
179	+	function TIBDatabaseInfo.GetDateDBCreated: TDateTime;
180	+	begin
181	+	CheckDatabase;
182	+	with Database.Attachment.GetDBInformation([isc_info_creation_date]) do
183	+	if (Count > 0) and (Items[0].GetItemType = isc_info_creation_date) then
184	+	Result := Items[0].GetAsDateTime
185	+	else
186	+	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
187	+	end;
188	+
189	+	function TIBDatabaseInfo.GetEncrypted: boolean;
190	+	var ConnFlags: Long;
191	+	begin
192	+	Result := ODSMajorVersion >= 12;
193	+	if Result then
194	+	try
195	+	ConnFlags := GetLongDatabaseInfo(fb_info_conn_flags);
196	+	Result := (ConnFlags and fb_info_crypt_encrypted) <> 0;
197	+	except
198	+	Result := false; {Introduced in Firebird 3.0.3}
199	+	end;
200	+	end;
201	+
202	+	function TIBDatabaseInfo.GetEncryptionKeyName: string;
203	+	begin
204	+	CheckDatabase;
205	+	{Introduced in Firebird 3.0.3}
206	+	with Database.Attachment.GetDBInformation([fb_info_crypt_key]) do
207	+	if (Count > 0) and (Items[0].GetItemType = fb_info_crypt_key) then
208	+	Result := Items[0].AsString
209	+	else
210	+	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
211	+	end;
212	+
213	+	function TIBDatabaseInfo.GetPagesFree: Long;
214	+	begin
215	+	result := GetLongDatabaseInfo(fb_info_pages_used);
216	+	end;
217	+
218	+	function TIBDatabaseInfo.GetPagesUsed: Long;
219	+	begin
220	+	result := GetLongDatabaseInfo(fb_info_pages_free);
221	+	end;
222	+
223	+	function TIBDatabaseInfo.GetTransactionCount: Long;
224	+	begin
225	+	result := GetLongDatabaseInfo(isc_info_active_tran_count);
226	+	end;
227	+
228	+	procedure TIBDatabaseInfo.CheckDatabase;
229	+	begin
230	+	if Database = nil then
231	+	IBError(ibxeDatabaseNotAssigned,[]);
232	+	if Database.Attachment = nil then
233	+	IBError(ibxeDatabaseClosed,[]);
234	+	end;
235
236		function TIBDatabaseInfo.GetAllocation: Long;
237		begin
#	Line 175 | Line 241 | end;
241		function TIBDatabaseInfo.GetBaseLevel: Long;
242		var Response: TByteArray;
243		begin
244	+	CheckDatabase;
245		with Database.Attachment.GetDBInformation([isc_info_base_level]) do
246		if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
247		begin
#	Line 190 | Line 257 | var
257		ConnectionType: integer;
258		SiteName: string;
259		begin
260	+	CheckDatabase;
261		with Database.Attachment.GetDBInformation([isc_info_db_id]) do
262		if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
263		Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
#	Line 202 | Line 270 | var
270		ConnectionType: integer;
271		FileName: string;
272		begin
273	+	CheckDatabase;
274		with Database.Attachment.GetDBInformation([isc_info_db_id]) do
275		if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
276		Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
#	Line 212 | Line 281 | end;
281		function TIBDatabaseInfo.GetDBImplementationNo: Long;
282		var Response: TByteArray;
283		begin
284	+	CheckDatabase;
285		with Database.Attachment.GetDBInformation([isc_info_implementation]) do
286		if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
287		begin
#	Line 225 | Line 295 | end;
295		function TIBDatabaseInfo.GetDBImplementationClass: Long;
296		var Response: TByteArray;
297		begin
298	+	CheckDatabase;
299		with Database.Attachment.GetDBInformation([isc_info_implementation]) do
300		if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
301		begin
#	Line 242 | Line 313 | end;
313
314		function TIBDatabaseInfo.GetODSMinorVersion: Long;
315		begin
316	<	result := GetLongDatabaseInfo(isc_info_ods_minor_version);
316	>	CheckDatabase;
317	>	Result := Database.Attachment.GetODSMinorVersion;
318		end;
319
320		function TIBDatabaseInfo.GetODSMajorVersion: Long;
321		begin
322	<	result := GetLongDatabaseInfo(isc_info_ods_version);
322	>	CheckDatabase;
323	>	Result := Database.Attachment.GetODSMajorVersion;
324		end;
325
326		function TIBDatabaseInfo.GetPageSize: Long;
#	Line 258 | Line 331 | end;
331		function TIBDatabaseInfo.GetVersion: String;
332		var Version: byte;
333		begin
334	+	CheckDatabase;
335		with Database.Attachment.GetDBInformation([isc_info_version]) do
336		if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
337		Items[0].DecodeVersionString(Version,Result)
#	Line 292 | Line 366 | end;
366
367		function TIBDatabaseInfo.GetUserNames: TStringList;
368		begin
369	+	CheckDatabase;
370		Result := FUserNames;
371		FUserNames.Clear;
372		with Database.Attachment.GetDBInformation([isc_info_user_names]) do
#	Line 321 | Line 396 | begin
396		result := GetLongDatabaseInfo(isc_info_writes);
397		end;
398
399	<	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
399	>	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
400	>	var FOperation: TStringList): TStringList;
401		var opCounts: TDBOperationCounts;
402		i: integer;
403		begin
404	+	CheckDatabase;
405		if FOperation = nil then FOperation := TStringList.Create;
406		result := FOperation;
407		with Database.Attachment.GetDBInformation([DBInfoCommand]) do
#	Line 383 | Line 460 | end;
460
461		function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
462		begin
463	+	CheckDatabase;
464		with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
465		if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
466		Result := Items[0].AsInteger
#	Line 390 | Line 468 | begin
468		IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
469		end;
470
471	+	function TIBDatabaseInfo.GetDatabasePage(PageNo: integer): string;
472	+	var DBRequest: IDIRB;
473	+	begin
474	+	DBRequest := Database.Attachment.AllocateDIRB;
475	+	DBRequest.Add(fb_info_page_contents).AsInteger := PageNo;
476	+	with Database.Attachment.GetDBInformation(DBRequest) do
477	+	if (Count > 0) and (Items[0].GetItemType = fb_info_page_contents) then
478	+	Result := Items[0].AsString
479	+	else
480	+	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
481	+	end;
482	+
483		function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
484		begin
485	+	CheckDatabase;
486		with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
487		if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
488		Result := Items[0].AsString
#	Line 400 | Line 491 | begin
491		end;
492
493
494	<	function TIBDatabaseInfo.GetDBSQLDialect: Integer;
494	>	function TIBDatabaseInfo.GetDBSQLDialect: Long;
495		begin
496	+	CheckDatabase;
497		with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
498		if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
499		Result := Items[0].AsInteger

Diff Legend

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