Search code examples
winapiwmifreepascallazarus

Windows: Calling a WMI function using FreePascal -- Working example?


I am looking for sample code on how to call a WMI function. Does anyone has a working example in FreePascal, ideally including code on how to pass parameters to the function? Unfortunately, the "Delphi WMI code Creator" does not help me as the FreePascal code for creating a function does not work.

Just to be clear: This is not about querying WMI properties, but calling a function like Win32_Printer.AddPrinterConnection (just to name an example).


Solution

  • I found a piece of Delphi code that set up many of the standard objects in the same way as Drake Wu's C++ example did.

    I was interested in that example because I'm interested in edids, so I fully translated said C++ article's solution to Delphi/FPC. It seems to work.

    program wmiedidint2;
    // based on https://theroadtodelphi.com/2011/04/21/accesing-the-wmi-from-delphi-and-fpc-via-com-without-late-binding-or-wbemscripting_tlb/
    // modified to function as https://learn.microsoft.com/en-us/answers/questions/95631/wmi-c-application-problem-wmimonitordescriptormeth.html?childToView=96407#answer-96407
    {$IFDEF FPC}
     {$MODE DELPHI} {$H+}
    {$ENDIF}
    
    {$APPTYPE CONSOLE}
    
    uses
      Windows,
      Variants,
      SysUtils,
      ActiveX,
      JwaWbemCli;
    
    const
      RPC_C_AUTHN_LEVEL_DEFAULT = 0;
      RPC_C_IMP_LEVEL_IMPERSONATE = 3;
      RPC_C_AUTHN_WINNT = 10;
      RPC_C_AUTHZ_NONE = 0;
      RPC_C_AUTHN_LEVEL_CALL = 3;
      EOAC_NONE = 0;
    
    
    function GetBytesFromVariant(const V: Variant): TBytes;
    // this function is a mess and only works for bytes. From SO
    var
      Len: Integer;
      SafeArray: PVarArray;
    begin
      Len := 1+VarArrayHighBound(v, 1)-VarArrayLowBound(v, 1);
      SetLength(Result, Len);
      SafeArray := VarArrayAsPSafeArray(V);
      Move(SafeArray.Data^, Pointer(Result)^, Length(result)*SizeOf(result[0]));
    end;
    
    procedure Test_IWbemServices_ExecQuery;
    const
      strLocale    = '';
      strUser      = '';
      strPassword  = '';
      strNetworkResource = 'root\WMI';
      strAuthority       = '';
      WQL                = 'SELECT * FROM WmiMonitorDescriptorMethods';
      EDIDMethodname      = 'WmiGetMonitorRawEEdidV1Block';
      EDIDClassName       = 'WmiMonitorDescriptorMethods';
    
    var
      FWbemLocator         : IWbemLocator;
      FWbemServices        : IWbemServices;
      FUnsecuredApartment  : IUnsecuredApartment;
      ppEnum               : IEnumWbemClassObject;
      apObjects            : IWbemClassObject;
      puReturned           : ULONG;
      pVal                 : OleVariant;
      pType                : Integer;
      plFlavor             : Integer;
      Succeed              : HRESULT;
      varreturnvalue       : olevariant;
      varotherval          : longint;
      varcmd2 : tagVariant;
      varcommand           : olevariant; // tagVARIANT;
    
      pOutParamsDefinition,
      pInParamsDefinition,
      pClass,
      pClassInstance       : IWbemClassObject;
      callres              : IWbemCallResult;
      err : IErrorInfo;
      aname,w2 : Widestring;
      bytes : TBytes;
      i : integer;
    
    procedure teststatus(const msg:string);
    begin
      if Succeeded(succeed) then
        writeln('Successs:',msg)
      else
        writeln('Fail:',msg)
    end;
    
    begin
      // Set general COM security levels --------------------------
      // Note: If you are using Windows 2000, you need to specify -
      // the default authentication credentials for a user by using
      // a SOLE_AUTHENTICATION_LIST structure in the pAuthList ----
      // parameter of CoInitializeSecurity ------------------------
      if Failed(CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil)) then Exit;
      // Obtain the initial locator to WMI -------------------------
      if Succeeded(CoCreateInstance(CLSID_WbemLocator, nil, CLSCTX_INPROC_SERVER, IID_IWbemLocator, FWbemLocator)) then
      try
        // Connect to WMI through the IWbemLocator::ConnectServer method
        if Succeeded(FWbemLocator.ConnectServer(strNetworkResource, strUser, strPassword, strLocale,  WBEM_FLAG_CONNECT_USE_MAX_WAIT, strAuthority, nil, FWbemServices)) then
        try
          // Set security levels on the proxy -------------------------
          if Failed(CoSetProxyBlanket(FWbemServices, RPC_C_AUTHN_WINNT, RPC_C_AUTHZ_NONE, nil, RPC_C_AUTHN_LEVEL_CALL, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE)) then Exit;
          if Succeeded(CoCreateInstance(CLSID_UnsecuredApartment, nil, CLSCTX_LOCAL_SERVER, IID_IUnsecuredApartment, FUnsecuredApartment)) then
          try
            // Use the IWbemServices pointer to make requests of WMI
            //Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY OR WBEM_FLAG_RETURN_IMMEDIATELY, nil, ppEnum);
            Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY, nil, ppEnum);
            if Succeeded(Succeed) then
            begin
              Writeln('Running Wmi Query..Press Enter to exit');
               // Get the data from the query
               while (ppEnum.Next(WBEM_INFINITE, 1, apObjects, puReturned)=0) do
               begin
                 succeed:= apObjects.Get('__PATH', 0, pVal, pType, plFlavor);
                 teststatus('get __PATH');
                 aname:=pval;
                 writeln('__PATH: ',aname);
    
    
                 succeed:=fwbemservices.GetObject(edidclassname,0,nil,pClass,callres);
                 teststatus('getobject');
                 succeed:=pClass.GetMethod(EDIDMethodname,0,pInParamsDefinition,pOutParamsDefinition);
                 teststatus('getmethod');
                 succeed:=pInParamsDefinition.SpawnInstance(0, pClassInstance);
                 teststatus('Spawn');
    
                 fillchar(varcmd2,sizeof(varcommand),#0);
                 varcmd2.vt:=VT_UI1;
                 varcmd2.bval:=0;
                 move(varcmd2,varcommand,sizeof(varcmd2));
    
                 succeed:= pClassInstance.Put('BlockId',0,@VarCommand,0);
                 teststatus('put blockid');
                 writeln('The BlockId is: ,',varCommand);
                 pOutParamsDefinition:=Nil;
                 callres:=nil;
    
                 w2:=EDIDMethodname;
                 succeed:= fwbemservices.ExecMethod(aname,w2,0,nil,pClassInstance,pOutParamsDefinition,callres);
                 if succeeded(succeed) then
                    begin
                      writeln('execute success!');
                    end;
                 succeed:= pOutParamsDefinition.Get('BlockType', 0, varreturnvalue,ptype,plFlavor);
                 if succeeded(succeed)  then
                   begin
                     writeln('blocktype:',varreturnvalue);
                     varotherval:=varreturnvalue;
                     if varotherval=1 then
                       begin
                         succeed:= pOutParamsDefinition.Get('BlockContent', 0, varreturnvalue,ptype,plFlavor);
                         if succeeded(succeed) then
                         begin
                         bytes:=GetBytesFromVariant(varreturnvalue);
                         write('bytes:');
                         for i:=0 to length(bytes)-1 do
                           begin
                             write('$',inttohex(bytes[i],2),' ');
                           end;
                         writeln;
                         end;
    
                       end;
                   end;
               end;
            end
            else
            Writeln(Format('Error executing WQL sentence %x',[Succeed]));
          finally
            FUnsecuredApartment := nil;
          end;
        finally
          FWbemServices := nil;
        end;
      finally
        FWbemLocator := nil;
      end;
    end;
    
    begin
      // Initialize COM. ------------------------------------------
      if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
      try
        Test_IWbemServices_ExecQuery;
      finally
        CoUninitialize();
      end;
      Readln;
    end.
    

    Note that the original (roadtodelphi) page also demonstrates event sinks