WmiDelphiClass - RRUZ/delphi-wmi-class-generator GitHub Wiki
Source of the TWmiClass base class
Note the last version of this class can be found in the Source reporitory
{**************************************************************************************************}
{ }
{ Unit uWmiDelphiClass }
{ Base class for the classes generated by the Delphi Wmi Class generator }
{ }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
{ License at http://www.mozilla.org/MPL/ }
{ }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
{ and limitations under the License. }
{ }
{ The Original Code is uWmiDelphiClass.pas. }
{ }
{ The Initial Developer of the Original Code is Rodrigo Ruz V. }
{ Portions created by Rodrigo Ruz V. are Copyright (C) 2010 Rodrigo Ruz V. }
{ All Rights Reserved. }
{ }
{**************************************************************************************************}
unit uWmiDelphiClass;
interface
{$IFNDEF MSWINDOWS}
Sorry Only Windows
{$ENDIF}
{.$DEFINE _DEBUG}
{$DEFINE WbemScripting_TLB}
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$UNDEF WbemScripting_TLB}
{$ENDIF}
{$IFNDEF WbemScripting_TLB}
{$DEFINE WMI_LateBinding}
{$ENDIF}
uses
{$IFDEF WbemScripting_TLB}
WbemScripting_TLB,
{$ENDIF}
Classes;
{$IFDEF WMI_LateBinding}
const
SWbemScripting_SWbemLocator {$IFDEF FPC}:WideString{$ENDIF} = 'WbemScripting.SWbemLocator';
wbemImpersonationLevelAnonymous = $00000001; //Anonymous Hides the credentials of the caller.
//Calls to WMI may fail with this impersonation level.
wbemImpersonationLevelIdentify = $00000002; //Identify Allows objects to query the credentials of the caller.
//Calls to WMI may fail with this impersonation level.
wbemImpersonationLevelImpersonate = $00000003; //Impersonate Allows objects to use the credentials of the caller.
//This is the recommended impersonation level for WMI Scripting API calls.
wbemImpersonationLevelDelegate = $00000004; //Delegate Allows objects to permit other objects to use the credentials of the caller.
//This impersonation, which will work with WMI Scripting API calls but may constitute an unnecessary security risk, is supported only under Windows 2000.
wbemFlagForwardOnly = $00000020; //Causes a forward-only enumerator to be returned. Forward-only enumerators are generally much faster and use less memory than conventional enumerators, but they do not allow calls to SWbemObject.Clone_.
wbemFlagBidirectional = $00000000; //Causes WMI to retain pointers to objects of the enumeration until the client releases the enumerator.
wbemFlagReturnImmediately = $00000010; //Causes the call to return immediately.
wbemFlagReturnWhenComplete = $00000000; //Causes this call to block until the query is complete. This flag calls the method in the synchronous mode.
wbemQueryFlagPrototype = $00000002; //Used for prototyping. It stops the query from happening and returns an object that looks like a typical result object.
wbemFlagUseAmendedQualifiers = $00020000; //Causes WMI to return class amendment data with the base class definition. For more information, see Localizing WMI Class Information.
{$ENDIF}
type
TWordArray = Array of Word;
TShortIntArray = Array of ShortInt;
TByteArray = Array of Byte;
TSmallIntArray = Array of SmallInt;
TIntegerArray = Array of Integer;
TCardinalArray = Array of Cardinal;
TInt64Array = Array of Int64;
TDoubleArray = Array of Double;
TBooleanArray = Array of Boolean;
TTDateTimeArray = Array of TDateTime;
TOleVariantArray= Array of OleVariant;
TWideStringArray= Array of WideString;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The TWmiClass class represents the base class to access the WMI info.
/// </summary>
{$IFDEF UNDEF}{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}{$ENDIF}
TWmiClass=class//(TObject)
private
FStaticInstance : OleVariant;
{$IFDEF WbemScripting_TLB}
FSWbemLocator : ISWbemLocator;
FWMIService : ISWbemServices;
{$ENDIF}
{$IFDEF WMI_LateBinding}
FSWbemLocator : OleVariant;
FWMIService : OleVariant;
{$ENDIF}
{$IFDEF FPC}
FWmiServer : WideString;
FWmiUser : WideString;
FWmiPass : WideString;
FWmiNameSpace : WideString;
FWmiClass : WideString;
{$ELSE}
FWmiServer : string;
FWmiUser : string;
FWmiPass : string;
FWmiNameSpace : string;
FWmiClass : string;
{$ENDIF}
FWmiConnected : Boolean;
FWMiDataLoaded : Boolean;
FWmiIsLocal : Boolean;
FWmiPropsNames : TStrings;
procedure DisposeCollection;
{$IFDEF FPC}
procedure SetWmiServer(const Value: WideString);
procedure SetWmiUser(const Value: WideString);
procedure SetWmiPass(const Value: WideString);
{$ELSE}
procedure SetWmiServer(const Value: string);
procedure SetWmiUser(const Value: string);
procedure SetWmiPass(const Value: string);
{$ENDIF}
procedure WmiConnect;
function GetPropValue(const PropName: string): OleVariant;
protected
FWmiCollection : TList;
FWmiCollectionIndex : Integer;
function _LoadWmiData: boolean;
constructor Create(LoadData:boolean;const _WmiNamespace,_WmiClass:string); overload;
public
{$IFDEF FPC}
{$REGION 'Documentation'}
/// <summary>
/// The WmiNameSpace property return the current WMI namespace
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiNameSpace : WideString read FWmiNameSpace;
{$REGION 'Documentation'}
/// <summary>
/// The WmiClass property return the current WMI class
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiClass : WideString read FWmiClass;
{$REGION 'Documentation'}
/// <summary>
/// The WmiServer property return or set the current server name or ip where the WMi service is connected
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiServer : WideString read FWmiServer write SetWmiServer;
{$REGION 'Documentation'}
/// <summary>
/// The WmiUser property return or set the user name used to connect to the WMI service
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiUser : WideString read FWmiUser write SetWmiUser;
{$REGION 'Documentation'}
/// <summary>
/// The WmiPass property return or set the password used to connect to the WMI service
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiPass: WideString read FWmiPass write SetWmiPass;
{$ELSE}
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiNameSpace property return the current WMI namespace
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiNameSpace : string read FWmiNameSpace;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiClass property return the current WMI class
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiClass : string read FWmiClass;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiServer property return or set the current server name or ip where the WMi service is connected
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiServer : string read FWmiServer write SetWmiServer;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiUser property return or set the user name used to connect to the WMI service
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiUser : string read FWmiUser write SetWmiUser;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiPass property return or set the password used to connect to the WMI service
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiPass: string read FWmiPass write SetWmiPass;
{$ENDIF}
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiPass property return True or False if the current instance is connected to the WMI service
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiConnected : boolean read FWmiConnected;
{$IFDEF WMI_LateBinding}
property SWbemLocator : OleVariant read FSWbemLocator;
property WMIService : OleVariant read FWMIService;
function GetNullValue : OleVariant;
{$ENDIF}
{$IFDEF WbemScripting_TLB}
property SWbemLocator : ISWbemLocator read FSWbemLocator;
property WMIService : ISWbemServices read FWMIService;
function GetNullValue : IDispatch;
{$ENDIF}
property Value[const PropName : string] : OleVariant read GetPropValue; default;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiProperties property return the list of the properties of the current class
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiProperties : TStrings read FWmiPropsNames;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The WmiCollectionIndex property return the current index to the collection which store the WMI Data
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
property WmiCollectionIndex : integer read FWmiCollectionIndex write FWmiCollectionIndex;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The GetCollectionCount function return the number of items of the collection which store the WMI Data
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function GetCollectionCount:Integer;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The SetCollectionIndex procedure set the index of the collection which store the WMI Data
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
procedure SetCollectionIndex(Index: Integer);virtual;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The GetCollectionIndexByPropertyValue function get the index of the coolection based in the Property name and value
/// if the value is not found return a -1
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function GetCollectionIndexByPropertyValue(const PropertyName:string; AValue:OleVariant):integer;virtual;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The GetPropertyValue function return the value of an property
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function GetPropertyValue(const PropName: string): OleVariant;
function GetPropertyValueByIndex(const PropName: string;Index:Integer): OleVariant;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The GetInstanceOf function return an instance to the current wmi class returned by the ExecQuery method
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function GetInstanceOf: OleVariant;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The GetStaticInstance function return an instance to the current wmi class
/// is equivalent to call WMIService.Get(WmiClass,0,GetNullValue);
/// MSDN : Retrieves an object, that is either a class definition or an instance, based on the object path.
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function GetStaticInstance : OleVariant;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The LoadWmiData procedure fill the collection with the data returbes by the ExecQuery method
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
procedure LoadWmiData;
Destructor Destroy; override;
end;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarStrNull function convert a OleVariant value to an string in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarStrNull(const V:OleVariant):string;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarWideStringNull function convert a OleVariant value to an WideString in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarWideStringNull(const V:OleVariant):WideString;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarByteNull function convert a OleVariant value to a Byte value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarByteNull(const V:OleVariant):Byte;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarShortIntNull function convert a OleVariant value to a ShortInt value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarShortIntNull(const V:OleVariant):ShortInt;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarWordNull function convert a OleVariant value to a Word value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarWordNull(const V:OleVariant):Word;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarSmallIntNull function convert a OleVariant value to a SmallInt value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarSmallIntNull(const V:OleVariant):SmallInt;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarIntegerNull function convert a OleVariant value to a Integer value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarIntegerNull(const V:OleVariant):Integer;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarInt64Null function convert a OleVariant value to a Int64 value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarInt64Null(const V:OleVariant):Int64;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarLongNull function convert a OleVariant value to a Longint value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarLongNull(const V:OleVariant):Longint;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarCardinalNull function convert a OleVariant value to a Cardinal value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarCardinalNull(const V:OleVariant):Cardinal;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarBoolNull function convert a OleVariant value to a Boolean value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarBoolNull(const V:OleVariant):Boolean;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarDoubleNull function convert a OleVariant value to a Double value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarDoubleNull(const V:OleVariant):Double;
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The VarDateTimeNull function convert a OleVariant value in UTC format to a TDateTime value in a safe way to avoid problems with null values
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function VarDateTimeNull(const V : OleVariant): TDateTime; //UTC
{$IFDEF UNDEF}{$REGION 'Documentation'}{$ENDIF}
/// <summary>
/// The DateTimeToUTC function convert a TDateTime Value to the UTC format
/// </summary>
{$IFDEF UNDEF}{$ENDREGION}{$ENDIF}
function DateTimeToUTC(const DateTimeValue:TDateTime):string;
function ArrayToVarArray(Arr : Array Of string):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Word):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Integer):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Byte):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Cardinal):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Int64):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of Boolean):OleVariant; overload;
function ArrayToVarArray(Arr : Array Of OleVariant):OleVariant; overload;
procedure VarArrayToArray(Arr : OleVariant;OutArr : TStrings); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TWordArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TShortIntArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TByteArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TSmallIntArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TIntegerArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TCardinalArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TInt64Array); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TDoubleArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TBooleanArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TTDateTimeArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TOleVariantArray); overload;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TWideStringArray); overload;
implementation
uses
ComObj, Windows, Variants, Activex, SysUtils;
type
TVariantValueClass=class
Value : OleVariant;
end;
TDataWmiClass=class
PropsValues : Array of OleVariant;
//PropsValues : TStringList;
InstanceOf : TVariantValueClass;
end;
Const
MaxNumProps =256;
DefaultDoubleNullValue :Double=0.0;
//DefaultDateTimeNullValue=0;
DefaultByteNullValue :Byte=0;
DefaultShorIntNullValue :ShortInt=0;
DefaultWordNullValue :Word=0;
DefaultSmallIntNullValue:Smallint=0;
DefaultIntegerNullValue :Integer=0;
DefaultInt64NullValue :Int64=0;
DefaultLongNullValue :Longint=0;
DefaultCardinalNullValue :Cardinal=0;
DefaultBoolNullValue :Boolean=False;
procedure VarArrayToArray(Arr : OleVariant;OutArr : TStrings); overload;
var
i : integer;
begin
OutArr.Clear;
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr.Add(VarStrNull(Arr[i]));
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TWordArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarWordNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TShortIntArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1));
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarShortIntNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TByteArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarByteNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TSmallIntArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarSmallIntNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TIntegerArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarIntegerNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TCardinalArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarCardinalNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TInt64Array); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarInt64Null(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TDoubleArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarShortIntNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TBooleanArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarBoolNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TTDateTimeArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarDateTimeNull(Arr[i]);
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TOleVariantArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=Arr[i];
end;
end;
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TWideStringArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarWideStringNull(Arr[i]);
end;
end;
{
procedure VarArrayToArray(Arr : OleVariant;var OutArr : TStringArray); overload;
var
i : integer;
begin
SetLength(OutArr,0);
if not VarIsNull(Arr) and VarIsArray(Arr) then
begin
SetLength(OutArr,VarArrayHighBound(Arr, 1)+1);
for i := VarArrayLowBound(Arr, 1) to VarArrayHighBound(Arr, 1) do
OutArr[i]:=VarStrNull(Arr[i]);
end;
end;
}
function ArrayToVarArray(Arr : Array Of string):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Word):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Integer):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Byte):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Cardinal):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Int64):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of Boolean):OleVariant;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function ArrayToVarArray(Arr : Array Of OleVariant):OleVariant; overload;
var
i : integer;
begin
Result :=VarArrayCreate([0, High(Arr)], varVariant);
for i:=Low(Arr) to High(Arr) do
Result[i]:=Arr[i];
end;
function CreateInstanceDataWmiClass: TDataWmiClass;
begin
Result :=TDataWmiClass.Create;
Result.InstanceOf:=TVariantValueClass.Create;
SetLength(Result.PropsValues,MaxNumProps);
end;
procedure DisposeDataWmiClass(DataWmiClass: TDataWmiClass);
var
i : integer;
begin
for i := 0 to MaxNumProps-1 do
DataWmiClass.PropsValues[i]:=Unassigned;
SetLength(DataWmiClass.PropsValues, 0);
DataWmiClass.InstanceOf.Value:=Unassigned;
DataWmiClass.InstanceOf.Free;
DataWmiClass.Free;
end;
function VarDoubleNull(const V:OleVariant):Double;
begin
Result:=DefaultDoubleNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarStrNull(const V:OleVariant):string;
begin
Result:='';
if not VarIsNull(V) then
Result:=V;//VarToStr(V);
end;
function VarWideStringNull(const V:OleVariant):WideString;
begin
Result:='';
if not VarIsNull(V) then
Result:=V;//VarToStr(V);
end;
function VarByteNull(const V:OleVariant):Byte;
begin
Result:=DefaultByteNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarShortIntNull(const V:OleVariant):ShortInt;
begin
Result:=DefaultShorIntNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarWordNull(const V:OleVariant):Word;
begin
Result:=DefaultWordNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarSmallIntNull(const V:OleVariant):SmallInt;
begin
Result:=DefaultSmallIntNullValue;
if not VarIsNull(V) then
Result:= V;
end;
function VarIntegerNull(const V:OleVariant):Integer;
begin
Result:=DefaultIntegerNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarInt64Null(const V:OleVariant):Int64;
begin
Result:=DefaultInt64NullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarLongNull(const V:OleVariant):Longint;
begin
Result:=DefaultLongNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarCardinalNull(const V:OleVariant):Cardinal;
begin
Result:=DefaultCardinalNullValue;
if not VarIsNull(V) then
Result:=V;
end;
function VarBoolNull(const V:OleVariant):Boolean;
begin
Result:=DefaultBoolNullValue;
if not VarIsNull(V) then
Result:=V;
end;
//Universal Time (UTC) format of YYYYMMDDHHMMSS.MMMMMM(+-)OOO.
function DateTimeToUTC(const DateTimeValue:TDateTime):string;
var Year, Month, Day: Word;
var Hour, Min, Sec, MSec: Word;
begin
DecodeDate(DateTimeValue, Year, Month, Day);
DecodeTime(DateTimeValue,Hour, Min, Sec, MSec);
Result:=Format('%.4d%.2d%.2d%.2d%.2d%.2d.000000+000',[Year, Month, Day, Hour, Min, Sec]);
end;
//Universal Time (UTC) format of YYYYMMDDHHMMSS.MMMMMM(+-)OOO.
//20091231000000.000000+000
function VarDateTimeNull(const V : OleVariant): TDateTime;
var
Year, Month, Day : Word;
Hour, Min, Sec, MSec: Word;
UtcStr : string;
begin
Result:=0;
UtcStr:=VarStrNull(V);
if Length(UtcStr)>=15 then
begin
Year :=StrToInt(Copy(UtcStr,1,4));
Month :=StrToInt(Copy(UtcStr,5,2));
Day :=StrToInt(Copy(UtcStr,7,2));
Hour :=StrToInt(Copy(UtcStr,9,2));
Min :=StrToInt(Copy(UtcStr,11,2));
Sec :=StrToInt(Copy(UtcStr,13,2));
MSec :=0;
Result:=EncodeDate(Year, Month, Day)+EncodeTime(Hour, Min, Sec, MSec);
end;
end;
{
function VarDateTimeNull(const V:OleVariant):TDateTime;
begin
Result:=DefaultDateTimeNullValue;
if VarIsArray(V) and not VarIsNull(V) then
Result:= V[0]
else
if not VarIsNull(V) then
Result:=V;
end;
}
{ TWmiClass }
constructor TWmiClass.Create(LoadData:boolean;const _WmiNamespace,_WmiClass:string);
begin
inherited Create;
FWmiConnected := False;
FWmiIsLocal := True;
FWmiServer := 'localhost';
FWmiUser := '';
FWmiPass := '';
FWMiDataLoaded := False;
FWmiCollectionIndex := -1;
FWmiCollection := TList.Create;
FWmiNameSpace := _WmiNamespace;
FWmiClass := _WmiClass;
FWmiPropsNames := TStringList.Create;
if LoadData then
FWMiDataLoaded:=_LoadWmiData;
end;
destructor TWmiClass.Destroy;
begin
FWmiPropsNames.Free;
DisposeCollection;
FWmiCollection.Free;
{$IFDEF WMI_LateBinding}
FSWbemLocator:=Unassigned;
FWMIService :=Unassigned;
{$ENDIF}
inherited;
end;
{$IFDEF FPC}
function GetWMIObject(const objectName: WideString): IDispatch;
var
chEaten: PULONG;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
{$ENDIF}
//http://www.computerperformance.co.uk/Logon/code/code_80070005.htm#Local_Security_and_Policies_and_DCOM
procedure TWmiClass.WmiConnect;
begin
//if not FWmiConnected then
//begin
{$IFDEF WMI_LateBinding}
{$IFDEF FPC}
FSWbemLocator := CreateOleObject(SWbemScripting_SWbemLocator);
FWMIService := FSWbemLocator.ConnectServer(WmiServer, WmiNameSpace, WmiUser, WmiPass);
//FWMIService := GetWMIObject(Format('winmgmts:\\localhost\%s',[FWmiNameSpace]));
{$ELSE}
FSWbemLocator := CreateOleObject(SWbemScripting_SWbemLocator);
FWMIService := FSWbemLocator.ConnectServer(WmiServer, WmiNameSpace, WmiUser, WmiPass);
{$ENDIF}
if not FWmiIsLocal then
FWMIService.Security_.ImpersonationLevel := wbemImpersonationLevelImpersonate;
{$ENDIF}
{$IFDEF WbemScripting_TLB}
FSWbemLocator := CoSWbemLocator.Create;
FWMIService := FSWbemLocator.ConnectServer(WmiServer, WmiNameSpace,WmiUser, WmiPass, '', '', 0, nil);
if not FWmiIsLocal then
FWMIService.Security_.ImpersonationLevel := wbemImpersonationLevelImpersonate;
{$ENDIF}
FWmiConnected := True;
//end;
end;
function TWmiClass.GetCollectionCount: Integer;
begin
if FWMiDataLoaded then
Result:=FWmiCollection.Count
else
Result:=-1;
end;
function TWmiClass.GetCollectionIndexByPropertyValue(const PropertyName: string; AValue: OleVariant): integer;
var
i : Integer;
V : OleVariant;
begin
Result:=-1;
if FWMiDataLoaded then
for i:=0 to FWmiCollection.Count-1 do
begin
V:=GetPropertyValueByIndex(PropertyName,i);
if V=AValue then
begin
Result:=i;
VarClear(V);
Break;
end
else
VarClear(V);
end;
end;
function TWmiClass.GetInstanceOf: OleVariant;
begin
if FWMiDataLoaded then
Result:=TDataWmiClass(FWmiCollection[FWmiCollectionIndex]).InstanceOf.Value
else
raise Exception.Create('WMI Data not loaded');
end;
{$IFDEF WMI_LateBinding}
function TWmiClass.GetNullValue: OleVariant;
begin
Result:=Null;
end;
{$ENDIF}
{$IFDEF WbemScripting_TLB}
function TWmiClass.GetNullValue: IDispatch;
begin
Result:=nil;
end;
{$ENDIF}
function TWmiClass.GetPropertyValue(const PropName: string): OleVariant;
var
i : integer;
begin
i :=FWmiPropsNames.IndexOf(PropName);
Result:=TDataWmiClass(FWmiCollection[FWmiCollectionIndex]).PropsValues[i];
end;
function TWmiClass.GetPropertyValueByIndex(const PropName: string; Index: Integer): OleVariant;
var
i : integer;
begin
i :=FWmiPropsNames.IndexOf(PropName);
Result:=TDataWmiClass(FWmiCollection[Index]).PropsValues[i];
end;
function TWmiClass.GetPropValue(const PropName: string): OleVariant;
begin
Result:=GetPropertyValue(PropName);
end;
function TWmiClass.GetStaticInstance: OleVariant;
begin
Result:=FStaticInstance;
end;
//Improving Enumeration Performance http://msdn.microsoft.com/en-us/library/aa390880%28VS.85%29.aspx
function TWmiClass._LoadWmiData: boolean;
var
{$IFDEF WMI_LateBinding}
objWbemObjectSet: OLEVariant;
WmiProperties : OLEVariant;
{$ENDIF}
{$IFDEF WbemScripting_TLB}
objWbemObjectSet: ISWbemObjectSet;
SWbemObject : ISWbemObject;
WmiProperties : ISWbemPropertySet;
{$ENDIF}
oEnum : IEnumvariant;
{$IFDEF FPC}
//iValue : PULONG;
oWmiObject : Variant;
PropItem : Variant;
WQL : WideString;
sValue : WideString;
{$ELSE}
iValue : Cardinal;
PropItem : OLEVariant;
oWmiObject : OLEVariant;
{$ENDIF}
i : integer;
oEnumProps : IEnumVARIANT;
DataWmiClass : TDataWmiClass;
{$IFDEF _DEBUG}
dt : TDateTime;
dg : TDateTime;
{$ENDIF}
begin;
DisposeCollection;
result:=True;
try
{$IFDEF _DEBUG} dt:=now; {$ENDIF}
WmiConnect;
{$IFDEF _DEBUG} OutputDebugString(PAnsiChar('Connected '+FormatDateTime('hh:nn:ss.zzz', Now-dt))); {$ENDIF}
{$IFDEF _DEBUG} dt:=now; {$ENDIF}
{$IFDEF WMI_LateBinding}
{$IFDEF FPC}
WQL := Format('SELECT * FROM %s',[FWmiClass]);
objWbemObjectSet := FWMIService.ExecQuery( WQL,'WQL',0);
oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant;
{$ELSE}
objWbemObjectSet := FWMIService.ExecQuery(Format('SELECT * FROM %s',[FWmiClass]),'WQL',wbemFlagForwardOnly and wbemFlagReturnImmediately);
oEnum := IUnknown(objWbemObjectSet._NewEnum) as IEnumVariant;
{$ENDIF}
{$ENDIF}
{$IFDEF WbemScripting_TLB}
objWbemObjectSet := FWMIService.ExecQuery(Format('SELECT * FROM %s',[FWmiClass]),'WQL',wbemFlagForwardOnly and wbemFlagReturnImmediately,nil);
oEnum := (objWbemObjectSet._NewEnum) as IEnumVariant;
{$ENDIF}
{$IFDEF _DEBUG} OutputDebugString(PAnsiChar('Query Executed in '+FormatDateTime('hh:nn:ss.zzz', Now-dt))); {$ENDIF}
FStaticInstance := FWMIService.Get(FWmiClass,0,GetNullValue);
{$IFDEF _DEBUG} dg:=now; {$ENDIF}
{$IFDEF FPC}
while oEnum.Next(1, oWmiObject, nil) = S_OK do
{$ELSE}
while oEnum.Next(1, oWmiObject, iValue) = S_OK do
{$ENDIF}
begin
{$IFDEF WbemScripting_TLB}
SWbemObject := IUnknown(oWmiObject) as ISWBemObject;
WmiProperties := SWbemObject.Properties_;
{$ENDIF}
{$IFDEF WMI_LateBinding}
WmiProperties := oWmiObject.Properties_;
{$ENDIF}
if FWmiPropsNames.Count=0 then
begin
{$IFDEF WMI_LateBinding}
oEnumProps := IUnknown(WmiProperties._NewEnum) as IEnumVariant;
{$ENDIF}
{$IFDEF WbemScripting_TLB}
oEnumProps := (WmiProperties._NewEnum) as IEnumVariant;
{$ENDIF}
{$IFDEF FPC}
while oEnumProps.Next(1, PropItem, nil) = S_OK do
{$ELSE}
while oEnumProps.Next(1, PropItem, iValue) = S_OK do
{$ENDIF}
begin
FWmiPropsNames.Add(PropItem.Name);
PropItem:=Unassigned;
end;
end;
DataWmiClass:=CreateInstanceDataWmiClass;
FWmiCollection.Add(DataWmiClass);
DataWmiClass.InstanceOf.Value:=oWmiObject;
{$IFDEF _DEBUG} dt:=now; {$ENDIF}
for i := 0 to FWmiPropsNames.Count - 1 do
begin
{$IFDEF WMI_LateBinding}
{$IFDEF FPC}
sValue:=FWmiPropsNames[i];
DataWmiClass.PropsValues[i]:= WmiProperties.Item(sValue).Value;
{$ELSE}
DataWmiClass.PropsValues[i]:= WmiProperties.Item(FWmiPropsNames[i]).Value;
{$ENDIF}
{$ENDIF}
{$IFDEF WbemScripting_TLB}
DataWmiClass.PropsValues[i]:= WmiProperties.Item(FWmiPropsNames[i],0).Get_Value;
{$ENDIF}
end;
oWmiObject :=Unassigned; //avoid leak cause by IEnumVARIANT.Next
{$IFDEF _DEBUG} OutputDebugString(PAnsiChar('Pass in '+FormatDateTime('hh:nn:ss.zzz', Now-dt))); {$ENDIF}
end;
{$IFDEF _DEBUG} OutputDebugString(PAnsiChar('Assigned in '+FormatDateTime('hh:nn:ss.zzz', Now-dg))); {$ENDIF}
if FWmiCollection.Count>0 then
SetCollectionIndex(0);
except
Result:=False;
end;
end;
procedure TWmiClass.SetCollectionIndex(Index: Integer);
begin
raise Exception.Create(Format('You must override this method %s',['SetCollectionIndex']));
end;
procedure TWmiClass.DisposeCollection;
var
i : integer;
begin
if Assigned(FWmiCollection) then
begin
for i:= 0 to FWmiCollection.Count - 1 do
DisposeDataWmiClass(TDataWmiClass(FWmiCollection[i]));
FWmiCollection.Clear;
FWmiCollectionIndex :=-1;
end;
end;
{$IFDEF FPC}
procedure TWmiClass.SetWmiServer(const Value: WideString);
begin
FWmiServer := Value;
FWmiIsLocal := false;
end;
procedure TWmiClass.SetWmiUser(const Value: WideString);
begin
FWmiUser := Value;
FWmiIsLocal := false;
end;
procedure TWmiClass.SetWmiPass(const Value: WideString);
begin
FWmiPass := Value;
FWmiIsLocal := false;
end;
{$ELSE}
procedure TWmiClass.SetWmiServer(const Value: string);
begin
FWmiServer := Value;
FWmiIsLocal := false;
end;
procedure TWmiClass.SetWmiUser(const Value: string);
begin
FWmiUser := Value;
FWmiIsLocal := false;
end;
procedure TWmiClass.SetWmiPass(const Value: string);
begin
FWmiPass := Value;
FWmiIsLocal := false;
end;
{$ENDIF}
procedure TWmiClass.LoadWmiData;
begin
FWMiDataLoaded:=_LoadWmiData;
end;
initialization
{$IFNDEF FPC}
CoInitialize(nil);
{$ENDIF}
finalization
{$IFNDEF FPC}
CoUninitialize;
{$ENDIF}
end.