本次文章其中所用脚本代码为ghiconan版主提供的由Branimir petrovic编写的代码，我在后面根据我公司现有的网络情况做了一些文件管理的添加与删除，最后有用ＦＴＰ批处理的方法上传到服务器内！

代码如下:

' FileName: SoftwareMeteringCLS.vbs

' ////////////////////////////////////////////////////////////////////

If (WScript.ScriptName = "SoftwareMeteringCLS.vbs") Then Call demo_SoftwareMeteringCLS()

' ====================================================================

Function getSoftwareList(sHost)

' Callable by *.wsf; will return list (safe array) of installed

' software on the sHost system (sHost is ComputerName or IP address).

'

' The assumption is that sHost is available and has WMI installed.

Set oSoftMeter = new SoftwareMeteringCLS

sProgsAry = oSoftMeter.getList(sHost)

Set oSpftMeter = Nothing

getSoftwareList = sProgsAry

End Function

' ====================== CLASS =======================================

Class SoftwareMeteringCLS

' Author: Branimir Petrovic

' Date: 6 Sept 2002

' Version: 1.0.3

'

' Revision History:

' 30 March 2002 V 1.0.0

'

' 08 April 2002 V 1.0.1

' Added error handling - if the target system is not present,

' or does not have WMI, getList(sHost) will return empty list.

'

' Added global function getSoftwareList(sHost) to be used

' from *.wsf scripts when caller script is JScript (since

' JScript can not instantiate VBS classes directly).

'

' 21 April 2002 V 1.0.2

' Replacing "[" with "(" and "]" with ")" in "DisplayName"

' Some strings like: [See Q311401 for more information]

' can cause troubles, therefore replacement.

'

' 6 Sept 2002 V 1.0.3

' Win2K's SP3 for Windows 2000 introduced slight (but silent)

' 'improvement' in a way registry provder's EnumValues method

' deals with empty keys. EnumValues method called against

' keys without any values (except the Default, empty value)

' will now return Null value (previously array of size 0 was

' returned). Added (previously unneeded) type checking...

'

'

' Dependancies:

' WSH 5.6

'

' Methods:

' - getClassName()

' - getVersion()

' - getList(sHost) sHost parameter can be computer name or IP address

' Enumerates all subkeys in:

' "Software\Microsoft\Windows\CurrentVersion\Uninstall"

' Returns array of strings, each string item containing:

' "DisplayNameKeyValue[ --Version: DisplayVersionKeyValue]"

'

' If sHost parameter is empty string or non-string value,

' function returns list of installed software on this host.

' Otherwise it will connect to host pointed to by sHost string

' (provided sufficient level of permissions)

'

' - getHostString() Returns name of the system or IP address

' --- Private data members

Private HKLM ' Points to HKEY_LOCAL_MACHINE hive

Private UNINSTALL_ROOT ' Software\Microsoft\Windows\CurrentVersion\Uninstall

Private SUPRESS_HOTFIX_ENTRIES ' By default is TRUE (set in Class_Initialize)

' (supressess listing of installed hotfixes)

Private CLASS_NAME

Private VERSION

Private REG_SZ

Private oReg

Private sComputerName

' --- Public

Public Function getClassName()

getClassName = CLASS_NAME

End Function

Public Function getVersion()

getVersion = VERSION

End Function

Public Function getList(sHost)

If TypeName(sHost)="String" AND sHost<>"" Then

sComputerName = sHost

Else

sComputerName = WScript.CreateObject("WScript.Network").ComputerName

End If

On Error Resume Next

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}//" &_

sComputerName & "/root/default:StdRegProv")

If Err.Number<>0 Then

' Computer is not accessable or does not have WMI, return empty array

getList = Array()

Else

' Computer is on the network and does have working WMI,

' return the list (safe array) of installed software

getList = listInstalledProgs(oReg)

End If

On Error GoTo 0

End Function

Public Function getHostString()

getHostString = sComputerName

End Function

' --- Private helper routines

Private Sub Class_Initialize

' Initialize various values used by this class

HKLM = &H80000002 ' Hive: HKEY_LOCAL_MACHINE

UNINSTALL_ROOT = "Software\Microsoft\Windows\CurrentVersion\Uninstall"

