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 142 by tony, Mon Jan 22 13:58:14 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 25 | Line 25
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                                                 }
28 > {    Associates Ltd 2011 - 2018                                               }
29   {                                                                        }
30   {************************************************************************}
31  
# Line 43 | Line 43 | type
43    { TIBDatabaseInfo }
44  
45    TIBDatabaseInfo = class(TComponent)
46 +  private
47 +    function GetDateDBCreated: TDateTime;
48 +    function GetEncrypted: boolean;
49 +    function GetEncryptionKeyName: string;
50 +    function GetPagesFree: Long;
51 +    function GetPagesUsed: Long;
52 +    function GetTransactionCount: Long;
53    protected
54      FDatabase: TIBDatabase;
55      FUserNames   : TStringList;
# Line 92 | Line 99 | type
99      constructor Create(AOwner: TComponent); override;
100      destructor Destroy; override;
101      function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
102 +    function GetDatabasePage(PageNo: integer): string;
103      property Allocation: Long read GetAllocation;
104      property BaseLevel: Long read GetBaseLevel;
105 +    property DateDBCreated: TDateTime read GetDateDBCreated;
106      property DBFileName: String read GetDBFileName;
107      property DBSiteName: String read GetDBSiteName;
108      property DBImplementationNo: Long read GetDBImplementationNo;
109      property DBImplementationClass: Long read GetDBImplementationClass;
110 +    property Encrypted: boolean read GetEncrypted;
111 +    property EncryptionKeyName: string read GetEncryptionKeyName;
112      property NoReserve: Long read GetNoReserve;
113      property ODSMinorVersion: Long read GetODSMinorVersion;
114      property ODSMajorVersion: Long read GetODSMajorVersion;
# Line 113 | Line 124 | type
124      property Marks: Long read GetMarks;
125      property Reads: Long read GetReads;
126      property Writes: Long read GetWrites;
127 +    property TransactionCount: Long read GetTransactionCount;
128      property BackoutCount: TStringList read GetBackoutCount;
129      property DeleteCount: TStringList read GetDeleteCount;
130      property ExpungeCount: TStringList read GetExpungeCount;
# Line 122 | Line 134 | type
134      property ReadSeqCount: TStringList read GetReadSeqCount;
135      property UpdateCount: TStringList read GetUpdateCount;
136      property DBSQLDialect : Long read GetDBSQLDialect;
137 +    property PagesUsed: Long read GetPagesUsed;
138 +    property PagesFree: Long read GetPagesFree;
139      property ReadOnly: Long read GetReadOnly;
140    published
141      property Database: TIBDatabase read FDatabase write FDatabase;
# Line 162 | Line 176 | begin
176    inherited Destroy;
177   end;
178  
179 + function TIBDatabaseInfo.GetDateDBCreated: TDateTime;
180 + begin
181 +  CheckDatabase;
182 +  with Database.Attachment.GetDBInformation([isc_info_creation_date]) do
183 +    if (Count > 0) and (Items[0].GetItemType = isc_info_creation_date) then
184 +      Result := Items[0].GetAsDateTime
185 +    else
186 +      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
187 + end;
188 +
189 + function TIBDatabaseInfo.GetEncrypted: boolean;
190 + var ConnFlags: Long;
191 + begin
192 +  Result := ODSMajorVersion >= 12;
193 +  if Result then
194 +  try
195 +    ConnFlags := GetLongDatabaseInfo(fb_info_conn_flags);
196 +    Result := (ConnFlags and fb_info_crypt_encrypted) <> 0;
197 +  except
198 +    Result := false; {Introduced in Firebird 3.0.3}
199 +  end;
200 + end;
201 +
202 + function TIBDatabaseInfo.GetEncryptionKeyName: string;
203 + begin
204 +  CheckDatabase;
205 +  {Introduced in Firebird 3.0.3}
206 +  with Database.Attachment.GetDBInformation([fb_info_crypt_key]) do
207 +    if (Count > 0) and (Items[0].GetItemType = fb_info_crypt_key) then
208 +      Result := Items[0].AsString
209 +    else
210 +     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
211 + end;
212 +
213 + function TIBDatabaseInfo.GetPagesFree: Long;
214 + begin
215 +  result := GetLongDatabaseInfo(fb_info_pages_used);
216 + end;
217 +
218 + function TIBDatabaseInfo.GetPagesUsed: Long;
219 + begin
220 +  result := GetLongDatabaseInfo(fb_info_pages_free);
221 + end;
222 +
223 + function TIBDatabaseInfo.GetTransactionCount: Long;
224 + begin
225 +  result := GetLongDatabaseInfo(isc_info_active_tran_count);
226 + end;
227 +
228   procedure TIBDatabaseInfo.CheckDatabase;
229   begin
230    if Database = nil then
# Line 404 | Line 467 | begin
467      else
468        IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
469   end;
470 +
471 + function TIBDatabaseInfo.GetDatabasePage(PageNo: integer): string;
472 + var DBRequest: IDIRB;
473 + begin
474 +  DBRequest := Database.Attachment.AllocateDIRB;
475 +  DBRequest.Add(fb_info_page_contents).AsInteger := PageNo;
476 +  with Database.Attachment.GetDBInformation(DBRequest) do
477 +    if (Count > 0) and (Items[0].GetItemType = fb_info_page_contents) then
478 +      Result := Items[0].AsString
479 +    else
480 +      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
481 + end;
482  
483   function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
484   begin

Diff Legend

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