2016-10-24
Software List (Enhanced Version)
' ----- 參數設定開始 -----
ADDomain = "Contoso"
TargetFilePath = "\\FileServer\Info$\Data\*.dbd"
GapString = "=====Gap====="
InfoString = "=====Info====="
' 除厝模式: (派送用戶端執行應設為 0)
' 0: 不顯示訊息
' 1: 顯示錯誤訊息
DebugMode = 0
' 資料取得方式 (此參數會在 DB Record 中註記):
' 1: Local - Client Push 檔案給 Server 讀取
' 2: Remote - Server 主動連線取得資料產生檔案
InfoDataType = 1
' 如果資料取得方式是 2: Server 主動連線取得資料產生檔案
' 此處給予客戶端有可能使用的管理員帳號密碼
AuthUserNameString = ""
AuthPasswordString = ""
' ----- 參數設定結束 -----
TempFileName = "HostInfo.tmp"
if (DebugMode = 1) then
On Error GoTo 0
else
On Error Resume Next
end if
' Must be 0 to Start Auth Test
AuthPass = 0
AuthUserNameArray = Split(AuthUserNameString,";")
AuthPasswordArray = Split(AuthPasswordString,";")
if UBound(AuthUserNameArray) <> UBound(AuthPasswordArray) Then
Wscript.quit
end if
' 資料取得方式 為 Remote 模式時, 必須帶入 IP, 如果是批次作業需多帶入帳號驗證序號 (嘗試錯誤後再用另一帳號嘗試通過驗證)
if (InfoDataType = 2 ) then
if (WScript.Arguments.Count = 1) then
RemoteComputer = Wscript.Arguments(0)
AuthSerial = 0
elseif (WScript.Arguments.Count = 2) then
Set WscriptArguments = Wscript.Arguments
RemoteComputer = WscriptArguments(0)
On Error Resume Next
AuthSerial = CInt(WscriptArguments(1))
if (vartype(AuthSerial) <> 2) then
wscript.quit
end if
if (DebugMode = 1) then
On Error GoTo 0
else
On Error Resume Next
end if
AuthUserName = AuthUserNameArray(AuthSerial)
AuthPassword = AuthPasswordArray(AuthSerial)
else
wscript.quit
end if
else
RemoteComputer = "."
AuthUserName = ""
AuthPassword = ""
end if
' ----- Set Object Class & Variables
Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
Set WshShell = CreateObject( "WScript.Shell" )
Set fso = CreateObject("Scripting.FileSystemObject")
If not fso.FolderExists(Replace(TargetFilePath,"\*.dbd","")) Then
if (DebugMode = 1) then
wscript.echo "Cannot Reach Target Path"
end if
wscript.quit
end if
Const HKEY_LOCAL_MACHINE = &H80000002
' ----- MB
Dim MBIndex
Dim MBManufacturer()
Dim MBProduct()
Dim MBSerialNumber()
Dim MBVersion()
MBIndex = -1
' ----- CPU
Dim CPUIndex
Dim CPUAddressWidth()
Dim CPUArchitecture()
Dim CPUCaption()
Dim CPUDataWidth()
Dim CPUDeviceID()
Dim CPUExtClock()
Dim CPUFamily()
Dim CPULevel()
Dim CPUManufacturer()
Dim CPUMaxClockSpeed()
Dim CPUName()
Dim CPUNumberOfCores()
Dim CPUNumberOfLogicalProcessors()
Dim CPUProcessorId()
Dim CPUSocketDesignation()
CPUIndex = -1
' ----- MEM
Dim MEMIndex
Dim MEMBankLabel()
Dim MEMCapacity()
Dim MEMDeviceLocator()
Dim MEMManufacturer()
Dim MEMMemoryType()
Dim MEMPartNumber()
Dim MEMSerialNumber()
Dim MEMSpeed()
Dim MEMTag()
MEMIndex = -1
' ----- NIC
Dim NICIndex
Dim NICCaption()
Dim NICDHCPEnabled()
Dim NICDNSHostName()
Dim NICIPAddress()
Dim NICMACAddress()
Dim NICServiceName()
NICIndex = -1
Dim AllInfoDNSHostName
' ----- DiskIndex
Dim DiskIndex
Dim DiskCaption()
Dim DiskFirmwareRevision()
Dim DiskInterfaceType()
Dim DiskMediaType()
Dim DiskModel()
Dim DiskSerialNumber()
Dim DiskSignature()
Dim DiskSize()
DiskIndex = -1
' ----- CDROMIndex
Dim CDROMIndex
Dim CDROMCaption()
Dim CDROMMediaType()
Dim CDROMMfrAssignedRevisionLevel()
Dim CDROMName()
CDROMIndex = -1
' ----- OS
Dim OSIndex
Dim OSBuildNumber()
Dim OSCaption()
Dim OSCodeSet()
Dim OSCountryCode()
Dim OSCSDVersion()
Dim OSCSName()
Dim OSCurrentTimeZone()
Dim OSInstallDate()
Dim OSLastBootUpTime()
Dim OSLocale()
Dim OSManufacturer()
Dim OSOperatingSystemSKU()
Dim OSOSArchitecture()
Dim OSOSLanguage()
Dim OSOSProductSuite()
Dim OSOSType()
Dim OSOtherTypeDescription()
Dim OSProductKey()
Dim OSProductType()
Dim OSRegisteredUser()
Dim OSSerialNumber()
Dim OSVersion()
OSIndex = -1
' ----- Software List
Dim SoftwareListIndex
Dim SoftwareDisplayName()
Dim SoftwareDisplayVersion()
Dim SoftwarePublisher()
Dim SoftwareInstallDate()
SoftwareListIndex = -1
' ----- Office List
Dim OfficeListIndex
Dim OfficeVersion()
Dim OfficeProductName()
Dim OfficeProductID()
Dim OfficeType()
Dim OfficeProductKey()
Dim OfficeNote()
OfficeListIndex = -1
Dim oReg
Dim osType
Dim aOffID(5,1)
Dim aOffIDX
' ----- GroupMember List
Dim GroupMemberListIndex
Dim GroupMemberAccount()
Dim GroupMemberType()
GroupMemberListIndex = -1
' ----- Get Info
Dim LastLogonAccount
if (InfoDataType = 1) then
Set objServices = objLocator.ConnectServer(RemoteComputer,"\root\cimv2",AuthUserName,AuthPassword,,,,objCtx)
elseif (InfoDataType = 2) then
On Error Resume Next
for i = AuthSerial to UBound(AuthUserNameArray)
if (AuthUserNameArray(i) <> "") then
Set objServices = objLocator.ConnectServer(RemoteComputer,"root\cimv2",AuthUserNameArray(i),AuthPasswordArray(i),,,,objCtx)
If Err = 0 then
AuthUserName = AuthUserNameArray(i)
AuthPassword = AuthPasswordArray(i)
AuthPass = 1
exit for
End If
if (DebugMode = 1) then
wscript.echo WScript.ScriptFullName & " " & RemoteComputer & " " & (i+1)
end if
TestNextAuth = WshShell.Run(WScript.ScriptFullName & " " & RemoteComputer & " " & (i+1), 0, false)
wscript.quit
end if
Next
if (DebugMode = 1) then
On Error GoTo 0
else
On Error Resume Next
end if
if AuthPass = 0 then
if (DebugMode = 1) then
wscript.echo "Auth All Failed"
end if
wscript.quit
end if
else
wscript.quit
end if
LastLogonAccount = GetLastLogonAccount()
If Err = 0 Then
GetMB()
GetCPU()
GetMEM()
GetOS()
GetNIC()
' ----- NIC After OS for AllInfoDNSHostName
GetDisk()
GetCDROM()
GetGroupMember("Administrators")
GetGroupMember("Power Users")
GetOfficeList()
GetSoftwareList(32)
GetSoftwareList(64)
' ----- Get ComputerSID
Set objServices = objLocator.ConnectServer(RemoteComputer,"\root\cimv2",AuthUserName,AuthPassword,,,,objCtx)
Set LocalAdministratorAccount = objServices.ExecQuery("SELECT * FROM Win32_Account where Name = 'Administrator' and LocalAccount = True and Domain = '" & AllInfoDNSHostName & "'",,48)
For Each User in LocalAdministratorAccount
ComputerSID = Left(User.SID, Len(User.SID) - 4)
next
WriteInfoToFile()
End If
wscript.quit
Function WriteInfoToFile()
MBd = GapString & vbcrlf & "MB" & vbcrlf & InfoString & vbcrlf & (MBIndex+1) & vbcrlf & "MBManufacturer" & vbTab & "MBProduct" & vbTab & "MBSerialNumber" & vbTab & "MBVersion"
For i=0 to (MBIndex)
MBd = MBd & vbcrlf & MBManufacturer(i) & vbTab & MBProduct(i) & vbTab & MBSerialNumber(i) & vbTab & MBVersion(i)
Next
CPUd = GapString & vbcrlf & "CPU" & vbcrlf & InfoString & vbcrlf & (CPUIndex+1) & vbcrlf & "CPUAddressWidth" & vbTab & "CPUArchitecture" & vbTab & "CPUCaption" & vbTab & "CPUDataWidth" & vbTab & "CPUDeviceID" & vbTab & "CPUExtClock" & vbTab & "CPUFamily" & vbTab & "CPULevel" & vbTab & "CPUManufacturer" & vbTab & "CPUMaxClockSpeed" & vbTab & "CPUName" & vbTab & "CPUNumberOfCores" & vbTab & "CPUNumberOfLogicalProcessors" & vbTab & "CPUProcessorId" & vbTab & "CPUSocketDesignation"
For i=0 to (CPUIndex)
CPUd = CPUd & vbcrlf & CPUAddressWidth(i) & vbTab & CPUArchitecture(i) & vbTab & CPUCaption(i) & vbTab & CPUDataWidth(i) & vbTab & CPUDeviceID(i) & vbTab & CPUExtClock(i) & vbTab & CPUFamily(i) & vbTab & CPULevel(i) & vbTab & CPUManufacturer(i) & vbTab & CPUMaxClockSpeed(i) & vbTab & CPUName(i) & vbTab & CPUNumberOfCores(i) & vbTab & CPUNumberOfLogicalProcessors(i) & vbTab & CPUProcessorId(i) & vbTab & CPUSocketDesignation(i)
Next
MEMd = GapString & vbcrlf & "MEM" & vbcrlf & InfoString & vbcrlf & (MEMIndex+1) & vbcrlf & "MEMBankLabel" & vbTab & "MEMCapacity" & vbTab & "MEMDeviceLocator" & vbTab & "MEMManufacturer" & vbTab & "MEMMemoryType" & vbTab & "MEMPartNumber" & vbTab & "MEMSerialNumber" & vbTab & "MEMSpeed" & vbTab & "MEMTag"
For i=0 to (MEMIndex)
MEMd = MEMd & vbcrlf & MEMBankLabel(i) & vbTab & MEMCapacity(i) & vbTab & MEMDeviceLocator(i) & vbTab & MEMManufacturer(i) & vbTab & MEMMemoryType(i) & vbTab & MEMPartNumber(i) & vbTab & MEMSerialNumber(i) & vbTab & MEMSpeed(i) & vbTab & MEMTag(i)
Next
NICd = GapString & vbcrlf & "NIC" & vbcrlf & InfoString & vbcrlf & (NICIndex+1) & vbcrlf & "NICCaption" & vbTab & "NICDHCPEnabled" & vbTab & "NICDNSHostName" & vbTab & "NICIPAddress" & vbTab & "NICMACAddress" & vbTab & "NICServiceName"
For i=0 to (NICIndex)
NICd = NICd & vbcrlf & NICCaption(i) & vbTab & NICDHCPEnabled(i) & vbTab & NICDNSHostName(i) & vbTab & NICIPAddress(i) & vbTab & NICMACAddress(i) & vbTab & NICServiceName(i)
Next
Diskd = GapString & vbcrlf & "Disk" & vbcrlf & InfoString & vbcrlf & (DiskIndex+1) & vbcrlf & "DiskCaption" & vbTab & "DiskFirmwareRevision" & vbTab & "DiskInterfaceType" & vbTab & "DiskMediaType" & vbTab & "DiskModel" & vbTab & "DiskSerialNumber" & vbTab & "DiskSignature" & vbTab & "DiskSize"
For i=0 to (DiskIndex)
Diskd = Diskd & vbcrlf & DiskCaption(i) & vbTab & DiskFirmwareRevision(i) & vbTab & DiskInterfaceType(i) & vbTab & DiskMediaType(i) & vbTab & DiskModel(i) & vbTab & DiskSerialNumber(i) & vbTab & DiskSignature(i) & vbTab & DiskSize(i)
Next
CDROMd = GapString & vbcrlf & "CDROM" & vbcrlf & InfoString & vbcrlf & (CDROMIndex+1) & vbcrlf & "CDROMCaption" & vbTab & "CDROMMediaType" & vbTab & "CDROMMfrAssignedRevisionLevel" & vbTab & "CDROMName"
For i=0 to (CDROMIndex)
CDROMd = CDROMd & vbcrlf & CDROMCaption(i) & vbTab & CDROMMediaType(i) & vbTab & CDROMMfrAssignedRevisionLevel(i) & vbTab & CDROMName(i)
Next
OSd = GapString & vbcrlf & "OS" & vbcrlf & InfoString & vbcrlf & (OSIndex+1) & vbcrlf & "OSBuildNumber" & vbTab & "OSCaption" & vbTab & "OSCodeSet" & vbTab & "OSCountryCode" & vbTab & "OSCSDVersion" & vbTab & "OSCSName" & vbTab & "OSCurrentTimeZone" & vbTab & "OSInstallDate" & vbTab & "OSLastBootUpTime" & vbTab & "OSLocale" & vbTab & "OSManufacturer" & vbTab & "OSOperatingSystemSKU" & vbTab & "OSOSArchitecture" & vbTab & "OSOSLanguage" & vbTab & "OSOSProductSuite" & vbTab & "OSOSType" & vbTab & "OSOtherTypeDescription" & vbTab & "OSProductKey" & vbTab & "OSProductType" & vbTab & "OSRegisteredUser" & vbTab & "OSSerialNumber" & vbTab & "OSVersion"
For i=0 to (OSIndex)
OSd = OSd & vbcrlf & OSBuildNumber(i) & vbTab & OSCaption(i) & vbTab & OSCodeSet(i) & vbTab & OSCountryCode(i) & vbTab & OSCSDVersion(i) & vbTab & OSCSName(i) & vbTab & OSCurrentTimeZone(i) & vbTab & OSInstallDate(i) & vbTab & OSLastBootUpTime(i) & vbTab & OSLocale(i) & vbTab & OSManufacturer(i) & vbTab & OSOperatingSystemSKU(i) & vbTab & OSOSArchitecture(i) & vbTab & OSOSLanguage(i) & vbTab & OSOSProductSuite(i) & vbTab & OSOSType(i) & vbTab & OSOtherTypeDescription(i) & vbTab & OSProductKey(i) & vbTab & OSProductType(i) & vbTab & OSRegisteredUser(i) & vbTab & OSSerialNumber(i) & vbTab & OSVersion(i)
Next
GroupMemberListd = GapString & vbcrlf & "GroupMember" & vbcrlf & InfoString & vbcrlf & (GroupMemberListIndex+1) & vbcrlf & "GroupName" & vbTab & "Account"
For i=0 to (GroupMemberListIndex)
GroupMemberListd = GroupMemberListd & vbcrlf & GroupMemberType(i) & vbTab & GroupMemberAccount(i)
Next
SoftwareListd = GapString & vbcrlf & "Software" & vbcrlf & InfoString & vbcrlf & (SoftwareListIndex+1) & vbcrlf & "DisplayName" & vbTab & "DisplayVersion" & vbTab & "Publisher" & vbTab & "InstallDate"
For i=0 to (SoftwareListIndex)
SoftwareListd = SoftwareListd & vbcrlf & SoftwareDisplayName(i) & vbTab & SoftwareDisplayVersion(i) & vbTab & SoftwarePublisher(i) & vbTab & SoftwareInstallDate(i)
Next
OfficeListd = GapString & vbcrlf & "Office" & vbcrlf & InfoString & vbcrlf & (OfficeListIndex+1) & vbcrlf & "OfficeVersion" & vbTab & "OfficeProductName" & vbTab & "OfficeProductID" & vbTab & "OfficeType" & vbTab & "OfficeProductKey" & vbTab & "OfficeNote"
For i=0 to (OfficeListIndex)
OfficeListd = OfficeListd & vbcrlf & OfficeVersion(i) & vbTab & OfficeProductName(i) & vbTab & OfficeProductID(i) & vbTab & OfficeType(i) & vbTab & OfficeProductKey(i) & vbTab & OfficeNote(i)
Next
FinalInfoContent = ""
FinalInfoContent = FinalInfoContent & "DateTime" & vbcrlf & InfoString & vbcrlf & Now & vbcrlf & LastLogonAccount & vbcrlf & InfoDataType & vbcrlf & ComputerSID & vbcrlf
FinalInfoContent = FinalInfoContent & MBd & vbcrlf
FinalInfoContent = FinalInfoContent & CPUd & vbcrlf
FinalInfoContent = FinalInfoContent & MEMd & vbcrlf
FinalInfoContent = FinalInfoContent & NICd & vbcrlf
FinalInfoContent = FinalInfoContent & Diskd & vbcrlf
FinalInfoContent = FinalInfoContent & CDROMd & vbcrlf
FinalInfoContent = FinalInfoContent & OSd & vbcrlf
FinalInfoContent = FinalInfoContent & GroupMemberListd & vbcrlf
FinalInfoContent = FinalInfoContent & SoftwareListd & vbcrlf
FinalInfoContent = FinalInfoContent & OfficeListd
if (InfoDataType = 1) then
TempFile = WshShell.ExpandEnvironmentStrings("%Temp%") & "\" & TempFileName
TargetFile = Replace(TargetFilePath,"*",AllInfoDNSHostName)
Set StdOut = fso.OpenTextFile(TempFile, 2, True, -1)
if (fso.FileExists(TempFile)) then
StdOut.WriteLine FinalInfoContent
StdOut.close
CopyFile = fso.CopyFile(TempFile,TargetFile,True)
DeleteTempFile = fso.DeleteFile(TempFile,True)
else
StdOut.close
Set StdOut = fso.OpenTextFile(TargetFile, 2, True, -1)
StdOut.WriteLine FinalInfoContent
StdOut.close
end if
elseif (InfoDataType = 2) then
TargetFile = Replace(TargetFilePath,"*",AllInfoDNSHostName)
Set StdOut = fso.OpenTextFile(TargetFile, 2, True, -1)
StdOut.WriteLine FinalInfoContent
StdOut.close
else
wscript.quit
end if
End Function
' ----- End
Function GetMB()
Set BaseBoardItems = objServices.ExecQuery("SELECT * FROM Win32_BaseBoard")
For Each BaseBoardObjItem in BaseBoardItems
MBIndex = MBIndex + 1
ReDim Preserve MBManufacturer(MBIndex)
ReDim Preserve MBProduct(MBIndex)
ReDim Preserve MBSerialNumber(MBIndex)
ReDim Preserve MBVersion(MBIndex)
MBManufacturer(MBIndex) = NullToEmpty(BaseBoardObjItem.Manufacturer)
MBProduct(MBIndex) = NullToEmpty(BaseBoardObjItem.Product)
MBSerialNumber(MBIndex) = NullToEmpty(BaseBoardObjItem.SerialNumber)
MBVersion(MBIndex) = NullToEmpty(BaseBoardObjItem.Version)
Next
End Function
Function GetCPU()
Set CPUItems = objServices.ExecQuery("SELECT * FROM Win32_Processor")
For Each CPU in CPUItems
CPUIndex = CPUIndex + 1
ReDim Preserve CPUAddressWidth(CPUIndex)
ReDim Preserve CPUArchitecture(CPUIndex)
ReDim Preserve CPUCaption(CPUIndex)
ReDim Preserve CPUDataWidth(CPUIndex)
ReDim Preserve CPUDeviceID(CPUIndex)
ReDim Preserve CPUExtClock(CPUIndex)
ReDim Preserve CPUFamily(CPUIndex)
ReDim Preserve CPULevel(CPUIndex)
ReDim Preserve CPUManufacturer(CPUIndex)
ReDim Preserve CPUMaxClockSpeed(CPUIndex)
ReDim Preserve CPUName(CPUIndex)
ReDim Preserve CPUNumberOfCores(CPUIndex)
ReDim Preserve CPUNumberOfLogicalProcessors(CPUIndex)
ReDim Preserve CPUProcessorId(CPUIndex)
ReDim Preserve CPUSocketDesignation(CPUIndex)
CPUAddressWidth(CPUIndex) = NullToEmpty(CPU.AddressWidth) ' OS x86 / x64
CPUArchitecture(CPUIndex) = NullToEmpty(CPU.Architecture)
CPUCaption(CPUIndex) = NullToEmpty(CPU.Caption)
CPUDataWidth(CPUIndex) = NullToEmpty(CPU.DataWidth) ' CPU x86 / x64
CPUDeviceID(CPUIndex) = NullToEmpty(CPU.DeviceID)
CPUExtClock(CPUIndex) = NullToEmpty(CPU.ExtClock)
CPUFamily(CPUIndex) = NullToEmpty(CPU.Family)
CPULevel(CPUIndex) = NullToEmpty(CPU.Level)
CPUManufacturer(CPUIndex) = NullToEmpty(CPU.Manufacturer)
CPUMaxClockSpeed(CPUIndex) = NullToEmpty(CPU.MaxClockSpeed)
CPUName(CPUIndex) = NullToEmpty(CPU.Name)
CPUNumberOfCores(CPUIndex) = NullToEmpty(CPU.NumberOfCores)
' old os not support (2003)
CPUNumberOfLogicalProcessors(CPUIndex) = NullToEmpty(CPU.NumberOfLogicalProcessors)
CPUProcessorId(CPUIndex) = NullToEmpty(CPU.ProcessorId)
CPUSocketDesignation(CPUIndex) = NullToEmpty(CPU.SocketDesignation)
Next
End Function
Function GetMEM()
Set MemoryItems = objServices.ExecQuery("SELECT * FROM Win32_PhysicalMemory")
For Each Memory in MemoryItems
MEMIndex = MEMIndex + 1
ReDim Preserve MEMBankLabel(MEMIndex)
ReDim Preserve MEMCapacity(MEMIndex)
ReDim Preserve MEMDeviceLocator(MEMIndex)
ReDim Preserve MEMManufacturer(MEMIndex)
ReDim Preserve MEMMemoryType(MEMIndex)
ReDim Preserve MEMPartNumber(MEMIndex)
ReDim Preserve MEMSerialNumber(MEMIndex)
ReDim Preserve MEMSpeed(MEMIndex)
ReDim Preserve MEMTag(MEMIndex)
MEMBankLabel(MEMIndex) = NullToEmpty(Memory.BankLabel)
MEMCapacity(MEMIndex) = NullToEmpty(Fix(Memory.Capacity/1048576))
MEMDeviceLocator(MEMIndex) = NullToEmpty(Memory.DeviceLocator)
MEMManufacturer(MEMIndex) = NullToEmpty(Memory.Manufacturer)
MEMMemoryType(MEMIndex) = NullToEmpty(Memory.MemoryType)
MEMPartNumber(MEMIndex) = NullToEmpty(Memory.PartNumber)
MEMSerialNumber(MEMIndex) = NullToEmpty(Memory.SerialNumber)
MEMSpeed(MEMIndex) = NullToEmpty(Memory.Speed)
MEMTag(MEMIndex) = NullToEmpty(Memory.Tag)
Next
End Function
Function GetNIC()
Set NetworkAdapterItems = objServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")
For Each NetworkAdapter in NetworkAdapterItems
If (VarType(NetworkAdapter.MACAddress) <> 1) Then
NICIndex = NICIndex + 1
ReDim Preserve NICCaption(NICIndex)
ReDim Preserve NICDHCPEnabled(NICIndex)
ReDim Preserve NICDNSHostName(NICIndex)
ReDim Preserve NICIPAddress(NICIndex)
ReDim Preserve NICMACAddress(NICIndex)
ReDim Preserve NICServiceName(NICIndex)
NICCaption(NICIndex) = NullToEmpty(Mid(NetworkAdapter.Caption,12,Len(NetworkAdapter.Caption)))
If (NetworkAdapter.DHCPEnabled = True) Then
NICDHCPEnabled(NICIndex) = 1
else
NICDHCPEnabled(NICIndex) = 0
End If
NICDNSHostName(NICIndex) = NullToEmpty(NetworkAdapter.DNSHostName)
If (NICDNSHostName(NICIndex) <> "") Then
AllInfoDNSHostName = NICDNSHostName(NICIndex)
End If
If (vartype(NetworkAdapter.IPAddress) = 8204) Then
For Each IPAddress in NetworkAdapter.IPAddress
If Not Instr(IPAddress,":") > 0 Then
If (NICIPAddress(NICIndex) <> "") Then
NICIPAddress(NICIndex) = NICIPAddress(NICIndex) & ";"
End If
NICIPAddress(NICIndex) = NICIPAddress(NICIndex) & IPAddress
End If
Next
else
NICIPAddress(NICIndex) = IPAddress
End If
NICIPAddress(NICIndex) = NullToEmpty(NICIPAddress(NICIndex))
NICMACAddress(NICIndex) = NullToEmpty(NetworkAdapter.MACAddress)
NICServiceName(NICIndex) = NullToEmpty(NetworkAdapter.ServiceName)
End If
Next
End Function
Function GetDisk()
' Vista & 2008 (含)以上版本才有這兩項
DiskFWR = 0
DiskSN = 0
Set DiskClass = objServices.Get("Win32_DiskDrive")
For Each DiskClassProperty In DiskClass.Properties_
If (UCase(DiskClassProperty.Name) = UCase("DiskFirmwareRevision")) Then
DiskFWR = 1
End If
If (UCase(DiskClassProperty.Name) = UCase("DiskSerialNumber")) Then
DiskSN = 1
End If
Next
Set DiskItems = objServices.ExecQuery("SELECT * FROM Win32_DiskDrive")
For Each Disk in DiskItems
DiskIndex = DiskIndex + 1
ReDim Preserve DiskCaption(DiskIndex)
ReDim Preserve DiskFirmwareRevision(DiskIndex)
ReDim Preserve DiskInterfaceType(DiskIndex)
ReDim Preserve DiskMediaType(DiskIndex)
ReDim Preserve DiskModel(DiskIndex)
ReDim Preserve DiskSerialNumber(DiskIndex)
ReDim Preserve DiskSignature(DiskIndex)
ReDim Preserve DiskSize(DiskIndex)
DiskCaption(DiskIndex) = NullToEmpty(Disk.Caption)
If (DiskFWR = 1) Then
DiskFirmwareRevision(DiskIndex) = NullToEmpty(Disk.FirmwareRevision)
else
DiskFirmwareRevision(DiskIndex) = ""
End If
DiskInterfaceType(DiskIndex) = NullToEmpty(Disk.InterfaceType)
DiskMediaType(DiskIndex) = NullToEmpty(Disk.MediaType)
DiskModel(DiskIndex) = NullToEmpty(Disk.Model)
If (DiskSN = 1) Then
DiskSerialNumber(DiskIndex) = NullToEmpty(Disk.SerialNumber)
else
DiskSerialNumber(DiskIndex) = ""
End If
DiskSignature(DiskIndex) = NullToEmpty(Disk.Signature)
DiskSize(DiskIndex) = NullToEmpty(Fix(Disk.Size/1000000000))
Next
End Function
Function GetCDROM()
Set CDROMItems = objServices.ExecQuery("SELECT * FROM Win32_CDROMDrive")
For Each CDROM in CDROMItems
CDROMIndex = CDROMIndex + 1
ReDim Preserve CDROMCaption(CDROMIndex)
ReDim Preserve CDROMMediaType(CDROMIndex)
ReDim Preserve CDROMMfrAssignedRevisionLevel(CDROMIndex)
ReDim Preserve CDROMName(CDROMIndex)
CDROMCaption(CDROMIndex) = NullToEmpty(CDROM.Caption)
CDROMMediaType(CDROMIndex) = NullToEmpty(CDROM.MediaType)
CDROMMfrAssignedRevisionLevel(CDROMIndex) = NullToEmpty(CDROM.MfrAssignedRevisionLevel)
CDROMName(CDROMIndex) = NullToEmpty(CDROM.Name)
Next
End Function
Function GetOS()
' 取得 Product Key
Set objSWbemServices = objLocator.ConnectServer(RemoteComputer,"\root\default", AuthUserName, AuthPassword)
objSWbemServices.Security_.ImpersonationLevel = 3
Set objReg = objSWbemServices.Get("stdregprov")
objReg.GetBinaryValue HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows NT\CurrentVersion","DigitalProductId",OSDigitalProductId
' Vista & 2008 (含)以上版本才有這兩項
OSSKU = 0
OSArch = 0
Set OSClass = objServices.Get("Win32_OperatingSystem")
For Each OSClassProperty In OSClass.Properties_
If (UCase(OSClassProperty.Name) = UCase("OperatingSystemSKU")) Then
OSSKU = 1
End If
If (UCase(OSClassProperty.Name) = UCase("OSArchitecture")) Then
OSArch = 1
End If
Next
Set OperatingSystemItems = objServices.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each OperatingSystem in OperatingSystemItems
OSIndex = OSIndex + 1
ReDim Preserve OSBuildNumber(OSIndex)
ReDim Preserve OSCaption(OSIndex)
ReDim Preserve OSCodeSet(OSIndex)
ReDim Preserve OSCountryCode(OSIndex)
ReDim Preserve OSCSDVersion(OSIndex)
ReDim Preserve OSCSName(OSIndex)
ReDim Preserve OSCurrentTimeZone(OSIndex)
ReDim Preserve OSInstallDate(OSIndex)
ReDim Preserve OSLastBootUpTime(OSIndex)
ReDim Preserve OSLocale(OSIndex)
ReDim Preserve OSManufacturer(OSIndex)
ReDim Preserve OSOperatingSystemSKU(OSIndex)
ReDim Preserve OSOSArchitecture(OSIndex)
ReDim Preserve OSOSLanguage(OSIndex)
ReDim Preserve OSOSProductSuite(OSIndex)
ReDim Preserve OSOSType(OSIndex)
ReDim Preserve OSOtherTypeDescription(OSIndex)
ReDim Preserve OSProductKey(OSIndex)
ReDim Preserve OSProductType(OSIndex)
ReDim Preserve OSRegisteredUser(OSIndex)
ReDim Preserve OSSerialNumber(OSIndex)
ReDim Preserve OSVersion(OSIndex)
OSBuildNumber(OSIndex) = NullToEmpty(OperatingSystem.BuildNumber)
OSCaption(OSIndex) = NullToEmpty(OperatingSystem.Caption)
OSCodeSet(OSIndex) = NullToEmpty(OperatingSystem.CodeSet)
OSCountryCode(OSIndex) = NullToEmpty(OperatingSystem.CountryCode)
OSCSDVersion(OSIndex) = NullToEmpty(OperatingSystem.CSDVersion)
OSCSName(OSIndex) = NullToEmpty(OperatingSystem.CSName)
If (AllInfoDNSHostName = "") Then
AllInfoDNSHostName = OSCSName(OSIndex)
End If
OSCurrentTimeZone(OSIndex) = NullToEmpty(OperatingSystem.CurrentTimeZone)
OSInstallDate(OSIndex) = OperatingSystem.InstallDate
OSLastBootUpTime(OSIndex) = OperatingSystem.LastBootUpTime
OSLocale(OSIndex) = NullToEmpty(OperatingSystem.Locale)
OSManufacturer(OSIndex) = NullToEmpty(OperatingSystem.Manufacturer)
If (OSSKU = 1) Then
OSOperatingSystemSKU(OSIndex) = NullToEmpty(OperatingSystem.OperatingSystemSKU)
else
OSOperatingSystemSKU(OSIndex) = ""
End If
If (OSArch = 1) Then
OSOSArchitecture(OSIndex) = NullToEmpty(OperatingSystem.OSArchitecture)
else
OSOSArchitecture(OSIndex) = ""
End If
OSOSLanguage(OSIndex) = NullToEmpty(OperatingSystem.OSLanguage)
OSOSProductSuite(OSIndex) = NullToEmpty(OperatingSystem.OSProductSuite)
OSOSType(OSIndex) = NullToEmpty(OperatingSystem.OSType)
OSOtherTypeDescription(OSIndex) = NullToEmpty(OperatingSystem.OtherTypeDescription)
OSProductKey(OSIndex) = NullToEmpty(DecodeOSKey(OSDigitalProductId))
OSProductType(OSIndex) = NullToEmpty(OperatingSystem.ProductType)
OSRegisteredUser(OSIndex) = NullToEmpty(OperatingSystem.RegisteredUser)
OSSerialNumber(OSIndex) = NullToEmpty(OperatingSystem.SerialNumber)
OSVersion(OSIndex) = NullToEmpty(OperatingSystem.Version)
Next
End Function
Function GetGroupMember(GroupName)
Set GroupMemberItems = objServices.ExecQuery("select * from Win32_GroupUser where GroupComponent = " & chr(34) & "Win32_Group.Domain='" & AllInfoDNSHostName & "',Name='" & GroupName & "'" & Chr(34))
For Each GroupMemberItem In GroupMemberItems
Dim strMemberName, NamesArray, strDomainName, DomainNameArray
NamesArray = Split(GroupMemberItem.PartComponent,",")
strMemberName = Replace(Replace(NamesArray(1),Chr(34),""),"Name=","")
DomainNameArray = Split(NamesArray(0),"=")
strDomainName = Replace(DomainNameArray(1),Chr(34),"")
If UCase(strDomainName) <> UCase(AllInfoDNSHostName) Then
strMemberName = strDomainName & "\" & strMemberName
End If
if ( (FindStr(strMemberName,"administrator") <> 1) and (FindStr(strMemberName,"domain admins") <> 1) ) then
GroupMemberListIndex = GroupMemberListIndex + 1
ReDim Preserve GroupMemberAccount(GroupMemberListIndex)
ReDim Preserve GroupMemberType(GroupMemberListIndex)
GroupMemberAccount(GroupMemberListIndex) = strMemberName
GroupMemberType(GroupMemberListIndex) = GroupName
end if
Next
End Function
Function DateTimeFormat(DateTime)
ReturnValue = ConvertTime(DateTime)
ReturnValue = Replace(ReturnValue,"AM 12","00")
ReturnValue = Replace(ReturnValue,"AM 01","01")
ReturnValue = Replace(ReturnValue,"AM 02","02")
ReturnValue = Replace(ReturnValue,"AM 03","03")
ReturnValue = Replace(ReturnValue,"AM 04","04")
ReturnValue = Replace(ReturnValue,"AM 05","05")
ReturnValue = Replace(ReturnValue,"AM 06","06")
ReturnValue = Replace(ReturnValue,"AM 07","07")
ReturnValue = Replace(ReturnValue,"AM 08","08")
ReturnValue = Replace(ReturnValue,"AM 09","09")
ReturnValue = Replace(ReturnValue,"AM 10","10")
ReturnValue = Replace(ReturnValue,"AM 11","11")
ReturnValue = Replace(ReturnValue,"PM 12","12")
ReturnValue = Replace(ReturnValue,"PM 01","13")
ReturnValue = Replace(ReturnValue,"PM 02","14")
ReturnValue = Replace(ReturnValue,"PM 03","15")
ReturnValue = Replace(ReturnValue,"PM 04","16")
ReturnValue = Replace(ReturnValue,"PM 05","17")
ReturnValue = Replace(ReturnValue,"PM 06","18")
ReturnValue = Replace(ReturnValue,"PM 07","19")
ReturnValue = Replace(ReturnValue,"PM 08","20")
ReturnValue = Replace(ReturnValue,"PM 09","21")
ReturnValue = Replace(ReturnValue,"PM 10","22")
ReturnValue = Replace(ReturnValue,"PM 11","23")
ReturnValue = Replace(ReturnValue,"上午 12","00")
ReturnValue = Replace(ReturnValue,"上午 01","01")
ReturnValue = Replace(ReturnValue,"上午 02","02")
ReturnValue = Replace(ReturnValue,"上午 03","03")
ReturnValue = Replace(ReturnValue,"上午 04","04")
ReturnValue = Replace(ReturnValue,"上午 05","05")
ReturnValue = Replace(ReturnValue,"上午 06","06")
ReturnValue = Replace(ReturnValue,"上午 07","07")
ReturnValue = Replace(ReturnValue,"上午 08","08")
ReturnValue = Replace(ReturnValue,"上午 09","09")
ReturnValue = Replace(ReturnValue,"上午 10","10")
ReturnValue = Replace(ReturnValue,"上午 11","11")
ReturnValue = Replace(ReturnValue,"下午 12","12")
ReturnValue = Replace(ReturnValue,"下午 01","13")
ReturnValue = Replace(ReturnValue,"下午 02","14")
ReturnValue = Replace(ReturnValue,"下午 03","15")
ReturnValue = Replace(ReturnValue,"下午 04","16")
ReturnValue = Replace(ReturnValue,"下午 05","17")
ReturnValue = Replace(ReturnValue,"下午 06","18")
ReturnValue = Replace(ReturnValue,"下午 07","19")
ReturnValue = Replace(ReturnValue,"下午 08","20")
ReturnValue = Replace(ReturnValue,"下午 09","21")
ReturnValue = Replace(ReturnValue,"下午 10","22")
ReturnValue = Replace(ReturnValue,"下午 11","23")
ReturnValue = Replace(ReturnValue,"AM 1","01")
ReturnValue = Replace(ReturnValue,"AM 2","02")
ReturnValue = Replace(ReturnValue,"AM 3","03")
ReturnValue = Replace(ReturnValue,"AM 4","04")
ReturnValue = Replace(ReturnValue,"AM 5","05")
ReturnValue = Replace(ReturnValue,"AM 6","06")
ReturnValue = Replace(ReturnValue,"AM 7","07")
ReturnValue = Replace(ReturnValue,"AM 8","08")
ReturnValue = Replace(ReturnValue,"AM 9","09")
ReturnValue = Replace(ReturnValue,"PM 1","13")
ReturnValue = Replace(ReturnValue,"PM 2","14")
ReturnValue = Replace(ReturnValue,"PM 3","15")
ReturnValue = Replace(ReturnValue,"PM 4","16")
ReturnValue = Replace(ReturnValue,"PM 5","17")
ReturnValue = Replace(ReturnValue,"PM 6","18")
ReturnValue = Replace(ReturnValue,"PM 7","19")
ReturnValue = Replace(ReturnValue,"PM 8","20")
ReturnValue = Replace(ReturnValue,"PM 9","21")
ReturnValue = Replace(ReturnValue,"上午 1","01")
ReturnValue = Replace(ReturnValue,"上午 2","02")
ReturnValue = Replace(ReturnValue,"上午 3","03")
ReturnValue = Replace(ReturnValue,"上午 4","04")
ReturnValue = Replace(ReturnValue,"上午 5","05")
ReturnValue = Replace(ReturnValue,"上午 6","06")
ReturnValue = Replace(ReturnValue,"上午 7","07")
ReturnValue = Replace(ReturnValue,"上午 8","08")
ReturnValue = Replace(ReturnValue,"上午 9","09")
ReturnValue = Replace(ReturnValue,"下午 1","13")
ReturnValue = Replace(ReturnValue,"下午 2","14")
ReturnValue = Replace(ReturnValue,"下午 3","15")
ReturnValue = Replace(ReturnValue,"下午 4","16")
ReturnValue = Replace(ReturnValue,"下午 5","17")
ReturnValue = Replace(ReturnValue,"下午 6","18")
ReturnValue = Replace(ReturnValue,"下午 7","19")
ReturnValue = Replace(ReturnValue,"下午 8","20")
ReturnValue = Replace(ReturnValue,"下午 9","21")
DateTimeFormat = ReturnValue
End Function
function ConvertTime(sTime)
if (sTime="**************.******+***") then
ConvertTime = "Unknown"
else
if (Trim(sTime)="") then
sTime="Unknown"
else
sYear = Mid(sTime,1,4)
sMonth = Mid(sTime,5,2)
sDay = Mid(sTime,7,2)
sHour = Mid(sTime,9,2)
sMin = Mid(sTime,11,2)
sSec = Mid(sTime,13,2)
end if
ConvertTime = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMin & ":" & sSec
end if
end function
Function DecodeOSKey(key)
if (VarType(key) <> 1) Then
Const KeyOffset = 52
i = 28
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
Do
Cur = Cur * 256
Cur = key(x + KeyOffset) + Cur
key(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x - 1
Loop While x >= 0
i = i - 1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1
KeyOutput = "-" & KeyOutput
End If
Loop While i >= 0
else
KeyOutput = ""
End If
DecodeOSKey = KeyOutput
End Function
Function GetSoftwareList(SystemBit)
objCtx.Add "__ProviderArchitecture", SystemBit
objCtx.Add "__RequiredArchitecture", True
Set objServices = objLocator.ConnectServer(RemoteComputer,"\root\default",AuthUserName,AuthPassword,,,,objCtx)
Set objStdRegProv = objServices.Get("StdRegProv")
Set Inparams = objStdRegProv.Methods_("EnumKey").Inparameters
Inparams.Hdefkey = HKEY_LOCAL_MACHINE
Inparams.Ssubkeyname = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
set Outparams = objStdRegProv.ExecMethod_("EnumKey", Inparams,,objCtx)
For Each strSubKey In Outparams.snames
isSystemComponent = 0
Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
Inparams.Hdefkey = HKEY_LOCAL_MACHINE
Inparams.Ssubkeyname = "Software\Microsoft\Windows\CurrentVersion\Uninstall\" & strSubKey
Inparams.Svaluename = "DisplayName"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
strDisplayName = Outparams.SValue
If (strDisplayName = "") Then
strDisplayName = strSubKey
End If
strDisplayName = NullToEmpty(strDisplayName)
Inparams.Svaluename = "ParentKeyName"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
strParentKeyName = Outparams.SValue
Inparams.Svaluename = "SystemComponent"
set Outparams = objStdRegProv.ExecMethod_("GetDWORDValue", Inparams,,objCtx)
strSystemComponent = Outparams.uValue
If (vartype(strSystemComponent) = 3) Then
If (strSystemComponent = 1) Then
isSystemComponent = 1
End If
End If
If ( (strDisplayName <> "") and (vartype(strParentKeyName) = 1) and (isSystemComponent = 0) ) Then
Inparams.Svaluename = "DisplayVersion"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
strDisplayVersion = NullToEmpty(Outparams.SValue)
Inparams.Svaluename = "Publisher"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
strPublisher = NullToEmpty(Outparams.SValue)
Inparams.Svaluename = "InstallDate"
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
strInstallDate = NullToEmpty(Outparams.SValue)
AddToList = 1
For i=0 to (SoftwareListIndex)
If ( (SoftwareDisplayName(i) = strDisplayName) and (SoftwareDisplayVersion(i) = strDisplayVersion) and (SoftwarePublisher(i) = strPublisher) and (SoftwareInstallDate(i) = strInstallDate) ) Then
AddToList = 0
exit for
End If
Next
strInstallDate = NullToEmpty(strInstallDate)
If ( (Len(strInstallDate) <> 0) and (Len(strInstallDate) <> 8) ) Then
strInstallDate= ""
End If
If (AddToList = 1) Then
SoftwareListIndex = SoftwareListIndex + 1
ReDim Preserve SoftwareDisplayName(SoftwareListIndex)
ReDim Preserve SoftwareDisplayVersion(SoftwareListIndex)
ReDim Preserve SoftwarePublisher(SoftwareListIndex)
ReDim Preserve SoftwareInstallDate(SoftwareListIndex)
SoftwareDisplayName(SoftwareListIndex) = strDisplayName
SoftwareDisplayVersion(SoftwareListIndex) = strDisplayVersion
SoftwarePublisher(SoftwareListIndex) = strPublisher
SoftwareInstallDate(SoftwareListIndex) = strInstallDate
End If
End If
Next
End Function
Function GetOfficeList()
aOffID(0,0) = "XP"
aOffID(0,1) = "10.0"
aOffID(1,0) = "2003"
aOffID(1,1) = "11.0"
aOffID(2,0) = "2007"
aOffID(2,1) = "12.0"
aOffID(3,0) = "2010"
aOffID(3,1) = "14.0"
aOffID(4,0) = "2013"
aOffID(4,1) = "15.0"
aOffID(5,0) = "2016"
aOffID(5,1) = "16.0"
Set oReg = objLocator.ConnectServer(RemoteComputer,"root\default",AuthUserName,AuthPassword,,,,objCtx).Get("StdRegProv")
objCtx.Add "__ProviderArchitecture", 64
osType = 32
oReg.GetStringValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Session Manager\Environment", "PROCESSOR_ARCHITECTURE", osProc
If osProc = "AMD64" Then osType = 64
wow = ""
If osType = "64" Then wow = "WOW6432Node\"
schKey97 "SOFTWARE\" & wow & "Microsoft\"
schKey2K "Office", "SOFTWARE\" & wow & "Microsoft\Office\9.0\", Array("0000","0001","0002","0003","0004","0010","0011","0012","0013","0014","0016","0017","0018","001A","004F"), "78E1-11D2-B60F-006097C998E7"
schKey2K "Visio", "SOFTWARE\" & wow & "Microsoft\Visio\6.0\", Array("B66F45DC"), "853B-11D3-83DE-00C04F3223C8"
For aOffIDX = LBound(aOffID, 1) To UBound(aOffID, 1)
schKey "SOFTWARE\Wow6432Node\Microsoft\Office\" & aOffID(aOffIDX,1) & "\Registration", false
schKey "SOFTWARE\Microsoft\Office\" & aOffID(aOffIDX,1) & "\Registration", True
Next
End Function
Sub schKey97(regKey)
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey & "Office\8.0", "BinDirPath", oDir97
If IsNull(oDir97) Then Exit Sub
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey & "Microsoft Reference\BookshelfF\96L", "PID", oProdID
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey & "Windows\CurrentVersion\Uninstall\Office8.0", "DisplayName", oProd
oInstall = "1"
If IsNull(oProd) Then
oInstall = "0"
oProd = "Microsoft Office 97"
End If
writeXML "97",oProd,oProdID,32,"",oInstall,"",""
End Sub
Sub schKey2K(name, regKey, guid1, guid2)
oProd = Null
oInstall = "0"
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, regKey & "Registration\DigitalProductID", "", aDPIDBytes
oKey = ""
If Not IsNull(aDPIDBytes) Then oKey = DecodeOfficeKey(aDPIDBytes)
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey & "Registration\ProductID", "", oProdID
If IsNull(oProdID) Then Exit Sub
oReg.EnumKey HKEY_LOCAL_MACHINE, "Software\" & wow & "Microsoft\Windows\CurrentVersion\Uninstall\", aKeys
If Not IsNull(aKeys) Then
For Each guid In aKeys
If UCase(Right(guid,Len(guid)-InStr(guid,"-"))) = guid2 & "}" Then
For i = LBound(guid1) To UBound(guid1)
If UCase(Left(guid,Len(guid1(i)) + 1)) = "{" & guid1(i) Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, "Software\" & wow & "Microsoft\Windows\CurrentVersion\Uninstall\" & guid, "DisplayName", oProd
oGUID = guid
oInstall = "1"
End If
Next
End If
Next
End If
If IsNull(oProd) Then oProd = "Microsoft " & name & " 2000"
writeXML "2000",oProd,oProdID,32,oGUID,oInstall,oKey,""
End Sub
Sub schKey(regKey, likeOS)
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, regKey, "DigitalProductID", aDPIDBytes
If IsNull(aDPIDBytes) Then
oReg.EnumKey HKEY_LOCAL_MACHINE, regKey, aGUIDKeys
If Not IsNull(aGUIDKeys) Then
For Each GUIDKey In aGUIDKeys
schKey regKey & "\" & GUIDKey, likeOS
Next
End If
Else
oVer = aOffID(aOffIDX,0)
oProd = Null
oKey = DecodeOfficeKey(aDPIDBytes)
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey, "ProductID", oProdID
oBit = osType
If Not likeOS Then oBit = 32
oGUID = Right(regKey,InStr(StrReverse(regKey),"\")-1)
oInstall = "1"
wow = ""
If Not likeOS Then wow = "WOW6432Node\"
oEdit = ""
If (oVer = "2010" Or oVer = "2013" Or oVer = "2016") Then
For i = 280 to 320 Step 2
If aDPIDBytes(i) <> 0 Then oEdit = oEdit & Chr(aDPIDBytes(i))
Next
End If
oNote = oEdit
If IsNull(oProd) And (oVer = "2010" Or oVer = "2013" Or oVer = "2016") Then
kEdit = UCase(oEdit)
If Mid(oGUID,11,4) = "003D" Then kEdit = "SingleImage"
oReg.GetStringValue HKEY_LOCAL_MACHINE, "Software\" & wow & "Microsoft\Windows\CurrentVersion\Uninstall\Office" & Left(aOffID(aOffIDX,1),2) & "." & kEdit, "DisplayName", oProd
End If
If IsNull(oProd) Then _
oReg.GetStringValue HKEY_LOCAL_MACHINE, "Software\" & wow & "Microsoft\Windows\CurrentVersion\Uninstall\" & oGUID, "DisplayName", oProd
If IsNull(oProd) Then
oInstall = "0"
oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey, "ProductName", oProd
If IsNull(oProd) Then oReg.GetStringValue HKEY_LOCAL_MACHINE, regKey, "ConvertToEdition", oProd
' Office Visio XP
If IsNull(oProd) And (oVer = "XP") Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, "Software\" & wow & "Microsoft\Office\XP\Common\ProductVersion", "LastProduct", pVer
' Original / SP1 / SP2
If ((pVer = "10.0.525") Or (pVer = "10.1.2514") Or (pVer = "10.2.5110")) Then
oProd = "Microsoft Office Visio XP"
End If
End If
' Office Visio Viewer 2003
If IsNull(oProd) And (oVer = "2003") And (oKey = "MF4QD-3T4PM-26X66-4KH7R-QGTYT") Then
oProd = "Microsoft Office Visio Viewer 2003"
End If
If IsNull(oProd) Then oProd = "UnidentIfiable Office " & oVer
End If
writeXML oVer,oProd,oProdID,oBit,oGUID,oInstall,oKey,oNote
End If
End Sub
Sub writeXML(oVer,oProd,oProdID,oBit,oGUID,oInstall,oKey,oNote)
OfficeListIndex = OfficeListIndex + 1
ReDim Preserve OfficeVersion(OfficeListIndex)
ReDim Preserve OfficeProductName(OfficeListIndex)
ReDim Preserve OfficeProductID(OfficeListIndex)
ReDim Preserve OfficeType(OfficeListIndex)
ReDim Preserve OfficeProductKey(OfficeListIndex)
ReDim Preserve OfficeNote(OfficeListIndex)
OfficeVersion(OfficeListIndex) = NullToEmpty(oVer)
OfficeProductName(OfficeListIndex) = NullToEmpty(oProd)
OfficeProductID(OfficeListIndex) = NullToEmpty(oProdID)
OfficeType(OfficeListIndex) = NullToEmpty(oBit)
OfficeProductKey(OfficeListIndex) = NullToEmpty(oKey)
OfficeNote(OfficeListIndex) = NullToEmpty(oNote)
End Sub
Function DecodeOfficeKey(iValues)
Dim arrDPID, foundKeys
arrDPID = Array()
foundKeys = Array()
Select Case (UBound(iValues))
Case 255: ' 2000
range = Array(52,66)
Case 163: ' XP, 2003, 2007
range = Array(52,66)
Case 1271: ' 2010, 2013, 2016
range = Array(808,822)
Case Else
Exit Function
End Select
charset = "BCDFGHJKMPQRTVWXY2346789"
For i = range(0) to range(1)
ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
arrDPID( UBound(arrDPID) ) = iValues(i)
Next
withN = (arrDPID(UBound(arrDPID)) \ 6) And 1
arrDPID(UBound(arrDPID)) = (arrDPID(UBound(arrDPID)) And &HF7) Or ((withN And 2) * 4)
For i = 24 To 0 Step -1
k = 0
For j = 14 To 0 Step -1
k = k * 256 Xor arrDPID(j)
arrDPID(j) = k \ 24
k = k Mod 24
Next
strProductKey = Mid(charset, k+1, 1) & strProductKey
Next
If (withN = 1) Then
keypart = Mid(strProductKey,2,k)
strProductKey = Replace(strProductKey, keypart, keypart & "N", 2, 1, 0)
If k = 0 Then strProductKey = "N" & strProductKey
End If
DecodeOfficeKey = ""
For i = 1 To 25
DecodeOfficeKey = DecodeOfficeKey & Mid(strProductKey,i,1)
If i Mod 5 = 0 And i <> 25 Then DecodeOfficeKey = DecodeOfficeKey & "-"
Next
End Function
Function NullToEmpty(ReturnValue)
If (vartype(ReturnValue) = 1) Then
ReturnValue = ""
End If
NullToEmpty = ReturnValue
End Function
Function GetLastLogonAccount()
Set objNetworkLoginProfile = objServices.ExecQuery("Select * from Win32_NetworkLoginProfile",,48)
LastLogonTime = 0
NextLogonTime = 0
For Each objItem in objNetworkLoginProfile
if ((LCase(objItem.Name) <> ADDomain & "\administrator") and (vartype(objItem.LastLogon) <> 1)) then
if (LastLogonTime = 0) then
if (vartype(objItem.LastLogon) <> 1) then
TempSplit = Split(objItem.LastLogon,".")
LastLogonTime = CDate(ConvertTime(objItem.LastLogon))
LastLogonName = Replace(LCase(objItem.Name),ADDomain & "\","")
end if
else
TempName = Replace(LCase(objItem.Name),ADDomain & "\","")
if (Len(objItem.Name) <> Len(TempName)) then
NextLogonTime = CDate(ConvertTime(objItem.LastLogon))
NextLogonName = TempName
end if
end if
if (NextLogonTime > LastLogonTime) then
LastLogonName = NextLogonName
end if
end if
Next
GetLastLogonAccount = LastLogonName
End Function
function ConvertTime(sTime)
if (sTime="**************.******+***") then
ConvertTime = "0"
else
if (Trim(sTime)="") then
sTime="0"
else
sYear = Mid(sTime,1,4)
sMonth = Mid(sTime,5,2)
sDay = Mid(sTime,7,2)
sHour = Mid(sTime,9,2)
sMin = Mid(sTime,11,2)
sSec = Mid(sTime,13,2)
end if
ConvertTime = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMin & ":" & sSec
end if
end function
function FindStr(Str,Find)
ReturnValue = 0
Str = LCase(Str)
Find = LCase(Find)
if (Str <> replace(Str,Find,"")) then
ReturnValue = 1
end if
FindStr = ReturnValue
end function
Labels:
VBScript
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言