• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    自动写入文件上传到指定服务器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


    上一篇:奇特的js写法,或许可以用来加密躲杀毒软件什么的
    下一篇:一个查看局域网在线IP的vbs脚本
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

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