网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料：

　

标题 自动写入文件上传到指定服务器SoftwareMeteringCLS.vbs源码
内容
    本次文章其中所用脚本代码为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
随便看

　

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/17 18:45:13