Option Explicit Dim strComputer Dim ListeMachines, TableauListeMachines Dim CheminScriptActuel, CheminFichierResultat, ScriptFileName, Position, objFSO, objFichierResultat Dim strKey, strEntry1a, strEntry1b, strEntry6, strEntry2, strEntry3, strEntry4, strEntry5 Dim objReg, arrSubkeys, strSubkey, strValue1, strValue2, strValue3, strValue4, strValue5, strValue6, intValue1, intValue2, intValue3, intValue4, intValue5 Dim Result Dim intRet1 Dim WSHShell, vCOMPUTERNAME Set WSHShell = CreateObject("WScript.Shell") vCOMPUTERNAME = WSHShell.ExpandEnvironmentStrings("%COMPUTERNAME%") ListeMachines = InputBox("Nom de la machine à traiter. Vous pouvez en entrer plusieurs séparées par ;","Nom machine",vCOMPUTERNAME) 'ListeMachines = "." 'Nom de la machine à examiner 'ListeMachines = "NomMachine1;NomMachine2" 'Nom de la machine à examiner ScriptFileName = wscript.scriptname Position = InstrRev(ScriptFileName,".") if (Position > 0) Then ScriptFileName = Left(ScriptFileName, Position - 1) CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1) CheminFichierResultat = CheminScriptActuel & "\" & ScriptFileName & "_Resultat.txt" Const ForReading = 1 Const ForWritting = 2 Const ForAppending = 8 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE strComputer = "." strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" strEntry1a = "DisplayName" strEntry1b = "QuietDisplayName" strEntry6 = "DisplayVersion" strEntry2 = "InstallDate" strEntry3 = "VersionMajor" strEntry4 = "VersionMinor" strEntry5 = "EstimatedSize" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFichierResultat = objFSO.OpenTextFile(CheminFichierResultat, ForWritting, True) TableauListeMachines = Split(ListeMachines, ";") objFichierResultat.WriteLine("ServerName" & VbTab & "Display Name" & VbTab & "Display Version" & VbTab & "Install Date" & VbTab & "VersionMajor" & VbTab & "Version Minor" & VbTab & "Estimated Size") For Each strComputer in TableauListeMachines Err.Clear On Error Resume Next Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv") If Err.Number = 0 Then objReg.EnumKey HKLM, strKey, arrSubkeys For Each strSubkey In arrSubkeys Result = "" intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, strEntry1a, strValue1) If intRet1 <> 0 Then objReg.GetStringValue HKLM, strKey & strSubkey, strEntry1b, strValue1 End If If strValue1 <> "" Then 'WScript.Echo VbCrLf & "Display Name: " & strValue1 Result = strComputer Result = Result & VbTab & strValue1 objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry6, strValue6 Result = Result & VbTab & strValue6 objReg.GetStringValue HKLM, strKey & strSubkey, strEntry2, strValue2 Result = Result & VbTab & strValue2 objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry3, intValue3 objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry4, intValue4 Result = Result & VbTab & intValue3 & VbTab & intValue4 objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry5, intValue5 If intValue5 <> "" Then Result = Result & VbTab & Round(intValue5/1024, 3) & " megabytes" Else Result = Result & VbTab & "" End If objFichierResultat.WriteLine(Result) End If Next strKey = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\" objReg.EnumKey HKLM, strKey, arrSubkeys For Each strSubkey In arrSubkeys Result = "" intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, strEntry1a, strValue1) If intRet1 <> 0 Then objReg.GetStringValue HKLM, strKey & strSubkey, strEntry1b, strValue1 End If If strValue1 <> "" Then 'WScript.Echo VbCrLf & "Display Name: " & strValue1 Result = strComputer Result = Result & VbTab & strValue1 objReg.GetStringValue HKLM, strKey & strSubkey, strEntry6, strValue6 Result = Result & VbTab & strValue6 objReg.GetStringValue HKLM, strKey & strSubkey, strEntry2, strValue2 Result = Result & VbTab & strValue2 objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry3, intValue3 objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry4, intValue4 Result = Result & VbTab & intValue3 & VbTab & intValue4 objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry5, intValue5 If intValue5 <> "" Then Result = Result & VbTab & Round(intValue5/1024, 3) & " megabytes" Else Result = Result & VbTab & "" End If objFichierResultat.WriteLine(Result) End If Next Set objReg = Nothing Else Wscript.Echo "Problème pour se connecter à " & strComputer End If Next objFichierResultat.Close 'Fermeture du fichier Set objFichierResultat = Nothing Set objFSO = Nothing Wscript.Echo "Termine"