Page 1 of 1

WMI

Posted: Wed Mar 16, 2011 12:46 am
by Droopy
Hello,

This function is compiled but crashed if called

test : MessageRequester("WMI",WMI("Select * FROM Win32_OperatingSystem,Name,CSDVersion,SerialNumber,RegisteredUser,Organization"))

Code: Select all

;{ WMI CONSTANT FUNCTIONS STRUCTURES
#VT_EMPTY = 0 
#VT_NULL = 1
#VT_I2 = 2
#VT_I4 = 3 
#VT_R4 = 4
#VT_R8 = 5
#VT_CY = 6
#VT_DATE = 7
#VT_BSTR = 8
#VT_DISPATCH = 9
#VT_ERROR = 10
#VT_BOOL = 11
#VT_VARIANT = 12
#VT_UNKNOWN = 13
#VT_DECIMAL = 14
#VT_I1 = 16 
#VT_UI1 = 17
#VT_UI2 = 18
#VT_UI4 = 19
#VT_I8 = 20
#VT_UI8 = 21
#VT_INT = 22
#VT_UINT = 23
#VT_VOID = 24
#VT_HRESULT = 25
#VT_PTR = 26
#VT_SAFEARRAY = 27
#VT_CARRAY = 28
#VT_USERDEFINED = 29
#VT_LPSTR = 30
#VT_LPWSTR = 31
#VT_RECORD = 36
#VT_INT_PTR = 37
#VT_UINT_PTR = 38 
#VT_FILETIME = 64 
#VT_BLOB = 65 
#VT_STREAM = 66 
#VT_STORAGE = 67 
#VT_STREAMED_OBJECT = 68 
#VT_STORED_OBJECT = 69 
#VT_BLOB_OBJECT = 70 
#VT_CF = 71 
#VT_CLSID = 72
#VT_VERSIONED_STREAM = 73
#VT_BSTR_BLOB = $FFF 
#VT_VECTOR = $1000 
#VT_ARRAY = $2000 
#VT_BYREF = $4000 
#VT_RESERVED = $8000 
#VT_ILLEGAL = $FFFF 
#VT_ILLEGALMASKED = $FFF 
#VT_TYPEMASK = $FFF 
#COINIT_MULTITHREAD = 0
#RPC_C_AUTHN_LEVEL_CONNECT = 2
#RPC_C_IMP_LEVEL_IDENTIFY = 2
#EOAC_NONE = 0
#RPC_C_AUTHN_WINNT = 10
#RPC_C_AUTHZ_NONE = 0
#RPC_C_AUTHN_LEVEL_CALL = 3
#RPC_C_IMP_LEVEL_IMPERSONATE = 3
#CLSCTX_INPROC_SERVER = 1
#wbemFlagReturnImmediately = 16
#wbemFlagForwardOnly = 32
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly
#WBEM_INFINITE = $FFFFFFFF
#VARIANT_FALSE = $0000 
#WMISeparator = "," 
;}

Structure BRECORD  
  pvRecord.l;
  IRecordInfo.l
EndStructure

Structure SIGNSCALE
  scale.b
  sign.b
EndStructure

Structure DECIMAL
  wReserved.w
  signscale.SIGNSCALE
  high32.l
  low64.Double
EndStructure
  
Structure pToVariant  
  a.l
  b.l
  c.l
  d.l
EndStructure

