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 45 by tony, Tue Dec 6 10:33:46 2016 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  
# Line 80 | Line 84 | type
84      function GetUpdateCount: TStringList;
85      function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
86      function GetReadOnly: Long;
83    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
87      function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
88      function GetDBSQLDialect: Long;
89    public
90      constructor Create(AOwner: TComponent); override;
91      destructor Destroy; override;
92 <    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
92 >    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
93      property Allocation: Long read GetAllocation;
94      property BaseLevel: Long read GetBaseLevel;
95      property DBFileName: String read GetDBFileName;
# Line 125 | Line 128 | type
128   implementation
129  
130   uses
131 <  IBIntf;
131 >  FBMessages;
132  
133   { TIBDatabaseInfo }
134  
# Line 164 | Line 167 | begin
167   end;
168  
169  
167 function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
168  RaiseError: Boolean): ISC_STATUS;
169 begin
170  result := ErrCode;
171  if RaiseError and (ErrCode > 0) then
172    IBDataBaseError;
173 end;
170   function TIBDatabaseInfo.GetAllocation: Long;
171   begin
172    result := GetLongDatabaseInfo(isc_info_allocation);
173   end;
174  
175   function TIBDatabaseInfo.GetBaseLevel: Long;
176 < var
181 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
182 <  DatabaseInfoCommand: Char;
176 > var Response: TByteArray;
177   begin
178 <  DatabaseInfoCommand := Char(isc_info_base_level);
179 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
180 <                         IBLocalBufferLength, local_buffer), True);
181 <  result := isc_vax_integer(@local_buffer[4], 1);
178 >  with Database.Attachment.GetDBInformation([isc_info_base_level]) do
179 >    if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
180 >    begin
181 >      Response := Items[0].GetAsBytes;
182 >      Result := Response[1];
183 >    end
184 >  else
185 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
186   end;
187  
188   function TIBDatabaseInfo.GetDBFileName: String;
189   var
190 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
191 <  DatabaseInfoCommand: Char;
190 >  ConnectionType: integer;
191 >  SiteName: string;
192   begin
193 <  DatabaseInfoCommand := Char(isc_info_db_id);
194 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
195 <                         IBLocalBufferLength, local_buffer), True);
196 <  local_buffer[5 + Int(local_buffer[4])] := #0;
197 <  result := String(PChar(@local_buffer[5]));
193 >  with Database.Attachment.GetDBInformation([isc_info_db_id]) do
194 >    if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
195 >      Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
196 >    else
197 >       IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
198   end;
199  
200   function TIBDatabaseInfo.GetDBSiteName: String;
201   var
202 <  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
203 <  p: PChar;
204 <  DatabaseInfoCommand: Char;
205 < begin
206 <  DatabaseInfoCommand := Char(isc_info_db_id);
207 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
208 <                        IBLocalBufferLength, local_buffer), True);
209 <  p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
212 <  p := p + Int(p^) + 1;                         { End of DBSiteName }
213 <  p^ := #0;                                     { Null it }
214 <  result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
202 >  ConnectionType: integer;
203 >  FileName: string;
204 > begin
205 >  with Database.Attachment.GetDBInformation([isc_info_db_id]) do
206 >    if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
207 >      Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
208 >    else
209 >       IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
210   end;
211  
212   function TIBDatabaseInfo.GetDBImplementationNo: Long;
213 < var
219 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
220 <  DatabaseInfoCommand: Char;
213 > var Response: TByteArray;
214   begin
215 <  DatabaseInfoCommand := Char(isc_info_implementation);
216 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
217 <                        IBLocalBufferLength, local_buffer), True);
218 <  result := isc_vax_integer(@local_buffer[3], 1);
215 >  with Database.Attachment.GetDBInformation([isc_info_implementation]) do
216 >    if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
217 >    begin
218 >      Response := Items[0].GetAsBytes;
219 >      Result := Response[1];
220 >    end
221 >  else
222 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
223   end;
224  
225   function TIBDatabaseInfo.GetDBImplementationClass: Long;
226 < var
230 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
231 <  DatabaseInfoCommand: Char;
226 > var Response: TByteArray;
227   begin
228 <  DatabaseInfoCommand := Char(isc_info_implementation);
229 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
230 <                         IBLocalBufferLength, local_buffer), True);
231 <  result := isc_vax_integer(@local_buffer[4], 1);
228 >  with Database.Attachment.GetDBInformation([isc_info_implementation]) do
229 >    if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
230 >    begin
231 >      Response := Items[0].GetAsBytes;
232 >      Result := Response[2];
233 >    end
234 >  else
235 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
236   end;
237  
238   function TIBDatabaseInfo.GetNoReserve: Long;
# Line 257 | Line 256 | begin
256   end;
257  
258   function TIBDatabaseInfo.GetVersion: String;
259 < var
261 <  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
262 <  DatabaseInfoCommand: Char;
259 > var Version: byte;
260   begin
261 <  DatabaseInfoCommand := Char(isc_info_version);
262 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
263 <                        IBBigLocalBufferLength, local_buffer), True);
264 <  local_buffer[5 + Int(local_buffer[4])] := #0;
265 <  result := String(PChar(@local_buffer[5]));
261 >  with Database.Attachment.GetDBInformation([isc_info_version]) do
262 >    if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
263 >      Items[0].DecodeVersionString(Version,Result)
264 >  else
265 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
266   end;
267  
268   function TIBDatabaseInfo.GetCurrentMemory: Long;
# Line 294 | Line 291 | begin
291   end;
292  
293   function TIBDatabaseInfo.GetUserNames: TStringList;
294 < var
295 <  local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
299 <  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);
294 > begin
295 >  Result := FUserNames;
296    FUserNames.Clear;
297 <  i := 0;
298 <  while local_buffer[i] = Char(isc_info_user_names) do
299 <  begin
300 <    Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
301 <    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;
297 >  with Database.Attachment.GetDBInformation([isc_info_user_names]) do
298 >    if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
299 >      Items[0].DecodeUserNames(Result)
300 >  else
301 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
302   end;
303  
304   function TIBDatabaseInfo.GetFetches: Long;
# Line 339 | Line 322 | begin
322   end;
323  
324   function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
325 < var
326 <  local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
344 <  DatabaseInfoCommand: Char;
345 <  i, qtd_tables, id_table, qtd_operations: Integer;
325 > var opCounts: TDBOperationCounts;
326 >    i: integer;
327   begin
328    if FOperation = nil then FOperation := TStringList.Create;
329    result := FOperation;
330 <  DatabaseInfoCommand := Char(DBInfoCommand);
331 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
332 <                         IBHugeLocalBufferLength, local_buffer), True);
333 <  FOperation.Clear;
334 <  { 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
335 <    2. 2 bytes telling how many bytes compose the subsequent value pairs.
336 <    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;
330 >  with Database.Attachment.GetDBInformation([DBInfoCommand]) do
331 >    if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
332 >      opCounts := Items[0].getOperationCounts
333 >  else
334 >     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
335 >  for i := 0 to Length(opCounts) - 1 do
336 >    FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
337   end;
338  
339   function TIBDatabaseInfo.GetBackoutCount: TStringList;
# Line 413 | Line 382 | begin
382   end;
383  
384   function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
385 < var
386 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
387 <  length: Integer;
388 <  _DatabaseInfoCommand: Char;
389 < begin
390 <  _DatabaseInfoCommand := Char(DatabaseInfoCommand);
422 <  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);
385 > begin
386 >  with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
387 >    if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
388 >      Result := Items[0].AsInteger
389 >    else
390 >      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
391   end;
392  
393   function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
429 var
430  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
431  _DatabaseInfoCommand: Char;
394   begin
395 <  _DatabaseInfoCommand := Char(DatabaseInfoCommand);
396 <  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
397 <                         IBBigLocalBufferLength, local_buffer), True);
398 <  local_buffer[4 + Int(local_buffer[3])] := #0;
399 <  result := String(PChar(@local_buffer[4]));
395 >  with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
396 >    if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
397 >      Result := Items[0].AsString
398 >    else
399 >      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
400   end;
401  
402  
403   function TIBDatabaseInfo.GetDBSQLDialect: Integer;
404 < var
405 <  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
406 <  length: Integer;
407 <  DatabaseInfoCommand: Char;
408 < begin
409 <  DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
448 <  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;
404 > begin
405 >  with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
406 >    if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
407 >      Result := Items[0].AsInteger
408 >    else
409 >      Result := 1;
410   end;
411  
412  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines