JojoChen's MIS Blog

花了三天時間，修改前人寫的舊版VBScript，己可以準確抓取Windows控制台新增移除程式內已安裝軟體。會修改的理由，為了避免常至使用者電腦查詢軟體，造成使用者的不便以及增進工作效率。測試Windows平台為Windows XP和Windows 7 64位元

VBScript程式如下：

Set WshShell = CreateObject( "WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Const HKCU = &H80000001 'HKEY_CURRENT_USER

strComputer = "."

'查詢電腦名稱
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objItem in colItems    
    strComputerName = objItem.CSName
Next

outputname="d:\" & strComputerName  & ".csv"

set output = oFSO.OpenTextFile(outputname,ForWriting,true,-1)

returncode=0

Set oReg1=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 
strKeyPath1 = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
oReg1.EnumKey HKCU, strKeyPath1, arrSubKeys

if err.number <> 0 then
   wscript.quit(err.number)
end if
        
For Each subkey In arrSubKeys
         displayname=""
         DisplayVersion = ""
         InstallDate = ""
         UninstallString = ""

         strKeyPath1 = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" & "\" & subkey
         strValueName = "DisplayName"
         oReg1.GetStringValue HKCU,strKeyPath1,strValueName,strValue
         DisplayName = strValue
         if ("" & strValue) <> "" then
            strValueName = "DisplayVersion"
            oReg1.GetStringValue HKCU,strKeyPath1,strValueName,strValue
            DisplayVersion = strValue   

            strValueName = "InstallDate"
            oReg1.GetStringValue HKCU,strKeyPath1,strValueName,strValue
            InstallDate = strValue    
               
            output.writeline DisplayName & ";" & DisplayVersion & ";" & InstallDate   
            appcount=appcount+1
         end if
        Next
        
        Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 
           strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
           oReg.EnumKey HKLM, strKeyPath, arrSubKeys

           if err.number <> 0 then
              wscript.quit(err.number)
           end if

        For Each subkey In arrSubKeys
            displayname=""
            DisplayVersion = ""
            InstallDate = ""
            UninstallString = ""
            
        if left(subkey,2)<>"KB" THEN

            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" & "\" & subkey
            strValueName = "DisplayName"
            oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
            DisplayName = strValue
             if ("" & strValue) <> "" then
               strValueName = "DisplayVersion"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               DisplayVersion = strValue   

               strValueName = "InstallDate"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               InstallDate = strValue

               strValueName = "UninstallString"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               UninstallString = strValue
               if not isnull(strValue) then                 
                  strValueName = "ReleaseType"
                  oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
                  ReleaseType = strValue               
                  If isnull(strValue) then  
                     strValueName = "SystemComponent"
                     oReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
                     SystemComponent = strValue
                     if isnull(strValue) or strValue=0 then
                        output.writeline DisplayName & ";" & DisplayVersion
                     end if
                  End if
               end if             
             end if
         end if
        Next

'判斷電腦cpu64位元，列出windows 7 64位元安裝軟體

Set objWMIService1 = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems1 = objWMIService1.ExecQuery("SELECT * FROM Win32_Processor")
For Each objItem1 in colItems1
    If objItem1.AddressWidth="64" then 'CPU 64位元電腦
              Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 
           strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
           oReg.EnumKey HKLM, strKeyPath, arrSubKeys

           if err.number <> 0 then
              wscript.quit(err.number)
           end if

        FOR EACH subkey IN arrSubKeys
            displayname=""
            DisplayVersion = ""
            InstallDate = ""
            UninstallString = ""

            strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" & "\" & subkey
            strValueName = "DisplayName"
            oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
            DisplayName = strValue
            IF ("" & strValue) <> "" AND left(strValue,15)<>"Security Update" and left(strValue,17)<>"Definition Update"  and  left(strValue,6)<>"Update"THEN
               strValueName = "DisplayVersion"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               DisplayVersion = strValue

               strValueName = "InstallDate"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               InstallDate = strValue

               strValueName = "UninstallString"
               oReg.GetStringValue HKLM,strKeyPath,strValueName,strValue
               UninstallString = strValue
               IF NOT isnull(strValue) THEN                 
                  strValueName = "SystemComponent"
                  oReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
                  SystemComponent = strValue               
                  IF isnull(strValue) THEN                       
                     output.writeline DisplayName & ";" & DisplayVersion
                  END IF
               END IF                    
           END IF
        NEXT            
    END IF
NEXT

if err.number<>0 then
    returncode=err.number
    wscript.quit(returncode)
end if    

output.close

' cleanup
set oFSO=nothing
set Wshshell=nothing

wscript.quit(returncode)