自动写入文件上传到指定服务器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:
" "SoftwareMicrosoftWindowsCurrentVersionUninstall"
" 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 " SoftwareMicrosoftWindowsCurrentVersionUninstall
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 = "SoftwareMicrosoftWindowsCurrentVersionUninstall"
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 = "^Qd+$" " 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