Software List Remote (Enhanced Version)

' ----- 參數設定開始 -----

ADDomain = "contoso"
TargetFilePath = "D:\Info\Data\*.dbd"
GapString = "=====Gap====="
InfoString = "=====Info====="

' 除厝模式: (派送用戶端執行應設為 0)
' 0: 不顯示訊息
' 1: 顯示錯誤訊息
DebugMode = 0

' 資料取得方式 (此參數會在 DB Record 中註記):
' 1: Local - Client Push 檔案給 Server 讀取
' 2: Remote - Server 主動連線取得資料產生檔案
InfoDataType = 2

' 如果資料取得方式是 2: Server 主動連線取得資料產生檔案
' 此處給予客戶端有可能使用的管理員帳號密碼
AuthUserNameString = "contoso\Administrator;administrator;administrator;"
AuthPasswordString = "password;P@$$w0rd;P@$$P@##w0rd;"

' ----- 參數設定結束 -----

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")
Const wbemConnectFlagUseMaxWait = 10
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,,,wbemConnectFlagUseMaxWait,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),,,wbemConnectFlagUseMaxWait,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,,,wbemConnectFlagUseMaxWait,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,,,wbemConnectFlagUseMaxWait,objCtx)
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,,,wbemConnectFlagUseMaxWait,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,,,wbemConnectFlagUseMaxWait,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