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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 83 by tony, Mon Jan 1 11:31:15 2018 UTC

#	Line 36 | Line 36 | unit IBDatabaseInfo;
36		interface
37
38		uses
39	<	SysUtils, Classes, IBHeader, IBExternals, IB, IBDatabase;
39	>	SysUtils, Classes, IB, IBExternals, IBDatabase;
40
41		type
42
43	+	{ TIBDatabaseInfo }
44	+
45		TIBDatabaseInfo = class(TComponent)
46		protected
45	–	FIBLoaded: Boolean;
47		FDatabase: TIBDatabase;
48		FUserNames   : TStringList;
49		FBackoutCount: TStringList;
#	Line 53 | 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 82 | 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;
89		function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
90		function GetDBSQLDialect: Long;
91		public
92		constructor Create(AOwner: TComponent); override;
93		destructor Destroy; override;
92	–	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;
#	Line 129 | 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);
139	–	FIBLoaded := False;
140	–	CheckIBLoaded;
141	–	FIBLoaded := True;
140		FUserNames := TStringList.Create;
141		FBackoutCount                        := nil;
142		FDeleteCount                         := nil;
#	Line 152 | 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;
164	<	FReadSeqCount.Free;
165	<	FUpdateCount.Free;
166	<	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	<
171	<	function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
172	<	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
185	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
186	<	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 }
217	<	p^ := #0;                                     { Null it }
218	<	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
223	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
224	<	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
234	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
235	<	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 261 | Line 264 | begin
264		end;
265
266		function TIBDatabaseInfo.GetVersion: String;
267	<	var
265	<	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
266	<	DatabaseInfoCommand: Char;
267	>	var Version: byte;
268		begin
269	<	DatabaseInfoCommand := Char(isc_info_version);
270	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
271	<	IBBigLocalBufferLength, local_buffer), True);
272	<	local_buffer[5 + Int(local_buffer[4])] := #0;
273	<	result := String(PChar(@local_buffer[5]));
269	>	CheckDatabase;
270	>	with Database.Attachment.GetDBInformation([isc_info_version]) do
271	>	if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
272	>	Items[0].DecodeVersionString(Version,Result)
273	>	else
274	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
275		end;
276
277		function TIBDatabaseInfo.GetCurrentMemory: Long;
#	Line 298 | Line 300 | begin
300		end;
301
302		function TIBDatabaseInfo.GetUserNames: TStringList;
303	<	var
304	<	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
305	<	temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
304	<	DatabaseInfoCommand: Char;
305	<	i, user_length: Integer;
306	<	begin
307	<	result := FUserNames;
308	<	DatabaseInfoCommand := Char(isc_info_user_names);
309	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
310	<	IBHugeLocalBufferLength, local_buffer), True);
303	>	begin
304	>	CheckDatabase;
305	>	Result := FUserNames;
306		FUserNames.Clear;
307	<	i := 0;
308	<	while local_buffer[i] = Char(isc_info_user_names) do
309	<	begin
310	<	Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
311	<	user_length := Long(local_buffer[i]);
317	<	Inc(i,1);
318	<	Move(local_buffer[i], temp_buffer[0], user_length);
319	<	Inc(i, user_length);
320	<	temp_buffer[user_length] := #0;
321	<	FUserNames.Add(String(temp_buffer));
322	<	end;
307	>	with Database.Attachment.GetDBInformation([isc_info_user_names]) do
308	>	if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
309	>	Items[0].DecodeUserNames(Result)
310	>	else
311	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
312		end;
313
314		function TIBDatabaseInfo.GetFetches: Long;
#	Line 342 | Line 331 | begin
331		result := GetLongDatabaseInfo(isc_info_writes);
332		end;
333
334	<	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
335	<	var
336	<	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
337	<	DatabaseInfoCommand: Char;
349	<	i, qtd_tables, id_table, qtd_operations: Integer;
334	>	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
335	>	var FOperation: TStringList): TStringList;
336	>	var opCounts: TDBOperationCounts;
337	>	i: integer;
338		begin
339	+	CheckDatabase;
340		if FOperation = nil then FOperation := TStringList.Create;
341		result := FOperation;
342	<	DatabaseInfoCommand := Char(DBInfoCommand);
343	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
344	<	IBHugeLocalBufferLength, local_buffer), True);
345	<	FOperation.Clear;
346	<	{ 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
347	<	2. 2 bytes telling how many bytes compose the subsequent value pairs.
348	<	3. A pair of values for each table in the database on wich the requested
360	<	type of operation has occurred since the database was last attached.
361	<	Each pair consists of:
362	<	1. 2 bytes specifying the table ID.
363	<	2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
364	<	}
365	<	qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
366	<	for i := 0 to qtd_tables - 1 do
367	<	begin
368	<	id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
369	<	qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
370	<	FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
371	<	end;
342	>	with Database.Attachment.GetDBInformation([DBInfoCommand]) do
343	>	if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
344	>	opCounts := Items[0].getOperationCounts
345	>	else
346	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
347	>	for i := 0 to Length(opCounts) - 1 do
348	>	FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
349		end;
350
351		function TIBDatabaseInfo.GetBackoutCount: TStringList;
#	Line 417 | Line 394 | begin
394		end;
395
396		function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
397	<	var
398	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
399	<	length: Integer;
400	<	_DatabaseInfoCommand: Char;
401	<	begin
402	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
403	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
427	<	IBLocalBufferLength, local_buffer), True);
428	<	length := isc_vax_integer(@local_buffer[1], 2);
429	<	result := isc_vax_integer(@local_buffer[3], length);
397	>	begin
398	>	CheckDatabase;
399	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
400	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
401	>	Result := Items[0].AsInteger
402	>	else
403	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
404		end;
405
406		function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
433	–	var
434	–	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
435	–	_DatabaseInfoCommand: Char;
407		begin
408	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
409	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
410	<	IBBigLocalBufferLength, local_buffer), True);
411	<	local_buffer[4 + Int(local_buffer[3])] := #0;
412	<	result := String(PChar(@local_buffer[4]));
408	>	CheckDatabase;
409	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
410	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
411	>	Result := Items[0].AsString
412	>	else
413	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
414		end;
415
416
417	<	function TIBDatabaseInfo.GetDBSQLDialect: Integer;
418	<	var
419	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
420	<	length: Integer;
421	<	DatabaseInfoCommand: Char;
422	<	begin
423	<	DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
424	<	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
453	<	IBLocalBufferLength, local_buffer), True);
454	<	if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
455	<	result := 1
456	<	else begin
457	<	length := isc_vax_integer(@local_buffer[1], 2);
458	<	result := isc_vax_integer(@local_buffer[3], length);
459	<	end;
417	>	function TIBDatabaseInfo.GetDBSQLDialect: Long;
418	>	begin
419	>	CheckDatabase;
420	>	with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
421	>	if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
422	>	Result := Items[0].AsInteger
423	>	else
424	>	Result := 1;
425		end;
426
427

Diff Legend

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