ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabaseInfo.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 83 by tony, Mon Jan 1 11:31:15 2018 UTC

# Line 22 | Line 22
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;
# Line 31 | 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
40 –    FIBLoaded: Boolean;
47      FDatabase: TIBDatabase;
48      FUserNames   : TStringList;
49      FBackoutCount: TStringList;
# Line 48 | 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 77 | 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;
87 –    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 124 | 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);
134 –  FIBLoaded := False;
135 –  CheckIBLoaded;
136 –  FIBLoaded := True;
140    FUserNames := TStringList.Create;
141    FBackoutCount                        := nil;
142    FDeleteCount                         := nil;
# Line 147 | 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;
159 <    FReadSeqCount.Free;
160 <    FUpdateCount.Free;
161 <  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 <
166 < function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
167 <  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
180 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
181 <  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 }
212 <  p^ := #0;                                     { Null it }
213 <  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
218 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
219 <  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
229 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
230 <  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 256 | Line 264 | begin
264   end;
265  
266   function TIBDatabaseInfo.GetVersion: String;
267 < var
260 <  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
261 <  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 293 | 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;
299 <  DatabaseInfoCommand: Char;
300 <  i, user_length: Integer;
301 < begin
302 <  result := FUserNames;
303 <  DatabaseInfoCommand := Char(isc_info_user_names);
304 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
305 <                        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]);
312 <    Inc(i,1);
313 <    Move(local_buffer[i], temp_buffer[0], user_length);
314 <    Inc(i, user_length);
315 <    temp_buffer[user_length] := #0;
316 <    FUserNames.Add(String(temp_buffer));
317 <  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 337 | 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;
344 <  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
355 <      type of operation has occurred since the database was last attached.
356 <    Each pair consists of:
357 <    1. 2 bytes specifying the table ID.
358 <    2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
359 <  }
360 <  qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
361 <  for i := 0 to qtd_tables - 1 do
362 <  begin
363 <    id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
364 <    qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
365 <    FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
366 <  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 412 | 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,
422 <                         IBLocalBufferLength, local_buffer), True);
423 <  length := isc_vax_integer(@local_buffer[1], 2);
424 <  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;
428 – var
429 –  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
430 –  _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,
448 <                       IBLocalBufferLength, local_buffer), True);
449 <  if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
450 <    result := 1
451 <  else begin
452 <    length := isc_vax_integer(@local_buffer[1], 2);
453 <    result := isc_vax_integer(@local_buffer[3], length);
454 <  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