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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

#	Line 18 | Line 18
18		{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19		{    express or implied. See the License for the specific language       }
20		{    governing rights and limitations under the License.                 }
21	–	{    The Original Code was created by InterBase Software Corporation     }
22	–	{       and its successors.                                              }
21		{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
22		{       Corporation. All Rights Reserved.                                }
23		{    Contributor(s): Jeff Overcash                                       }
24		{                                                                        }
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                                                 }
29	+	{                                                                        }
30		{************************************************************************}
31
32		unit IBDatabaseInfo;
33
34	+	{$Mode Delphi}
35	+
36		interface
37
38		uses
39	<	Windows, SysUtils, Classes, Forms, ExtCtrls,
35	<	IBHeader, IBExternals, IB, IBDatabase;
39	>	SysUtils, Classes, IB, IBExternals, IBDatabase;
40
41		type
42
43	+	{ TIBDatabaseInfo }
44	+
45		TIBDatabaseInfo = class(TComponent)
46		protected
41	–	FIBLoaded: Boolean;
47		FDatabase: TIBDatabase;
48		FUserNames   : TStringList;
49		FBackoutCount: TStringList;
#	Line 49 | Line 54 | type
54		FReadIdxCount: TStringList;
55		FReadSeqCount: TStringList;
56		FUpdateCount: TStringList;
57	+	procedure CheckDatabase;
58		function GetAllocation: Long;
59		function GetBaseLevel: Long;
60		function GetDBFileName: String;
#	Line 78 | Line 84 | type
84		function GetReadIdxCount: TStringList;
85		function GetReadSeqCount: TStringList;
86		function GetUpdateCount: TStringList;
87	<	function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
87	>	function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
88		function GetReadOnly: Long;
83	–	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
89		function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
90		function GetDBSQLDialect: Long;
91		public
92		constructor Create(AOwner: TComponent); override;
93		destructor Destroy; override;
94	<	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
94	>	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
95		property Allocation: Long read GetAllocation;
96		property BaseLevel: Long read GetBaseLevel;
97		property DBFileName: String read GetDBFileName;
#	Line 125 | Line 130 | type
130		implementation
131
132		uses
133	<	IBIntf;
133	>	FBMessages;
134
135		{ TIBDatabaseInfo }
136
137		constructor TIBDatabaseInfo.Create(AOwner: TComponent);
138		begin
139		inherited Create(AOwner);
135	–	FIBLoaded := False;
136	–	CheckIBLoaded;
137	–	FIBLoaded := True;
140		FUserNames := TStringList.Create;
141		FBackoutCount                        := nil;
142		FDeleteCount                         := nil;
#	Line 148 | Line 150 | end;
150
151		destructor TIBDatabaseInfo.Destroy;
152		begin
153	<	if FIBLoaded then
154	<	begin
155	<	FUserNames.Free;
156	<	FBackoutCount.Free;
157	<	FDeleteCount.Free;
158	<	FExpungeCount.Free;
159	<	FInsertCount.Free;
160	<	FPurgeCount.Free;
161	<	FReadIdxCount.Free;
160	<	FReadSeqCount.Free;
161	<	FUpdateCount.Free;
162	<	end;
153	>	if assigned(FUserNames) then FUserNames.Free;
154	>	if assigned(FBackoutCount) then FBackoutCount.Free;
155	>	if assigned(FDeleteCount) then FDeleteCount.Free;
156	>	if assigned(FExpungeCount) then FExpungeCount.Free;
157	>	if assigned(FInsertCount) then FInsertCount.Free;
158	>	if assigned(FPurgeCount) then FPurgeCount.Free;
159	>	if assigned(FReadIdxCount) then FReadIdxCount.Free;
160	>	if assigned(FReadSeqCount) then FReadSeqCount.Free;
161	>	if assigned(FUpdateCount) then FUpdateCount.Free;
162		inherited Destroy;
163		end;
164
165	<
167	<	function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
168	<	RaiseError: Boolean): ISC_STATUS;
165	>	procedure TIBDatabaseInfo.CheckDatabase;
166		begin
167	<	result := ErrCode;
168	<	if RaiseError and (ErrCode > 0) then
169	<	IBDataBaseError;
167	>	if Database = nil then
168	>	IBError(ibxeDatabaseNotAssigned,[]);
169	>	if Database.Attachment = nil then
170	>	IBError(ibxeDatabaseClosed,[]);
171		end;
172	+
173		function TIBDatabaseInfo.GetAllocation: Long;
174		begin
175		result := GetLongDatabaseInfo(isc_info_allocation);
176		end;
177
178		function TIBDatabaseInfo.GetBaseLevel: Long;
179	<	var
181	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
182	<	DatabaseInfoCommand: Char;
179	>	var Response: TByteArray;
180		begin
181	<	DatabaseInfoCommand := Char(isc_info_base_level);
182	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
183	<	IBLocalBufferLength, local_buffer), True);
184	<	result := isc_vax_integer(@local_buffer[4], 1);
181	>	CheckDatabase;
182	>	with Database.Attachment.GetDBInformation([isc_info_base_level]) do
183	>	if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
184	>	begin
185	>	Response := Items[0].GetAsBytes;
186	>	Result := Response[1];
187	>	end
188	>	else
189	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
190		end;
191
192		function TIBDatabaseInfo.GetDBFileName: String;
193		var
194	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
195	<	DatabaseInfoCommand: Char;
194	>	ConnectionType: integer;
195	>	SiteName: string;
196		begin
197	<	DatabaseInfoCommand := Char(isc_info_db_id);
198	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
199	<	IBLocalBufferLength, local_buffer), True);
200	<	local_buffer[5 + Int(local_buffer[4])] := #0;
201	<	result := String(PChar(@local_buffer[5]));
197	>	CheckDatabase;
198	>	with Database.Attachment.GetDBInformation([isc_info_db_id]) do
199	>	if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
200	>	Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
201	>	else
202	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
203		end;
204
205		function TIBDatabaseInfo.GetDBSiteName: String;
206		var
207	<	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
208	<	p: PChar;
209	<	DatabaseInfoCommand: Char;
210	<	begin
211	<	DatabaseInfoCommand := Char(isc_info_db_id);
212	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
213	<	IBLocalBufferLength, local_buffer), True);
214	<	p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
215	<	p := p + Int(p^) + 1;                         { End of DBSiteName }
213	<	p^ := #0;                                     { Null it }
214	<	result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
207	>	ConnectionType: integer;
208	>	FileName: string;
209	>	begin
210	>	CheckDatabase;
211	>	with Database.Attachment.GetDBInformation([isc_info_db_id]) do
212	>	if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
213	>	Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
214	>	else
215	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
216		end;
217
218		function TIBDatabaseInfo.GetDBImplementationNo: Long;
219	<	var
219	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
220	<	DatabaseInfoCommand: Char;
219	>	var Response: TByteArray;
220		begin
221	<	DatabaseInfoCommand := Char(isc_info_implementation);
222	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
223	<	IBLocalBufferLength, local_buffer), True);
224	<	result := isc_vax_integer(@local_buffer[3], 1);
221	>	CheckDatabase;
222	>	with Database.Attachment.GetDBInformation([isc_info_implementation]) do
223	>	if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
224	>	begin
225	>	Response := Items[0].GetAsBytes;
226	>	Result := Response[1];
227	>	end
228	>	else
229	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
230		end;
231
232		function TIBDatabaseInfo.GetDBImplementationClass: Long;
233	<	var
230	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
231	<	DatabaseInfoCommand: Char;
233	>	var Response: TByteArray;
234		begin
235	<	DatabaseInfoCommand := Char(isc_info_implementation);
236	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
237	<	IBLocalBufferLength, local_buffer), True);
238	<	result := isc_vax_integer(@local_buffer[4], 1);
235	>	CheckDatabase;
236	>	with Database.Attachment.GetDBInformation([isc_info_implementation]) do
237	>	if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
238	>	begin
239	>	Response := Items[0].GetAsBytes;
240	>	Result := Response[2];
241	>	end
242	>	else
243	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
244		end;
245
246		function TIBDatabaseInfo.GetNoReserve: Long;
#	Line 243 | Line 250 | end;
250
251		function TIBDatabaseInfo.GetODSMinorVersion: Long;
252		begin
253	<	result := GetLongDatabaseInfo(isc_info_ods_minor_version);
253	>	CheckDatabase;
254	>	Result := Database.Attachment.GetODSMinorVersion;
255		end;
256
257		function TIBDatabaseInfo.GetODSMajorVersion: Long;
258		begin
259	<	result := GetLongDatabaseInfo(isc_info_ods_version);
259	>	CheckDatabase;
260	>	Result := Database.Attachment.GetODSMajorVersion;
261		end;
262
263		function TIBDatabaseInfo.GetPageSize: Long;
#	Line 257 | Line 266 | begin
266		end;
267
268		function TIBDatabaseInfo.GetVersion: String;
269	<	var
261	<	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
262	<	DatabaseInfoCommand: Char;
269	>	var Version: byte;
270		begin
271	<	DatabaseInfoCommand := Char(isc_info_version);
272	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
273	<	IBBigLocalBufferLength, local_buffer), True);
274	<	local_buffer[5 + Int(local_buffer[4])] := #0;
275	<	result := String(PChar(@local_buffer[5]));
271	>	CheckDatabase;
272	>	with Database.Attachment.GetDBInformation([isc_info_version]) do
273	>	if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
274	>	Items[0].DecodeVersionString(Version,Result)
275	>	else
276	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
277		end;
278
279		function TIBDatabaseInfo.GetCurrentMemory: Long;
#	Line 294 | Line 302 | begin
302		end;
303
304		function TIBDatabaseInfo.GetUserNames: TStringList;
305	<	var
306	<	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
307	<	temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
300	<	DatabaseInfoCommand: Char;
301	<	i, user_length: Integer;
302	<	begin
303	<	result := FUserNames;
304	<	DatabaseInfoCommand := Char(isc_info_user_names);
305	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
306	<	IBHugeLocalBufferLength, local_buffer), True);
305	>	begin
306	>	CheckDatabase;
307	>	Result := FUserNames;
308		FUserNames.Clear;
309	<	i := 0;
310	<	while local_buffer[i] = Char(isc_info_user_names) do
311	<	begin
312	<	Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
313	<	user_length := Long(local_buffer[i]);
313	<	Inc(i,1);
314	<	Move(local_buffer[i], temp_buffer[0], user_length);
315	<	Inc(i, user_length);
316	<	temp_buffer[user_length] := #0;
317	<	FUserNames.Add(String(temp_buffer));
318	<	end;
309	>	with Database.Attachment.GetDBInformation([isc_info_user_names]) do
310	>	if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
311	>	Items[0].DecodeUserNames(Result)
312	>	else
313	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
314		end;
315
316		function TIBDatabaseInfo.GetFetches: Long;
#	Line 338 | Line 333 | begin
333		result := GetLongDatabaseInfo(isc_info_writes);
334		end;
335
336	<	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
337	<	var
338	<	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
339	<	DatabaseInfoCommand: Char;
345	<	i, qtd_tables, id_table, qtd_operations: Integer;
336	>	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
337	>	var FOperation: TStringList): TStringList;
338	>	var opCounts: TDBOperationCounts;
339	>	i: integer;
340		begin
341	+	CheckDatabase;
342		if FOperation = nil then FOperation := TStringList.Create;
343		result := FOperation;
344	<	DatabaseInfoCommand := Char(DBInfoCommand);
345	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
346	<	IBHugeLocalBufferLength, local_buffer), True);
347	<	FOperation.Clear;
348	<	{ 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
349	<	2. 2 bytes telling how many bytes compose the subsequent value pairs.
350	<	3. A pair of values for each table in the database on wich the requested
356	<	type of operation has occurred since the database was last attached.
357	<	Each pair consists of:
358	<	1. 2 bytes specifying the table ID.
359	<	2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
360	<	}
361	<	qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
362	<	for i := 0 to qtd_tables - 1 do
363	<	begin
364	<	id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
365	<	qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
366	<	FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
367	<	end;
344	>	with Database.Attachment.GetDBInformation([DBInfoCommand]) do
345	>	if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
346	>	opCounts := Items[0].getOperationCounts
347	>	else
348	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
349	>	for i := 0 to Length(opCounts) - 1 do
350	>	FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
351		end;
352
353		function TIBDatabaseInfo.GetBackoutCount: TStringList;
#	Line 413 | Line 396 | begin
396		end;
397
398		function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
399	<	var
400	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
401	<	length: Integer;
402	<	_DatabaseInfoCommand: Char;
403	<	begin
404	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
405	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
423	<	IBLocalBufferLength, local_buffer), True);
424	<	length := isc_vax_integer(@local_buffer[1], 2);
425	<	result := isc_vax_integer(@local_buffer[3], length);
399	>	begin
400	>	CheckDatabase;
401	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
402	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
403	>	Result := Items[0].AsInteger
404	>	else
405	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
406		end;
407
408		function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
429	–	var
430	–	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
431	–	_DatabaseInfoCommand: Char;
409		begin
410	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
411	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
412	<	IBBigLocalBufferLength, local_buffer), True);
413	<	local_buffer[4 + Int(local_buffer[3])] := #0;
414	<	result := String(PChar(@local_buffer[4]));
410	>	CheckDatabase;
411	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
412	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
413	>	Result := Items[0].AsString
414	>	else
415	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
416		end;
417
418
419	<	function TIBDatabaseInfo.GetDBSQLDialect: Integer;
420	<	var
421	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
422	<	length: Integer;
423	<	DatabaseInfoCommand: Char;
424	<	begin
425	<	DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
426	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
449	<	IBLocalBufferLength, local_buffer), True);
450	<	if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
451	<	result := 1
452	<	else begin
453	<	length := isc_vax_integer(@local_buffer[1], 2);
454	<	result := isc_vax_integer(@local_buffer[3], length);
455	<	end;
419	>	function TIBDatabaseInfo.GetDBSQLDialect: Long;
420	>	begin
421	>	CheckDatabase;
422	>	with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
423	>	if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
424	>	Result := Items[0].AsInteger
425	>	else
426	>	Result := 1;
427		end;
428
429

Diff Legend

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