The Road to Delphi

Delphi – Free Pascal – Oxygene

Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Part 2

1 Comment

This is the part 2 of the Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Article

One of the nice features of the Function Discovery API is the posibility of filter the results for device enumeration, for this you must use the CreateInstanceCollectionQuery method and then add the conditions for the query using the AddPropertyConstraint method.

Try this sample Delphi code which enumerates all the processors devices where the manufacturer is Intel.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Activex,
  Winapi.PropSys,
  Winapi.Functiondiscovery,
  System.SysUtils;

procedure Enumerate;
var
    LFunctionDiscovery : IFunctionDiscovery;
    LFunctionInstance  : IFunctionInstance;
    ppIFunctionInstanceCollection: IFunctionInstanceCollection;
    ppIFunctionInstanceCollectionQuery: IFunctionInstanceCollectionQuery;
    ppIPropertyStore  : IPropertyStore;
    pv : TPropVariant;
    pdwCount : DWORD;
    pszCategory: PWCHAR;
    hr : HResult;
    i : integer;
begin
  //create an instance to the  IFunctionDiscovery interface
  LFunctionDiscovery := CreateComObject(CLSID_FunctionDiscovery) as IFunctionDiscovery;
  try
    //set the provider to search
    pszCategory:=FCTN_CATEGORY_PNP;
    //get the devices collection
    hr := LFunctionDiscovery.CreateInstanceCollectionQuery(pszCategory, nil, false, nil, nil, ppIFunctionInstanceCollectionQuery);
      if Succeeded(hr)  then
      begin
       PropVariantClear(pv);
       pv.vt:=VT_LPWSTR;
       pv.pwszVal:='Intel';
       hr := ppIFunctionInstanceCollectionQuery.AddPropertyConstraint(PKEY_Device_Manufacturer, pv, QC_EQUALS);
       if not Succeeded(hr) then RaiseLastOSError;

       PropVariantClear(pv);
       pv.vt:=VT_LPWSTR;
       pv.pwszVal:='Processor';
       hr := ppIFunctionInstanceCollectionQuery.AddPropertyConstraint(PKEY_Device_Class, pv, QC_EQUALS);
       if not Succeeded(hr) then RaiseLastOSError;

        hr := ppIFunctionInstanceCollectionQuery.Execute(ppIFunctionInstanceCollection);
        if Succeeded(hr)  then
        begin
          //get the collection count
          ppIFunctionInstanceCollection.GetCount(pdwCount);
          if pdwCount=0 then
            Writeln(Format('No items was found for the %s category',[pszCategory]))
          else
          for i := 0 to pdwCount - 1 do begin
            //get the n Item of the collection
            if Succeeded(ppIFunctionInstanceCollection.Item(i, LFunctionInstance)) then
            begin
              //init the propertiess store
              LFunctionInstance.OpenPropertyStore(STGM_READ, ppIPropertyStore);
              //read the properties values
              if Succeeded(ppIPropertyStore.GetValue(PKEY_NAME, pv)) then
               Writeln(Format('Name          %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_InstanceId, pv)) then
               Writeln(Format('Instance Id   %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Driver, pv)) then
               Writeln(Format('Device Driver %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Model, pv)) then
               Writeln(Format('Model         %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Manufacturer, pv)) then
               Writeln(Format('Manufacturer  %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_LocationInfo, pv)) then
               Writeln(Format('Location      %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_Class, pv)) then
               Writeln(Format('Class        %s',[pv.pwszVal]));
              if Succeeded(ppIPropertyStore.GetValue(PKEY_Device_ClassGuid, pv)) then
               Writeln(Format('Class Guid   %s',[pv.puuid^.ToString]));
              Writeln;
            end
            else
             RaiseLastOSError;
           end;
        end;
      end
      else
       RaiseLastOSError;
  finally
    LFunctionDiscovery:=nil;
  end;
end;

begin
 try
   ReportMemoryLeaksOnShutdown:=True;
   if (Win32MajorVersion >= 6) then  // available on Vista (or later)
   begin
    if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
    try
     Enumerate;
    finally
      CoUninitialize;
    end;
   end
   else
   Writeln('Windows version not compatible');
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Author: Rodrigo

Just another Delphi guy.

One thought on “Exploring Delphi XE3 – WinApi Additions – Winapi.Functiondiscovery Part 2

  1. Doesn’t give PNP ID GUIDs; but this will

    //depending of the type of the property display the info
    case pv.vt of
    VT_BOOL : Writeln(Format(‘%-40s %s’,[KeyName , BoolToStr(pv.boolVal, True)]));
    VT_UINT : Writeln(Format(‘%-40s %d’,[KeyName ,pv.ulVal]));
    VT_INT : Writeln(Format(‘%-40s %d’,[KeyName ,pv.iVal]));
    VT_I4,
    VT_UI4 : Writeln(Format(‘%-40s %d’,[KeyName ,pv.ulVal]));
    VT_EMPTY : Writeln(Format(‘%-40s %s’,[KeyName ,'(Empty)’]));
    VT_LPWSTR : Writeln(Format(‘%-40s %s’,[KeyName ,pv.pwszVal]));
    VT_CLSID : Writeln(Format(‘%-40s %s’,[KeyName ,pv.puuid^.ToString]));
    VT_VECTOR or VT_LPWSTR :
    try
    k := 0;
    while PropVariantGetElem(pv,k,ps)=0 do
    begin
    case ps.vt of
    VT_LPWSTR : Writeln(Format(‘%-40s %s’,[KeyName ,ps.pwszVal]));
    else
    Writeln(Format(‘%-40s %s’,[KeyName ,'(Type Unk)’+IntToStr(pv.vt) ]));
    end;
    Inc(k);
    end;
    except

    end;
    else
    Writeln(Format(‘%-40s %s’,[KeyName ,'(Type Unknow)’+IntToStr(pv.vt) ]));
    end;

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s