[OK]5.46 x86 MessageRequester and WMI datas
Posted: Sun Jan 28, 2018 1:12 am
Hello..
That code list severals infos from WMI and write them into a simple txt file.
It's working perfectly but if i uncomment the MessageRequester() Line 661 (at the end of the code) the informations are not here anymore..
i don't know if it's a bug or a conflict between PB and WMI function but it seems very strange.
(i steel have the problem without writing a file. even if you try to simply use a messagerequester(), the datas are not present).
Here is the code.
That code list severals infos from WMI and write them into a simple txt file.
It's working perfectly but if i uncomment the MessageRequester() Line 661 (at the end of the code) the informations are not here anymore..
i don't know if it's a bug or a conflict between PB and WMI function but it seems very strange.
(i steel have the problem without writing a file. even if you try to simply use a messagerequester(), the datas are not present).
Here is the code.
Code: Select all
; MonPC v10
; By Ar-S // PB 5.46 x86
; WMI CODE by nco2k
; Thanks to Celtic88 pour son code géant sur les WMI que j'ai décortiqué et qui m'a bien aidé
EnableExplicit
Global Path$
Global.s OS, Build, Archi, User, Comp, Bios, Workg, CMfab, CMmod, Proce, Coeur, CG, MemT, MemMod, Capture, Resultat
Global LR
Global.f MemTo
Global NewList MonPC.s()
Global.b scanOk = 0
#RPC_C_AUTHN_WINNT = 10
#RPC_C_AUTHN_LEVEL_CALL = 3
#RPC_C_AUTHN_LEVEL_PKT_PRIVACY = 6
#RPC_C_AUTHZ_NONE = 0
#RPC_C_IMP_LEVEL_IMPERSONATE = 3
#RPC_E_CHANGED_MODE = $80010106
#EOAC_NONE = 0
#CLSCTX_INPROC_SERVER = $1
#WBEM_FLAG_ALWAYS = 0
#WBEM_FLAG_RETURN_IMMEDIATELY = 16
#WBEM_FLAG_FORWARD_ONLY = 32
#WBEM_FLAG_NONSYSTEM_ONLY = 64
#WBEM_INFINITE = -1
Structure DECIMAL2
wReserved.w
scale.b
sign.b
Hi32.l
Lo64.q
EndStructure
Structure VARIANT2
vt.w
wReserved1.w
wReserved2.w
wReserved3.w
StructureUnion
llVal.q
lVal.l
bVal.b
iVal.w
fltVal.f
dblVal.d
boolVal.w
bool.w
scode.l
cyVal.q
date.d
bstrVal.i
*punkVal.IUnknown
*pdispVal.IDispatch
*parray
*pbVal.BYTE
*piVal.WORD
*plVal.LONG
*pllVal.QUAD
*pfltVal.FLOAT
*pdblVal.DOUBLE
*pboolVal.WORD
*pbool.WORD
*pscode.LONG
*pcyVal.QUAD
*pdate.DOUBLE
*pbstrVal.INTEGER
*ppunkVal.INTEGER
*ppdispVal.INTEGER
*pparray.INTEGER
*pvarVal.VARIANT2
*byref
cVal.b
uiVal.w
ulVal.l
ullVal.q
intVal.l
uintVal.l
*pdecVal.DECIMAL2
*pcVal.BYTE
*puiVal.WORD
*pulVal.LONG
*pullVal.QUAD
*pintVal.LONG
*puintVal.LONG
brecord.VARIANT_BRECORD
decVal.DECIMAL2
EndStructureUnion
EndStructure
Import "OleAut32.lib"
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
SysAllocString2_(String.p-unicode) As "_SysAllocString"
SysFreeString2_(*String) As "_SysFreeString"
CompilerElse
SysAllocString2_(String.p-unicode) As "SysAllocString"
SysFreeString2_(*String) As "SysFreeString"
CompilerEndIf
EndImport
Procedure$ WMI(WQL$)
Protected Result$, QuerySelect$, QuerySelectIndex, PropertyList$, PropertyListIndex, PropertyListSize, PropertyListElement$, *PropertyArray, PropertyArrayIndex, PropertyArrayOffset.l, PropertyArraySize.l, PropertyArrayDimensions, PropertyArrayElement$, BufferArrayIndex, BufferArrayOffset.l, BufferArraySize.l, BufferArrayDimensions, BufferArrayElement$
Protected CoInit, *SysRoot, *SysLanguage, *SysQuery, *SysArray, *SysList, ClassObjectSize, iwbemlocator.IWbemLocator, iwbemservices.IWbemServices, ienumwbemclassobject.IEnumWbemClassObject, iwbemclassobject.IWbemClassObject, variant.VARIANT2, VarByte.b, VarWord.w, VarLong.l, VarQuad.q, VarFloat.f, VarDouble.d, *VarString, *VarArray
If UCase(Left(WQL$, 7)) = "SELECT "
QuerySelectIndex = FindString(WQL$, " FROM ", 9, #PB_String_NoCase)
If QuerySelectIndex
QuerySelect$ = Trim(Mid(WQL$, 8, QuerySelectIndex - 8))
EndIf
EndIf
If QuerySelect$
CoInit = CoInitializeEx_(0, #COINIT_APARTMENTTHREADED | #COINIT_DISABLE_OLE1DDE)
If CoInit = #S_OK Or CoInit = #S_FALSE Or CoInit = #RPC_E_CHANGED_MODE
If CoInitializeSecurity_(0, -1, 0, 0, #RPC_C_AUTHN_LEVEL_PKT_PRIVACY, #RPC_C_IMP_LEVEL_IMPERSONATE, 0, #EOAC_NONE, 0) = #ERROR_SUCCESS And CoCreateInstance_(?CLSID_WbemLocator, 0, #CLSCTX_INPROC_SERVER, ?IID_IWbemLocator, @iwbemlocator) = #ERROR_SUCCESS
*SysRoot = SysAllocString2_("ROOT\CIMV2")
If *SysRoot
If iwbemlocator\ConnectServer(*SysRoot, 0, 0, 0, 0, 0, 0, @iwbemservices) = #ERROR_SUCCESS
If CoSetProxyBlanket_(iwbemservices, #RPC_C_AUTHN_WINNT, #RPC_C_AUTHZ_NONE, 0, #RPC_C_AUTHN_LEVEL_CALL, #RPC_C_IMP_LEVEL_IMPERSONATE, 0, #EOAC_NONE) = #ERROR_SUCCESS
*SysLanguage = SysAllocString2_("WQL")
If *SysLanguage
*SysQuery = SysAllocString2_(WQL$)
If *SysQuery
If iwbemservices\ExecQuery(*SysLanguage, *SysQuery, #WBEM_FLAG_FORWARD_ONLY | #WBEM_FLAG_RETURN_IMMEDIATELY, 0, @ienumwbemclassobject) = #ERROR_SUCCESS
While ienumwbemclassobject\Next(#WBEM_INFINITE, 1, @iwbemclassobject, @ClassObjectSize) = #ERROR_SUCCESS And ClassObjectSize = 1
If QuerySelect$ <> "*"
PropertyList$ = QuerySelect$+","
Else
PropertyList$ = ""
*PropertyArray = #False
If iwbemclassobject\GetNames(0, #WBEM_FLAG_ALWAYS | #WBEM_FLAG_NONSYSTEM_ONLY, 0, @*PropertyArray) = #ERROR_SUCCESS And *PropertyArray
PropertyArrayDimensions = SafeArrayGetDim_(*PropertyArray)
If PropertyArrayDimensions = 1 And SafeArrayGetLBound_(*PropertyArray, PropertyArrayDimensions, @PropertyArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*PropertyArray, PropertyArrayDimensions, @PropertyArraySize) = #ERROR_SUCCESS
For PropertyArrayIndex = PropertyArrayOffset To PropertyArraySize
If SafeArrayGetElement_(*PropertyArray, @PropertyArrayIndex, @*SysArray) = #ERROR_SUCCESS And *SysArray
PropertyArrayElement$ = PeekS(*SysArray, -1, #PB_Unicode)
If PropertyArrayElement$
PropertyList$+PropertyArrayElement$+","
EndIf
SysFreeString2_(*SysArray)
EndIf
Next
EndIf
SafeArrayDestroy_(*PropertyArray)
EndIf
EndIf
If PropertyList$
PropertyListSize = CountString(PropertyList$, ",")
For PropertyListIndex = 1 To PropertyListSize
PropertyListElement$ = Trim(StringField(PropertyList$, PropertyListIndex, ","))
If PropertyListElement$
*SysList = SysAllocString2_(PropertyListElement$)
If *SysList
If iwbemclassobject\Get(*SysList, 0, @variant, 0, 0) = #ERROR_SUCCESS
Select variant\vt
Case #VT_EMPTY, #VT_NULL, #VT_VOID, #VT_BYREF | #VT_EMPTY, #VT_BYREF | #VT_NULL, #VT_BYREF | #VT_VOID
Result$+PropertyListElement$+"="+#CRLF$
Case #VT_BOOL, #VT_BYREF | #VT_BOOL
If variant\vt & #VT_BYREF <> #VT_BYREF
VarWord = variant\boolVal
Else
VarWord = variant\pboolVal\w
EndIf
If VarWord
Result$+PropertyListElement$+"=1"+#CRLF$
Else
Result$+PropertyListElement$+"=0"+#CRLF$
EndIf
Case #VT_I1, #VT_BYREF | #VT_I1
If variant\vt & #VT_BYREF <> #VT_BYREF
VarByte = variant\cVal
Else
VarByte = variant\pcVal\b
EndIf
Result$+PropertyListElement$+"="+Str(VarByte)+#CRLF$
Case #VT_UI1, #VT_BYREF | #VT_UI1
If variant\vt & #VT_BYREF <> #VT_BYREF
VarByte = variant\bVal
Else
VarByte = variant\pbVal\b
EndIf
Result$+PropertyListElement$+"="+StrU(VarByte, #PB_Byte)+#CRLF$
Case #VT_I2, #VT_BYREF | #VT_I2
If variant\vt & #VT_BYREF <> #VT_BYREF
VarWord = variant\iVal
Else
VarWord = variant\piVal\w
EndIf
Result$+PropertyListElement$+"="+Str(VarWord)+#CRLF$
Case #VT_UI2, #VT_BYREF | #VT_UI2
If variant\vt & #VT_BYREF <> #VT_BYREF
VarWord = variant\uiVal
Else
VarWord = variant\puiVal\w
EndIf
Result$+PropertyListElement$+"="+StrU(VarWord, #PB_Word)+#CRLF$
Case #VT_I4, #VT_INT, #VT_BYREF | #VT_I4, #VT_BYREF | #VT_INT
If variant\vt & #VT_BYREF <> #VT_BYREF
VarLong = variant\lVal
Else
VarLong = variant\plVal\l
EndIf
Result$+PropertyListElement$+"="+Str(VarLong)+#CRLF$
Case #VT_UI4, #VT_UINT, #VT_ERROR, #VT_BYREF | #VT_UI4, #VT_BYREF | #VT_UINT, #VT_BYREF | #VT_ERROR
If variant\vt & #VT_BYREF <> #VT_BYREF
VarLong = variant\ulVal
Else
VarLong = variant\pulVal\l
EndIf
Result$+PropertyListElement$+"="+StrU(VarLong, #PB_Long)+#CRLF$
Case #VT_I8, #VT_CY, #VT_BYREF | #VT_I8, #VT_BYREF | #VT_CY
If variant\vt & #VT_BYREF <> #VT_BYREF
VarQuad = variant\llVal
Else
VarQuad = variant\pllVal\q
EndIf
Result$+PropertyListElement$+"="+Str(VarQuad)+#CRLF$
Case #VT_UI8, #VT_BYREF | #VT_UI8
If variant\vt & #VT_BYREF <> #VT_BYREF
VarQuad = variant\ullVal
Else
VarQuad = variant\pullVal\q
EndIf
Result$+PropertyListElement$+"="+StrU(VarQuad, #PB_Quad)+#CRLF$
Case #VT_R4, #VT_BYREF | #VT_R4
If variant\vt & #VT_BYREF <> #VT_BYREF
VarFloat = variant\fltVal
Else
VarFloat = variant\pfltVal\f
EndIf
Result$+PropertyListElement$+"="+StrF(VarFloat)+#CRLF$
Case #VT_R8, #VT_DATE, #VT_BYREF | #VT_R8, #VT_BYREF | #VT_DATE
If variant\vt & #VT_BYREF <> #VT_BYREF
VarDouble = variant\dblVal
Else
VarDouble = variant\pdblVal\d
EndIf
Result$+PropertyListElement$+"="+StrD(VarDouble)+#CRLF$
Case #VT_LPSTR, #VT_BYREF | #VT_LPSTR
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarString = variant\bstrVal
Else
*VarString = variant\pbstrVal\i
EndIf
If *VarString
Result$+PropertyListElement$+"="+PeekS(*VarString, -1, #PB_Ascii)+#CRLF$
Else
Result$+PropertyListElement$+"="+#CRLF$
EndIf
Case #VT_LPWSTR, #VT_BSTR, #VT_BYREF | #VT_LPWSTR, #VT_BYREF | #VT_BSTR
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarString = variant\bstrVal
Else
*VarString = variant\pbstrVal\i
EndIf
If *VarString
Result$+PropertyListElement$+"="+PeekS(*VarString, -1, #PB_Unicode)+#CRLF$
Else
Result$+PropertyListElement$+"="+#CRLF$
EndIf
Case #VT_ARRAY | #VT_EMPTY, #VT_ARRAY | #VT_NULL, #VT_ARRAY | #VT_VOID, #VT_BYREF | #VT_ARRAY | #VT_EMPTY, #VT_BYREF | #VT_ARRAY | #VT_NULL, #VT_BYREF | #VT_ARRAY | #VT_VOID
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
BufferArrayElement$+#US$
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_BOOL, #VT_BYREF | #VT_ARRAY | #VT_BOOL
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarWord) = #ERROR_SUCCESS
If VarWord
BufferArrayElement$+"1"+#US$
Else
BufferArrayElement$+"0"+#US$
EndIf
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_I1, #VT_BYREF | #VT_ARRAY | #VT_I1
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarByte) = #ERROR_SUCCESS
BufferArrayElement$+Str(VarByte)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_UI1, #VT_BYREF | #VT_ARRAY | #VT_UI1
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarByte) = #ERROR_SUCCESS
BufferArrayElement$+StrU(VarByte, #PB_Byte)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_I2, #VT_BYREF | #VT_ARRAY | #VT_I2
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarWord) = #ERROR_SUCCESS
BufferArrayElement$+Str(VarWord)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_UI2, #VT_BYREF | #VT_ARRAY | #VT_UI2
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarWord) = #ERROR_SUCCESS
BufferArrayElement$+StrU(VarWord, #PB_Word)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_I4, #VT_ARRAY | #VT_INT, #VT_BYREF | #VT_ARRAY | #VT_I4, #VT_BYREF | #VT_ARRAY | #VT_INT
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarLong) = #ERROR_SUCCESS
BufferArrayElement$+Str(VarLong)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_UI4, #VT_ARRAY | #VT_UINT, #VT_ARRAY | #VT_ERROR, #VT_BYREF | #VT_ARRAY | #VT_UI4, #VT_BYREF | #VT_ARRAY | #VT_UINT, #VT_BYREF | #VT_ARRAY | #VT_ERROR
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarLong) = #ERROR_SUCCESS
BufferArrayElement$+StrU(VarLong, #PB_Local)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_I8, #VT_ARRAY | #VT_CY, #VT_BYREF | #VT_ARRAY | #VT_I8, #VT_BYREF | #VT_ARRAY | #VT_CY
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarQuad) = #ERROR_SUCCESS
BufferArrayElement$+Str(VarQuad)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_UI8, #VT_BYREF | #VT_ARRAY | #VT_UI8
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarQuad) = #ERROR_SUCCESS
BufferArrayElement$+StrU(VarQuad, #PB_Quad)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_R4, #VT_BYREF | #VT_ARRAY | #VT_R4
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarFloat) = #ERROR_SUCCESS
BufferArrayElement$+StrF(VarFloat)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_R8, #VT_ARRAY | #VT_DATE, #VT_BYREF | #VT_ARRAY | #VT_R8, #VT_BYREF | #VT_ARRAY | #VT_DATE
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @VarDouble) = #ERROR_SUCCESS
BufferArrayElement$+StrD(VarDouble)+#US$
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_LPSTR, #VT_BYREF | #VT_ARRAY | #VT_LPSTR
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @*VarString) = #ERROR_SUCCESS
If *VarString
BufferArrayElement$+PeekS(*VarString, -1, #PB_Ascii)+#US$
SysFreeString2_(*VarString)
Else
BufferArrayElement$+#US$
EndIf
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
Case #VT_ARRAY | #VT_LPWSTR, #VT_ARRAY | #VT_BSTR, #VT_BYREF | #VT_ARRAY | #VT_LPWSTR, #VT_BYREF | #VT_ARRAY | #VT_BSTR
If variant\vt & #VT_BYREF <> #VT_BYREF
*VarArray = variant\parray
Else
*VarArray = variant\pparray\i
EndIf
If *VarArray
BufferArrayDimensions = SafeArrayGetDim_(*VarArray)
If BufferArrayDimensions = 1 And SafeArrayGetLBound_(*VarArray, BufferArrayDimensions, @BufferArrayOffset) = #ERROR_SUCCESS And SafeArrayGetUBound_(*VarArray, BufferArrayDimensions, @BufferArraySize) = #ERROR_SUCCESS
BufferArrayElement$ = ""
For BufferArrayIndex = BufferArrayOffset To BufferArraySize
If SafeArrayGetElement_(*VarArray, @BufferArrayIndex, @*VarString) = #ERROR_SUCCESS
If *VarString
BufferArrayElement$+PeekS(*VarString, -1, #PB_Unicode)+#US$
SysFreeString2_(*VarString)
Else
BufferArrayElement$+#US$
EndIf
EndIf
Next
Result$+PropertyListElement$+"="+BufferArrayElement$+#CRLF$
EndIf
EndIf
EndSelect
VariantClear_(variant)
EndIf
SysFreeString2_(*SysList)
EndIf
EndIf
Next
EndIf
Wend
ienumwbemclassobject\Release()
EndIf
SysFreeString2_(*SysQuery)
EndIf
SysFreeString2_(*SysLanguage)
EndIf
EndIf
iwbemservices\Release()
EndIf
SysFreeString2_(*SysRoot)
EndIf
iwbemlocator\Release()
EndIf
If CoInit <> #RPC_E_CHANGED_MODE
CoUninitialize_()
EndIf
EndIf
EndIf
ProcedureReturn Result$
DataSection
CLSID_WbemLocator:
Data.l $4590F811
Data.w $1D3A, $11D0
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
IID_IWbemLocator:
Data.l $DC12A687
Data.w $737F, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
EndDataSection
EndProcedure
; Ar-S Procedure pour simplifier l'extraction des données /////
Macro GetOS(NomCommande, Class)
WMI("SELECT "+NomCommande+" FROM " +Class)
EndMacro
Procedure.s Filtre(Titre.s,CommandeAVirer.s,ClassWMI.s)
Capture.s = GetOs(CommandeAVirer, ClassWMI)
Capture.s = RemoveString(Capture,CommandeAVirer+"=")
Resultat.s = Titre.s +" : "+ Capture
LR = Len(Resultat)
Resultat = Left(Resultat,LR-2)
ProcedureReturn Resultat
EndProcedure
; /////////////////////////////////////////////////////////////
; Ar-S Macro pour simplifier l'ajout d'un élément dans la liste MonPc()
Macro Add2List(donnee)
AddElement ( MonPc() )
MonPC() = donnee
EndMacro
; Extraction des données
OS.s = Filtre("OS","Caption","Win32_OperatingSystem")
Build.s = Filtre("Build","BuildNumber","Win32_OperatingSystem")
Archi.s = Filtre("","OSArchitecture","Win32_OperatingSystem")
User.s = "Utilisateur connecté: " + UserName()
Comp.s = "Nom de l'ordinateur : " + ComputerName()
Workg.s= Filtre("Groupe de travail","Workgroup","Win32_ComputerSystem")
CMfab.s = Filtre("Fabricant","Manufacturer","Win32_ComputerSystem")
CMmod.s = Filtre("Modèle","Model","Win32_ComputerSystem")
Proce.s = "Processeur : " +CPUName()
Coeur.s = Filtre("","NumberOfLogicalProcessors","Win32_ComputerSystem")
Bios.s = Filtre("Version","Caption","Win32_BIOS")
CG.s = Filtre("Carte Graphique","Caption","Win32_VideoController")
MemT.s = Filtre("","TotalPhysicalMemory","Win32_ComputerSystem")
MemT.s = RemoveString(MemT," : ")
MemTo.f = Round ( (Val (MemT)/1024/1024/1024), #PB_Round_Up)
MemT.s = "Quantité totale : " + Str(MemTo) + " go"
MemMod.s= Filtre("Modèle"+Chr(10),"PartNumber","Win32_PhysicalMemory")
MemMod.s= RemoveString(MemMod," : ")
; Création d'une liste pour un traitement plus aisé (et éventuellent un export txt)
Add2List("~ Système d'exploitation ~")
Add2List(OS + " " + Build + " " + "("+Archi+" )")
Add2List(User)
Add2List(Comp)
Add2List(Workg)
Add2List("")
;
Add2List("~ Carte mère ~")
Add2List(CMfab)
Add2List(CMmod)
Add2List(Proce + " " +"(" +Coeur +" coeurs )")
Add2List("")
;
Add2List("~ Bios ~")
Add2List(Bios)
Add2List("")
Add2List("~ Carte Graphique ~")
Add2List(CG)
Add2List("")
Add2List("~ Mémoire physique ~")
Add2List(MemT)
Add2List(MemMod)
;TEST
; ForEach MonPC()
; Debug MonPC()
; Next
; MessageRequester("test",TXT.s)
Path$ = GetCurrentDirectory() + "MonPC_"+ComputerName()+".txt"
Debug Path$
If CreateFile(0, Path$)
FileSeek(0, Lof(0))
ForEach MonPC()
WriteStringN(0, MonPC())
Next
CloseFile(0)
RunProgram (Path$,"","",0)
Else
; MessageRequester("Information","Impossible de créer le fichier!"+Chr(10)+"Lancez MONPC depuis un support réinscriptible.")
EndIf
End