It is currently Fri Dec 06, 2019 8:42 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 6 posts ] 
Author Message
 Post subject: WMI
PostPosted: Wed Mar 16, 2011 12:46 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Sep 16, 2004 9:50 pm
Posts: 658
Location: France
Hello,

This function is compiled but crashed if called

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

Code:
;{ 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

_________________
DroopyLib/PBFastLib/HMod


Top
 Profile  
Reply with quote  
 Post subject: Re: WMI
PostPosted: Wed Mar 16, 2011 8:46 pm 
Offline
Addict
Addict

Joined: Sat Apr 10, 2004 1:20 pm
Posts: 1143
Location: Germany
you are exporting a string function and use it internally.

Use it this way and it works as expected :
Code:
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:
val.s=val.s+", "+ipf_Uni2Ansi(rgVar)

and line 205 to
Code:
val.s=ipf_Uni2Ansi(x\bstrVal)


Top
 Profile  
Reply with quote  
 Post subject: Re: WMI
PostPosted: Wed Mar 16, 2011 11:33 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Sep 16, 2004 9:50 pm
Posts: 658
Location: France
Thanks to you :D .

i fix another bug in pbfastlib.

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

_________________
DroopyLib/PBFastLib/HMod


Top
 Profile  
Reply with quote  
 Post subject: Re: WMI
PostPosted: Thu Mar 17, 2011 1:27 am 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
<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>

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: WMI
PostPosted: Thu Mar 17, 2011 12:24 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Sep 16, 2004 9:50 pm
Posts: 658
Location: France
Hello ts-soft

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

_________________
DroopyLib/PBFastLib/HMod


Top
 Profile  
Reply with quote  
 Post subject: Re: WMI
PostPosted: Thu Mar 17, 2011 12:54 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
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.

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye