自动写入文件上传到指定服务器SoftwareMeteringCLS.vbs源码

'' 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