ProcedureDLL.l Ansi2Uni(string.s) ; Converts normal (Ansi) string To Unicode 
  *out = AllocateMemory(Len(string)*4) 
  MultiByteToWideChar_(#CP_ACP, 0, string, -1, *out, Len(string))  
  ProcedureReturn *out  
EndProcedure 

ProcedureDLL.s Uni2Ansi(Pointer) ; Converts Unicode to normal (Ansi) string 
  Buffer.s=Space(512)
  WideCharToMultiByte_(#CP_ACP,0,Pointer,-1,@Buffer,512,0,0)
  ProcedureReturn Buffer
EndProcedure


Procedure.s WMI(WMICommand.s) ; Interrogate WMI Database
  
  ;// MSDN : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnanchor/html/anch_wmi.asp
  
  ;- WMI Initialize
  CoInitializeEx_(0,#COINIT_MULTITHREAD)
  hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
  If hres <> 0: MessageRequester("ERROR", "unable to call CoInitializeSecurity", #MB_OK)
    CoUninitialize_()
    ProcedureReturn wmi$
  EndIf
  hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
  If hres <> 0: MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK)
    loc\release()
    CoUninitialize_()
    ProcedureReturn wmi$
  EndIf
  hres=loc\ConnectServer(Ansi2Uni("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemLocator::ConnectServer", #MB_OK)
    svc\release()
    loc\release()
    CoUninitialize_()
    ProcedureReturn wmi$
  EndIf
  hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown)
  hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK)
    svc\release()
    loc\release()
    CoUninitialize_()
    ProcedureReturn wmi$
  EndIf
  hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK)
    svc\release()
    loc\release()
    CoUninitialize_()
    ProcedureReturn wmi$
  EndIf
  pUnk\release()
  
  
  ;- CallData
  k=CountString(WMICommand,#WMISeparator)
  Dim wmitxt$(k)
  For i=0 To k
    wmitxt$(i) = Trim(StringField(WMICommand,i+1,#WMISeparator))
  Next
  
  hres=svc\ExecQuery(Ansi2Uni("WQL"),Ansi2Uni(wmitxt$(0)), #IFlags,0,@pEnumerator.IEnumWbemClassObject)
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK)
    svc\Release() 
    loc\Release() 
    pEnumerator\Release() 
    CoUninitialize_() 
    ProcedureReturn wmi$ 
  EndIf
  hres=pEnumerator\reset()
  Repeat
  hres=pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn)
  For i=1 To k
    hres=pclsObj\get(Ansi2Uni(wmitxt$(i)), 0, @x.Variant, 0, 0)
    
    Type=x\vt
    
    Select Type
        
      Case 8200
        val.s=""
        nDim=SafeArrayGetDim_(x\lVal)
        SafeArrayGetUBound_(x\lVal, nDim, @plUbound)
        ;Dim rgVar(plUbound)
        For z=0 To plUbound
          SafeArrayGetElement_(x\lVal, @z, @rgVar)
          val.s=val.s+", "+Uni2Ansi(rgVar)
        Next
        val.s=Mid(val.s, 3, Len(val.s))
        
      Case 8195
        val.s=""
        nDim=SafeArrayGetDim_(x\scode)
        SafeArrayGetUBound_(x\scode, nDim, @plUbound)
        ;Dim rgVar(plUbound)
        For z=0 To plUbound
          SafeArrayGetElement_(x\scode, @z, @rgVar)
          val.s=val.s + ", " +  Str(rgVar) 
        Next
        val.s=Mid(val.s, 3, Len(val.s))
        
      Case 11
        If x\boolVal=0
          val.s="FALSE" 
        ElseIf x\boolVal=-1
          val.s="TRUE"
        EndIf
        
      Case 8
        val.s=Uni2Ansi(x\bstrVal)
        
      Case 3
        val.s=Str(x\lVal)
        
      Case 1
        val.s="n/a"
        
      Default
        val.s=""
        
    EndSelect
    If uReturn <> 0: wmi$=wmi$+wmitxt$(i)+" = "+val+Chr(10)+Chr(13): EndIf
  Next
Until uReturn = 0

;- Cleanup
svc\release()
loc\release()
pEnumerator\release()
pclsObj\release()
CoUninitialize_()
ProcedureReturn wmi$

EndProcedure

;- Data
DataSection
  CLSID_IEnumWbemClassObject:
  ;1B1CAD8C-2DAB-11D2-B604-00104B703EFD
  Data.l $1B1CAD8C
  Data.w $2DAB, $11D2
  Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD
  IID_IEnumWbemClassObject:
  ;7C857801-7381-11CF-884D-00AA004B2E24
  Data.l $7C857801
  Data.w $7381, $11CF
  Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
  CLSID_WbemLocator:
  ;4590f811-1d3a-11d0-891f-00aa004b2e24
  Data.l $4590F811
  Data.w $1D3A, $11D0
  Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
  IID_IWbemLocator:
  ;dc12a687-737f-11cf-884d-00aa004b2e24
  Data.l $DC12A687
  Data.w $737F, $11CF
  Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
  IID_IUnknown:
  ;00000000-0000-0000-C000-000000000046
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
EndDataSection
any idea

Re: WMI

Posted: Wed Mar 16, 2011 8:46 pm
by ABBKlaus
you are exporting a string function and use it internally.

Use it this way and it works as expected :

Code: Select all

Procedure.s ipf_Uni2Ansi(Pointer) ; Converts Unicode to normal (Ansi) string 
  Buffer.s=Space(512)
  WideCharToMultiByte_(#CP_ACP,0,Pointer,-1,@Buffer,512,0,0)
  ProcedureReturn Buffer
EndProcedure

ProcedureDLL.s Uni2Ansi(Pointer) ; Converts Unicode to normal (Ansi) string 
  ProcedureReturn ipf_Uni2Ansi(Pointer)
EndProcedure
and donĀ“t forget to change line 182 to

Code: Select all

val.s=val.s+", "+ipf_Uni2Ansi(rgVar)
and line 205 to

Code: Select all

val.s=ipf_Uni2Ansi(x\bstrVal)

Re: WMI

Posted: Wed Mar 16, 2011 11:33 pm
by Droopy
Thanks to you :D .

i fix another bug in pbfastlib.

Now i can compile this function with tailbite without changing anything :wink:

Re: WMI

Posted: Thu Mar 17, 2011 1:27 am
by ts-soft
<offtopic>
ProcedureDLL.s Uni2Ansi
Is not a good name for a userlib function. Most user have some userlib or include with the same name.
</offtopic>

Re: WMI

Posted: Thu Mar 17, 2011 12:24 pm
by Droopy
Hello ts-soft

I change function name to Unicode2Ansi and Ansi2Unicode (in my next library)

Re: WMI

Posted: Thu Mar 17, 2011 12:54 pm
by ts-soft
I wouldn't export this function. Is not required to use your lib.
If somebody requires this, he can use peek and poke to do the same.