REG_SZ = 1

SUPRESS_HOTFIX_ENTRIES = true

CLASS_NAME = "SoftwareMeteringCLS"

VERSION = "1.0.3"

End Sub

Private Function listInstalledProgs(oReg)

' returns array of strings DisplayName & " " & DisplayVersion

Dim oRegX, nCnt, sSubKeysAry, sProgName

Dim sProgsAry(): ReDim sProgsAry(1)

sSubKeysAry = getKeys(oReg, HKLM, UNINSTALL_ROOT)

If SUPRESS_HOTFIX_ENTRIES Then

' Supress looking into all hot fix related sub keys (like Q252795, etc...)

Set oRegX = new RegExp

oRegX.Pattern = "^Q\d+$" ' will detect patterns like: Q252795

oRegX.IgnoreCase = true

For nCnt = 0 To UBound(sSubKeysAry)

If NOT oRegX.Test(sSubKeysAry(nCnt)) Then

sProgName = getProgNameAndVersion(oReg, HKLM, _

UNINSTALL_ROOT & "\" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then

If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then

ReDim Preserve sProgsAry(UBound(sProgsAry)+1)

End If

sProgsAry(UBound(sProgsAry)-1) = sProgName

End If

End If

Next

Else

' List all sub keys including hotfix related ones (like Q252795, etc...)

For nCnt = 0 To UBound(sSubKeysAry)

sProgName = getProgNameAndVersion(oReg, HKLM, _

UNINSTALL_ROOT & "\" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then

If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then

ReDim Preserve sProgsAry(UBound(sProgsAry)+1)

End If

sProgsAry(UBound(sProgsAry)-1) = sProgName

End If

Next

End If

listInstalledProgs = sProgsAry

End Function

Private Function getKeys(oReg, HIVE, sKeyRoot)

' Returns array of strings of subkey names

Dim vKeysAry

Call oReg.EnumKey(HIVE, sKeyRoot, vKeysAry)

getKeys = vKeysAry ' >>>

End Function

Private Function getProgNameAndVersion(oReg, HIVE, sKeyRoot)

' If both values "DisplayName" and "DisplayVersion" exist in sKeyRoot, return:

' "DisplayNameKeyValue --Version: DisplayVersionKeyValue"

'

' If only "DisplayName" exists, return:

' "DisplayNameKeyValue"

'

' Otherwise EMPTY is returned

Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion

oReg.EnumValues HIVE, sKeyRoot, sKeyValuesAry, iKeyTypesAry 'fill the arrays

' 6 Sept 2002

' SP3 for Win2K altered behavior of registry provider's EnumValues method!

' EnumValues method after SP3 does not return empty array any more for all

' those registry keys that have only empty Default value.

' Therefore sKeyValuesAry must be tested to see if it is an array or not.

If NOT IsArray(sKeyValuesAry) Then

Exit Function ' ' >>>

End If

For nCnt = 0 To UBound(sKeyValuesAry)

If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then

If iKeyTypesAry(nCnt) = REG_SZ Then

oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue

If sValue<>"" Then

sDisplayName = sValue

sDisplayName = Replace(sDisplayName, "[", "(")

sDisplayName = Replace(sDisplayName, "]", ")")

End If

End If

ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then

If iKeyTypesAry(nCnt) = REG_SZ Then

oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue

If sValue<>"" Then sDisplayVersion = sValue

End If

End If

If (sDisplayName<>"") AND (sDisplayVersion<>"") Then

getProgNameAndVersion = sDisplayName & " --Version: " & sDisplayVersion

Exit Function ' >>>

End If

Next

If sDisplayName<>"" Then

getProgNameAndVersion = sDisplayName

Exit Function ' >>>

End If

End Function

End Class

' ====================== END OF CLASS ================================

Function demo_SoftwareMeteringCLS()

Dim oSoftMeter, sProgsAry, sComputer

'sComputer = "W-BRANIMIR-666"

'sComputer = "W-Branimir-079"

sComputer = "" ' query local host

sProgsAry = getSoftwareList(sComputer)

Call WScript.Echo(Join(sProgsAry, vbCrLf))

End Function