'************************************************* 
' Script : Check Computer Application List  
'Last Mondify:By Alin(slin0511@163.com)
'*************************************************

On Error Resume Next       

Const HKLM         = &H80000002   
Const strKeyPath   = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
Const ForReading   = 1   
Const ForAppending = 8  
  
'*****************************************************************
'Please change the path of the file where you want to save it!!!!
'*****************************************************************
Const FilePath     ="\\publicserver\public\exchange"
Set Wshell         = CreateObject("Wscript.Shell")   
Set objFSO         = CreateObject("Scripting.FileSystemobject")   

'*****************************************************************
'Get the computer name!!!!
'*****************************************************************
Dim WshNetwork
Set WshNetwork = WScript.CreateObject("WScript.Network")
strComputer = WshNetwork.ComputerName  

'*****************************************************************
'Delete the txt file if it is exist !!!!
'*****************************************************************
Set MyFile = objFSO.GetFile(FilePath & WshNetwork.ComputerName &".txt")
MyFile.Delete

'*****************************************************************
'Create the txt file and write the application list to the file !!!!
'*****************************************************************
Set textWriteFile  = objFSO.OpenTextFile(FilePath & WshNetwork.ComputerName &".txt",forappending,True)

Do      

Set objReg  = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")   
objReg.EnumKey HKLM, strKeyPath,arrSubKeys    

  For Each strSubKey In arrSubKeys        
    intRet = objReg.GetStringValue(HKLM, strKeyPath & strSubKey,"DisplayName",strValue)                               

        If strValue <> "" And intRet = 0 And inStr(1,strValue,"windows",1)<=0 Then 
                CScript.Echo strComputer & "    " & strValue
                textWriteFile.WriteLine(strComputer & "    " & strValue)
             End If                  

        
         If strValue <> "" And intRet = 0 And inStr(1,strValue,"Java",1) >0 Then

                CScript.Echo strComputer & "    " & strValue
                 textWriteFile.WriteLine(strComputer & "    " & strValue)
             End If                  

 Next

Loop Until objFile.AtEndOfStream       
textWriteFile.Close   
objFile.Close
复制代码