Welcome

首页 / 编程脚本 / 自动写入文件上传到指定服务器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