mitec_wmi.pas

MiTeC.System.Information.v10.7.0.FS 检测系统硬件信息的DELPHI控件

{*******************************************************}
{        MiTeC System Information Component Suite       }
{                  WMI routines                         }
{                 version 10.7.0                        }
{            for Delphi 5,6,7,2005,2006                 }
{                                                       }
{       Copyright © 1997-2007 Michal Mutl               }
{                                                       }
{*******************************************************}

{$INCLUDE MITEC_DEF.Inc}

unit MiTeC_WMI;

interface

uses MiTeC_WbemScripting_TLB, Windows, Messages, SysUtils,
{$IFDEF D6PLUS} Variants, {$ENDIF} Classes;

const
  RootNameSpace = 'root\CIMV2';
  ArrayDelimiter = '|';

type
  TInstanceProperty = record
    Name,
    Value: string;
  end;

  TInstanceProperties = array of TInstanceProperty;

  TInstances = array of TInstanceProperties;

function GetInstancePropertyValue(AList: TInstances; APropertyName: string; AInstanceIndex: Cardinal = 0; AArrayIndex: Cardinal = 0): string;
function WmiGetPropStr(wmiProp: ISWbemProperty): string;
function WmiGetTypeStr(wmiProp: ISWbemProperty): string;
function WmiConnect(AMachine, AUser, APwd, ARoot: string): Boolean;
procedure WmiDisconnect;
function WmiCommand(AQuery: string; var AList: TInstances): Integer;
procedure WmiSaveToStorage(AFolderName, AFilename: string; AWMI: TInstances);

implementation

uses ActiveX, ComObj, MiTeC_SS, MiTeC_StrUtils;

var
  wmiLocator: TSWbemLocator;
  wmiServices: ISWbemServices;

function GetInstancePropertyValue;
var
  i: Integer;
begin
  Result:='';
  if not Assigned(AList) then
    Exit;
  try
    for i:=0 to High(AList[AInstanceIndex]) do
      if SameText(APropertyName,AList[AInstanceIndex][i].Name) then begin
        Result:=AList[AInstanceIndex][i].Value;
        if Pos(ArrayDelimiter,Result)>0 then
          Result:=ExtractWord(AArrayIndex+1,Result,[ArrayDelimiter]);
        Result:=Trim(Result);
        Break;
      end;
  except
  end;
end;

function WmiGetTypeStr(wmiProp: ISWbemProperty): string;
begin
  Result:='<unknown>';
  case wmiProp.CIMType of
    wbemCimtypeSint8: Result:='sint8';
    wbemCimtypeUint8: Result:='uint8';
    wbemCimtypeSint16: Result:='sint16';
    wbemCimtypeUint16: Result:='uint16';
    wbemCimtypeSint32: Result:='sint32';
    wbemCimtypeUint32: Result:='uint32';
    wbemCimtypeSint64: Result:='sint64';
    wbemCimtypeReal32: Result:='real32';
    wbemCimtypeReal64: Result:='real64';
    wbemCimtypeBoolean: Result:='boolean';
    wbemCimtypeString: Result:='string';
    wbemCimtypeUint64: Result:='uint64';
    wbemCimtypeDatetime: Result:='datetime';
    wbemCimtypeReference: Result:='reference';
    wbemCimtypeChar16: Result:='char16';
    wbemCimtypeObject: Result:='object';
  end;
  if wmiProp.IsArray then
    Result:='array of '+Result;
end;

function WmiGetPropStr(wmiProp: ISWbemProperty): string;
var
  i: integer;
begin
  Result:='';
  if VarIsNull(wmiProp.Get_Value) then
    Result:='NULL'
  else begin
    case wmiProp.CIMType of
      wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeSint16,
      wbemCimtypeUint16, wbemCimtypeSint32, wbemCimtypeUint32,
      wbemCimtypeSint64:
        if VarIsArray(wmiProp.Get_Value) then begin
          for i:=0 to VarArrayHighBound(wmiProp.Get_Value, 1) do begin
            if i>0 then
              Result:=Result+';' ;
            Result:=Result+IntToStr(wmiProp.Get_Value[i]) ;
          end ;
        end else
          Result:=IntToStr(wmiProp.Get_Value);
      wbemCimtypeReal32, wbemCimtypeReal64:
        Result:=FloatToStr(wmiProp.Get_Value);
      wbemCimtypeBoolean:
        if wmiProp.Get_Value then
          Result:='True'
        else
          Result:='False';
      wbemCimtypeString, wbemCimtypeUint64:
        if VarIsArray(wmiProp.Get_Value) then begin
          for i:=0 to VarArrayHighBound(wmiProp.Get_Value,1) do begin
            if i>0 then
              Result:=Result+ArrayDelimiter;
            Result:=Result+wmiProp.Get_Value[i];
          end;
          SetLength(Result,Length(Result)-1);
        end else
          Result:=wmiProp.Get_Value;
      wbemCimtypeDatetime:
        Result:=wmiProp.Get_Value;
      wbemCimtypeReference:
        Result:=wmiProp.Get_Value;
      wbemCimtypeChar16:
        Result:='<16-bit character>';
      wbemCimtypeObject:
        Result:='<CIM Object>';
    end;
  end;
