自动写入文件上传到指定服务器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