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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 83 by tony, Mon Jan 1 11:31:15 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 257 | Line 264 | begin
264   end;
265  
266   function TIBDatabaseInfo.GetVersion: String;
267 < var
261 <  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
262 <  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 294 | 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;
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);
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]);
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;
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 338 | 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;
345 <  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
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;
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 413 | 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,
423 <                         IBLocalBufferLength, local_buffer), True);
424 <  length := isc_vax_integer(@local_buffer[1], 2);
425 <  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;
429 – var
430 –  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
431 –  _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,
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;
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