end;

function WMIConnect;
begin
  Result:=False;
  try
    wmiLocator:=TSWbemLocator.Create(nil);
    if CoInitialize(nil) in [S_OK, S_FALSE] then begin
      wmiServices:=wmiLocator.ConnectServer(Amachine,ARoot,AUser,APwd,'','',0,nil);
      Result:=True;
    end;
  except
  end;
end;

function WmiCommand;
var
  i,j: Integer;
  wmiObjectSet: ISWbemObjectSet;
  wmiObject: ISWbemObject;
  wmiProp: ISWbemProperty;
  propSet: ISWbemPropertySet;
  v: OleVariant;
  n: LongWord;
  propEnum,Enum: IEnumVariant;
begin
  Result:=-1;
  Finalize(AList);
  if not Assigned(wmiServices) then
    Exit;
  try
    if Pos('SELECT',Uppercase(AQuery))=1 then
      wmiObjectSet:=wmiServices.ExecQuery(AQuery,'WQL',wbemFlagReturnImmediately,nil)
    else
      wmiObjectSet:=wmiServices.InstancesOf(AQuery,wbemFlagReturnImmediately or wbemQueryFlagShallow,nil);
    Result:=wmiObjectSet.Count;
    if Result=0 then
      Exit;
    SetLength(AList,Result);
    Enum:=(wmiObjectSet._NewEnum) as IEnumVariant;
    i:=0;
    while (Enum.Next(1,v,n)=S_OK) do begin
      wmiObject:=IUnknown(v) as SWBemObject;
      propSet:=wmiObject.Properties_;
      Setlength(AList[i],propSet.Count);
      propEnum:=(propSet._NewEnum) as IEnumVariant;
      j:=0;
      while (propEnum.Next(1,v,n)=S_OK) do begin
        wmiProp:=IUnknown(v) as SWBemProperty;
        AList[i][j].Name:=wmiProp.Name;
        Alist[i][j].Value:=WmiGetPropStr(wmiProp);
        Inc(j);
      end;
      Inc(i);
    end;
  except

  end;
end;

procedure WMIDisconnect;
begin
  try
    wmiServices:=nil;
    wmiLocator.Free;
    //CoUninitialize;
  except
  end;
end;

procedure WmiSaveToStorage;
var
  stg: IStorage;
  SS, Sub: TStructuredStorage;

procedure WriteToPS(AIndex: Cardinal);
var
  S: TStructuredStorage;
  SPS: TStoragePropertySet;
  i: integer;
begin
  S:=Sub.OpenSubStorage(IntToStr(AIndex),STG_OPEN,True);
  SPS:=S.OpenPropertySet(StringToGUID(FMTID_DocSummaryInformation),STG_OPEN,True);
  try
    for i:=0 to High(AWMI[AIndex]) do
      WritestringProperty(SPS._IPropertyStorage,AWMI[AIndex][i].Name,AWMI[AIndex][i].Value);
  finally
    SPS.Free;
    S.Free;
  end;
end;

var
  i: Integer;
begin
  if StgIsStorageFile(PWideChar(WideString(AFileName)))<>S_OK then
    OleCheck(StgCreateDocFile(PWideChar(WideString(AFileName)),STG_CREATE_OPEN,0,stg))
  else
    OleCheck(StgOpenStorage(PWideChar(WideString(AFileName)),nil,STG_OPEN,nil,LongInt(nil),stg));
  SS:=TStructuredStorage.Create(nil,stg);
  try
    SS.FStorage.DestroyElement(PWideChar(WideString(AFolderName)));
    Sub:=SS.OpenSubStorage(AFolderName,STG_OPEN,True);
    try
      for i:=0 to High(AWMI) do begin
        WriteToPS(i);
      end;
    finally
      Sub.Free;
    end;
  finally
    SS.Free;
  end;
end;

end.