|
This is great, but I miss another piece of information that is very useful to me. Actually, I need a data telling me which port the switch was connected to which device.
|
|
|
|
|
Hi ,
Thanks for script , i have try to scan my network pc , but it is showing only my pc
Regards
Ali Mohammed Khan
|
|
|
|
|
Hi Sean,
Could you please advise how I can amend the code to read from a list of servers instead of scanning a subnet.
I would also like to get the NIC config info for each card installed, could you help with that as well.
|
|
|
|
|
Please include this details below VB script....
Monitor 1 brand,Moniter 1 Make,Monitor 1 serial no,
Monitor 2 brand,Moniter 2 Make,Monitor 2 serial no
Warms Regards
Ganesh
IT AssetManagenment Team
|
|
|
|
|
I've been using both this code with modification made from the thread "assetscan" and for the monitor info your wanting and everyone else likely I have found a reliable code and have been using this script>>> "VSB - Get Monitor Serial Number Remotely". we run 4 lcd's per machine and I simply added the headers for the additional monitors this code picked them up and did exactly what we needed it to do.
perhaps someone here with more experience than myself could simply tweak for your request.
http://www.itsupportguides.com/vbs-scripts/vbs-script-get-monitor-serial-number-remotely/[^]
|
|
|
|
|
Please help us am triying out to get complete systems hardware details...Using VB script..
Requesting Please include detail for below script.....
Monitor 1 brand,Moniter 1 Make,Monitor 1 serial no,
Monitor 2 brand,Moniter 2 Make,Monitor 2 serial no
realy help us to get VB output
***********************************************************
On Error Resume Next
CONST wbemFlagReturnImmediately = &h10
CONST wbemFlagForwardOnly = &h20
CONST ForReading = 1
CONST ForWriting = 2
CONST DEV_ID = 0
CONST FSYS = 1
CONST DSIZE = 2
CONST FSPACE = 3
CONST USPACE = 4
CONST TITLE = "AssetScanLite"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath
Dim strDomain, strRole, strMake, strModel, strSerial, _
strBIOSrev, strNICmodel(4), strDateInstalled
outputFile = "IP_table.txt"
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
strDocName = InputBox("What would you like" & _
" to name the output file?", TITLE)
Call IPCREATE()
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
inputFile = "IP_table.txt"
outputFile = "NA_IP.txt"
set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(inputFile, ForReading, True)
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
Function IsConnectible(sHost, iPings, iTO)
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & _
iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, _
FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
If Ask("Run AssetScan now?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
Call BuildXLS()
Call Connect()
Call Footer()
objXL.ActiveWorkbook.SaveAs Scriptpath & _
strDocName & "-AssetScan.xls"
MsgBox "Your inventory run is complete!", _
vbInformation + vbOKOnly, TITLE
Sub IPCREATE()
currentIP = getip()
dim Seps(2)
Seps(0) = "."
Seps(1) = "."
test2 = Tokenize(currentIP, Seps)
strSubIP = test2(0) & "." & test2(1) & "." & test2(2) & "."
strSubIP = InputBox ("Enter Subnet to Scan - ie: 192.168.5." & _
" Press <enter> to Scan Local Subnet", _
Title, strSubIP)
On Error Resume Next
intStartingAddress = InputBox ("Start at :", _
"Scanning Subnet: "&strSubIP, 61)
intEndingAddress = InputBox ("End at :", "Scanning Subnet: "_
& strSubIP&intStartingAddress, 254)
For i = intStartingAddress to intEndingAddress
strComputer = strSubIP & i
fx.WriteLine(strSubIP & i)
Next
End Sub
Function Tokenize(byVal TokenString, byRef TokenSeparators())
Dim NumWords, a()
NumWords = 0
Dim NumSeps
NumSeps = UBound(TokenSeparators)
Do
Dim SepIndex, SepPosition
SepPosition = 0
SepIndex = -1
for i = 0 to NumSeps-1
Dim pos
pos = InStr(TokenString, TokenSeparators(i))
If pos > 0 and ( (SepPosition = 0) or _
(pos < SepPosition) ) Then
SepPosition = pos
SepIndex = i
End If
Next
If SepIndex < 0 Then
redim preserve a(NumWords+1)
a(NumWords) = TokenString
Else
Dim substr
substr = Trim(Left(TokenString, SepPosition-1))
redim preserve a(NumWords+1)
a(NumWords) = substr
Dim TrimPosition
TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
TokenString = Trim(Mid(TokenString, TrimPosition))
End If
NumWords = NumWords + 1
loop while (SepIndex >= 0)
Tokenize = a
End Function
Function GetIP()
Dim ws : Set ws = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP
If ws.Environment("SYSTEM")("OS") = "" Then
ws.run "winipcfg /batch " & TmpFile, 0, True
Else
ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If
With fso.GetFile(TmpFile).OpenAsTextStream
Do While NOT .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then
IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
Loop
.Close
End With
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If
GetIP = IP
fso.GetFile(TmpFile).Delete
Set fso = Nothing
Set ws = Nothing
End Function
function TranslateDomainRole(byVal roleID)
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
end function
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
Call Error()
Else
On Error Resume Next
set oWMI = GetObject("winmgmts:{impersonation" & _
"Level=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
Call Error()
Else
strCompName = UCase(strPC)
set HostName = oWMI.ExecQuery("select DNSHostName" & _
" from Win32_NetworkAdapterConfiguration" & _
" where IPEnabled=TRUE")
for each Host in HostName
strHostName = Host.DNSHostName
Next
Set colItems = _
oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", _
"WQL",wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strDomain = objItem.Domain
strRole = TranslateDomainRole(objItem.DomainRole)
Next
Set colItems = oWMI.ExecQuery("SELECT * FROM" & _
" Win32_ComputerSystemProduct", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strSerial = objItem.IdentifyingNumber
strModel = objItem.Name
strMake = objItem.Vendor
Next
set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, "_
& "TotalVirtualMemory, TotalPageFileSpace from "_
& "Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = _
FormatNumber(Memory.TotalPhysicalMemory/1024,1)_
& " Mb"
Next
set OSSet = oWMI.ExecQuery("select Caption, " & _
"CSDVersion, SerialNumber " & _
"from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
Next
Set colSettings = _
oWMI.ExecQuery ("Select * from Win32_BIOS")
For Each objBIOS in colSettings
strBIOSrev = objBIOS.Version
Next
set ProSet = oWMI.ExecQuery("select Name," & _
" MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed & " MHZ"
Next
set loggeduser = oWMI.ExecQuery("select UserName" & _
" from Win32_ComputerSystem")
for each logged in loggeduser
struser = logged.UserName
Next
Set colSettings = oWMI.ExecQuery ("Select *" & _
" from Win32_NetworkAdapter")
i=1
For Each objComputer in colSettings
if ObjComputer.AdapterType = "Ethernet 802.3" Then
strNICmodel(i-1) = strMsg & _
"Interface["& i & "]: " & ObjComputer.Name
i=i+1
End if
NEXT
set IPConfigSet = oWMI.ExecQuery("select ServiceName," & _
" IPAddress, " & "IPSubnet, DefaultIPGateway," & _
" MACAddress from " & _
"Win32_NetworkAdapterConfiguration" & _
" where IPEnabled=TRUE")
Count = 0
for each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
for each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
Set colSettings = oWMI.ExecQuery ("Select *" & _
" from Win32_OperatingSystem")
For Each objComputer in colSettings
strDateInstalled = Objcomputer.InstallDate
NEXT
set DiskSet = oWMI.ExecQuery("select DeviceID," & _
" FileSystem, Size, FreeSpace " & _
"from Win32_LogicalDisk where DriveType = '3'")
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
Call AddLineToXLS(strCompName, strHostName, _
strDomain, strRole, strMake, strModel, _
strSerial, strRAM, strOS, strSP, _
strBIOSrev, strProc, strSpeed, struser, _
strMask, strGate, strMAC, _
strDateInstalled, strNICmodel)
Next
End If
End If
End If
Loop
End Sub
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = " AssetScan Inventory"
objXL.Rows(1).RowHeight = 25
objXL.Columns(1).ColumnWidth = 9
objXL.Columns(2).ColumnWidth = 14
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 17
objXL.Columns(5).ColumnWidth = 16
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 15
objXL.Columns(8).ColumnWidth = 7
objXL.Columns(9).ColumnWidth = 26
objXL.Columns(10).ColumnWidth = 12
objXL.Columns(11).ColumnWidth = 14
objXL.Columns(12).ColumnWidth = 24
objXL.Columns(13).ColumnWidth = 15
objXL.Columns(14).ColumnWidth = 19
objXL.Columns(15).ColumnWidth = 11
objXL.Columns(16).ColumnWidth = 11
objXL.Columns(17).ColumnWidth = 14
objXL.Columns(18).ColumnWidth = 22
objXL.Columns(19).ColumnWidth = 37
objXL.Columns(20).ColumnWidth = 35
objXL.Columns(21).ColumnWidth = 35
objXL.Columns(22).ColumnWidth = 35
objXL.Columns(23).ColumnWidth = 35
objXL.Range("A1:Z1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:Z").Select
objXL.Selection.HorizontalAlignment = 3
dim arrNicTitle(4)
arrNicTitle(0) = "NIC #1 Model"
arrNicTitle(1) = "NIC #2 Model"
arrNicTitle(2) = "NIC #3 Model"
arrNicTitle(3) = "NIC #4 Model"
arrNicTitle(4) = "NIC #5 Model"
Call AddLineToXLS("IP Address" , "Hostname" , _
"Domain" , "Role" , "Make" , "Model" , "Serial Number" , _
"RAM" , "Operating System" , "Service Pack" , _
"BIOS Revision" , "Processor Type" , "Processor Speed", _
"Logged in user" , "Subnet Mask" , "Default Gateway", _
"MAC Address", "Date Installed", arrNicTitle)
End Sub
objXL.Columns("A:AA").Select
objXL.Selection.HorizontalAlignment = 3
objXL.Selection.Font.Size = 8
Sub AddLineToXLS(strCompName, strHostName, strDomain, _
strRole, strMake, strModel, strSerial, strRAM, _
strOS, strSP, strBIOSrev, strProc, strSpeed, struser, _
strMask, strGate, strMAC, strDateInstalled, byRef strNICmodel)
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strHostName
objXL.Cells(intRow, 3).Value = strDomain
objXL.Cells(intRow, 4).Value = strRole
objXL.Cells(intRow, 5).Value = strMake
objXL.Cells(intRow, 6).Value = strModel
objXL.Cells(intRow, 7).Value = strSerial
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strOS
objXL.Cells(intRow, 10).Value = strSP
objXL.Cells(intRow, 11).Value = strBIOSrev
objXL.Cells(intRow, 12).Value = strProc
objXL.Cells(intRow, 13).Value = strSpeed
objXL.Cells(intRow, 14).Value = struser
objXL.Cells(intRow, 15).Value = strMask
objXL.Cells(intRow, 16).Value = strGate
objXL.Cells(intRow, 17).Value = strMAC
objXL.Cells(intRow, 18).Value = strDateInstalled
objXL.Cells(intRow, 19).Value = strNICmodel(0)
objXL.Cells(intRow, 20).Value = strNICmodel(1)
objXL.Cells(intRow, 21).Value = strNICmodel(2)
objXL.Cells(intRow, 22).Value = strNICmodel(3)
objXL.Cells(intRow, 23).Value = strNICmodel(4)
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)
objXL.Cells(intRow, 11).Value = strDEV_ID
objXL.Cells(intRow, 12).Value = strFSYS
objXL.Cells(intRow, 13).Value = strDSIZE
objXL.Cells(intRow, 14).Value = strFSPACE
objXL.Cells(intRow, 15).Value = strUSPACE
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
Sub Footer()
strFooter1 = "Inventory AssetScan"
strFooter2 = "Script was created by Sean Kelly" & _
" and is free for personal/small business use"
strComplete = "Inventory run completed at: " & Date & " at " & time
intRow = intRow + 4
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2
objXL.Cells(intRow, 4).Value = strFooter1
intRow = intRow + 1
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2
objXL.Cells(intRow, 4).Value = strFooter2
intRow = intRow + 1
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2
objXL.Cells(intRow, 4).Value = strStart
intRow = intRow + 1
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2
objXL.Cells(intRow, 4).Value = strComplete
intRow = intRow + 1
End Sub
Sub Error()
fx.WriteLine(strPC)
End Sub
|
|
|
|
|
This is a great and fully functional source code. I am really impressed with your work. Can you use sql tables instead of excel spreadsheet to store the information?
|
|
|
|
|
New update (You have now a software list added)
Added the follwing
Software List
Vesion
Patches
Fixes
UsageKeys
If there anybody have the idea to separate the software in a column.
Also My suggestion to make a dynamic creation of Column instead to add NIC #1 NIC #2…….
I mean a column will be created dynamically if more than one NIC founded
The same for the software List
Don’t forget my last question to display the error in the row fiels
Thank You
The new update tested successfully
'***********************************************************
'AssetScan.vbs - Query PC's on your network with WMI and log
'the responses into an excel spreadsheet.
'
'© Sean Kelly - skelly@engineer.com
' rev 12 April 2005
'
' works with Windows NT, 2K, XP
'***********************************************************
On Error Resume Next
'***** DECLARATIONS*****************************
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Const ForReading = 1
Const ForWriting = 2
Const TITLE = "AssetScanLite"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB, strSubIP
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD, strKeyPath, strValueName
Dim strRAM, strRAMUsed, strRAMFree, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser, retStrr
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName, strDateTime
Dim pathlength, Scriptpath
Dim strDomain, strRole, strMake, strModel, strSerial, strBIOSrev, strNICmodel(4), strDateInstalled, strHDD
Dim intStartingAddress, intEndingAddress
intStartingAddress = -1
intEndingAddress = -1
set objArgs = WScript.Arguments
For each strArg in objArgs
If InStr(strArg,"output=") > 0 Then
strDocName = Replace(strArg,"output=","")
ElseIf InStr(strArg,"subnet=") > 0 Then
strSubIP = Replace(strArg,"subnet=","")
ElseIf InStr(strArg,"start=") > 0 Then
intStartingAddress = Replace(strArg,"start=","")
ElseIf InStr(strArg,"end=") > 0 Then
intEndingAddress = Replace(strArg,"end=","")
End If
next
outputFile = "IP_table.txt"
Set fsox = CreateObject("Scripting.FileSystemObject")
Set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
If strDocName = "" Then
' What is the name of the output file?
strDocName = InputBox ("What would you like to name the output file?", TITLE)
'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
strDocName = Scriptpath & strDocName & ".xls"
End If
' Create IP list to scan
Call IPCREATE()
Set adsi = CreateObject("ADSystemInfo")
Set wscr = CreateObject("WScript.Network")
inputFile = "IP_table.txt"
outputFile = "NA_IP.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(inputFile, ForReading, True)
Set fsox = CreateObject("Scripting.FileSystemObject")
Set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
'*****[ FUNCTIONS ]*******************************
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
Function IsConnectible(sHost, iPings, iTO)
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
'===========
Function addCategoryData(outputText, category, data)
'For handling problem when data contains &
pos=InStr(data,"&")
if pos>0 Then
data = Replace(data,"&","###AND###")
end if
'For handling problem when data contains <
pos=InStr(data,"<")
if pos>0 Then
data = Replace(data,"<","###[###")
end if
'For handling problem when data contains >
pos=InStr(data,">")
if pos>0 Then
data = Replace(data,">","###]###")
end if
'For handling problem when data contains DOUBLEQUOTE
pos=InStr(data,doubleQuote)
if pos>0 Then
data = Replace(data,doubleQuote,"###DQ###")
end if
retStrr = outputText
if NOT ISNULL(data) then
retStrr = retStrr & spaceString
retStrr = retStrr & category
retStrr = retStrr & equalString
retStrr = retStrr & doubleQuote
retStrr = retStrr & Trim(data)
retStrr = retStrr & doubleQuote
end if
addCategoryData=retStrr
End Function
'*****[ MAIN SCRIPT ]*****************************
If WScript.Arguments.Count = 0 Then
If Ask("Run AssetScan now?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
End If
Call BuildXLS()
Call Connect()
objXL.DisplayAlerts = False
objXL.AlertBeforeOverwriting = False
objXL.ActiveWorkbook.SaveAs strDocName
objXL.ActiveWorkbook.Close
If WScript.Arguments.Count = 0 Then
MsgBox "Your inventory run is complete!", vbInformation + vbOKOnly, TITLE
End If
'*****[ SUB ROUTINES ]****************************
'*** Subroutine create ip table
Sub IPCREATE()
If strSubIP = "" Then
currentIP = getip()
Dim Seps(2)
Seps(0) = "."
Seps(1) = "."
test2 = Tokenize(currentIP, Seps)
strSubIP = test2(0) & "." & test2(1) & "." & test2(2) & "."
strSubIP = InputBox ("Enter Subnet to Scan - ie: 192.168.5. Press <enter> to Scan Local Subnet", Title, strSubIP)
On Error Resume Next
End If
If intStartingAddress = -1 Then
intStartingAddress = InputBox ("Start at :", "Scanning Subnet: "&strSubIP, 1)
End If
If intEndingAddress = -1 Then
intEndingAddress = InputBox ("End at :", "Scanning Subnet: "&strSubIP&intStartingAddress, 200)
End If
For i = intStartingAddress to intEndingAddress
strComputer = strSubIP & i
fx.WriteLine(strComputer)
Next
End Sub
Function Tokenize(byVal TokenString, byRef TokenSeparators())
Dim NumWords, a()
NumWords = 0
Dim NumSeps
NumSeps = UBound(TokenSeparators)
Do
Dim SepIndex, SepPosition
SepPosition = 0
SepIndex = -1
For i = 0 to NumSeps-1
' Find location of separator in the string
Dim pos
pos = InStr(TokenString, TokenSeparators(i))
' Is the separator present, and is it closest to the beginning of the string?
If pos > 0 and ( (SepPosition = 0) or (pos < SepPosition) ) Then
SepPosition = pos
SepIndex = i
End If
Next
' Did we find any separators?
If SepIndex < 0 Then
' None found - so the token is the remaining string
ReDim preserve a(NumWords+1)
a(NumWords) = TokenString
Else
' Found a token - pull out the substring
Dim substr
substr = Trim(Left(TokenString, SepPosition-1))
' Add the token to the list
ReDim preserve a(NumWords+1)
a(NumWords) = substr
' Cutoff the token we just found
Dim TrimPosition
TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
TokenString = Trim(Mid(TokenString, TrimPosition))
End If
NumWords = NumWords + 1
Loop While (SepIndex >= 0)
Tokenize = a
End Function
Function GetIP()
Dim ws : Set ws = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP
If ws.Environment("SYSTEM")("OS") = "" Then
ws.run "winipcfg /batch " & TmpFile, 0, True
Else
ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If
With fso.GetFile(TmpFile).OpenAsTextStream
Do While NOT .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
Loop
.Close
End With
'WinXP (NT? 2K?) leaves a carriage return at the end of line
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If
GetIP = IP
fso.GetFile(TmpFile).Delete
Set fso = Nothing
Set ws = Nothing
End Function
function TranslateDomainRole(byVal roleID)
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
End function
'*********************************************************
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
'Call MsgNoPing()
Call Error()
Else
On Error Resume Next
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
'Call MsgNoConnect()
Call Error()
Else
'Get IP Address and "fix" it so that it is easily sorted
Dim parts
parts = Split(strPC,".")
StrCompName = FixIP(Parts(0)) & "." & FixIP(Parts(1)) & "." & FixIP(Parts(2)) & "." & FixIP(Parts(3))
'Get Hostname
Set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For each Host in HostName
strHostName = Host.DNSHostName
Next
'Get Domain and Role
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strDomain = objItem.Domain
strRole = TranslateDomainRole(objItem.DomainRole)
Next
'Get Make, Model, Serial Number
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strSerial = objItem.IdentifyingNumber
strModel = objItem.Name
strMake = objItem.Vendor
Next
'Get RAM (Total)
'Set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory from " & "Win32_LogicalMemoryConfiguration")
Set MemorySet = oWMI.ExecQuery("select TotalVisibleMemorySize, FreePhysicalMemory from Win32_OperatingSystem")
For each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalVisibleMemorySize/1024,1)
strRAMFree = FormatNumber(Memory.FreePhysicalMemory/1024,1)
strRAMUsed = FormatNumber((Memory.TotalVisibleMemorySize - Memory.FreePhysicalMemory)/1024,1)
Next
'Get Operating System and Service Pack Info
Set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber " & "from Win32_OperatingSystem")
For each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
Next
'Get BIOS Revision
Set colSettings = oWMI.ExecQuery ("Select * from Win32_BIOS")
For Each objBIOS in colSettings
strBIOSrev = objBIOS.Version
Next
'Get Processor Type
Set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
For each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed
Next
'SoftwareList Info
'=================
softwareDataText="<Software_Info>"
softwareDataText = softwareDataText & "<InstalledProgramsList>"
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
count=0
If NOT ISNULL(arrSubKeys) then
For Each subkey In arrSubKeys
subkeyPath = strKeyPath & "\" & subkey
objReg.GetStringValue HKEY_LOCAL_MACHINE, subkeyPath, "DisplayName", softwareName
objReg.GetStringValue HKEY_LOCAL_MACHINE, subkeyPath, "DisplayVersion", softwareVersion
objReg.GetStringValue HKEY_LOCAL_MACHINE, subkeyPath, "Publisher", softwarePublisher
objReg.GetStringValue HKEY_LOCAL_MACHINE, subkeyPath, "InstallDate", softwareInstallDate
keyForSoftwareUsage = "SOFTWARE\Microsoft\Windows\CurrentVersion\App Management\ARPCache\" & subkey
objReg.GetBinaryValue HKEY_LOCAL_MACHINE, keyForSoftwareUsage, "SlowInfoCache", usageData
swUsage = getSoftwareUsage(usageData)
if(softwareName <> "") then
count=count+1
softwareDataText = softwareDataText & "<Software_" & count & " "
softwareDataText = addCategoryData(softwareDataText, "Name", softwareName)
softwareDataText = addCategoryData(softwareDataText, "Version", softwareVersion)
softwareDataText = addCategoryData(softwareDataText, "Vendor", softwarePublisher)
softwareDataText = addCategoryData(softwareDataText, "InstallDate", softwareInstallDate)
softwareDataText = addCategoryData(softwareDataText, "Usage", swUsage)
softwareDataText = addCategoryData(softwareDataText, "Key", subkey)
softwareDataText = softwareDataText & "/>"
end if
Next
end if
softwareDataText = softwareDataText & "</InstalledProgramsList>"
'===========================================================
'Get Logged in user
Set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
For each logged in loggeduser
struser = logged.UserName
Next
'Get NIC Model 'ISOLATE PRIMARY NIC INFO
Set colSettings = oWMI.ExecQuery ("Select * from Win32_NetworkAdapter")
i=1
For Each objComputer in colSettings
If ObjComputer.AdapterType = "Ethernet 802.3" Then
strNICmodel(i-1) = strMsg & "Interface["& i & "]: " & ObjComputer.Name
i=i+1
End if
Next
'Get Subnet Mask, MAC Address, Default Gateway
Set IPConfigSet = oWMI.ExecQuery("select ServiceName, IPAddress, " & "IPSubnet, DefaultIPGateway, MACAddress from " & "Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
For each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
For each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
'Date Installed
Set colSettings = oWMI.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objComputer in colSettings
strDateInstalled = Objcomputer.InstallDate
Next
'Add line for each hard disk
Set DiskSet = oWMI.ExecQuery("select FreeSpace " & "from Win32_LogicalDisk where DriveType = '3'")
Dim strTempName, intCount
intCount = 0
strTempName = strHostName
For each Disk in DiskSet
If DiskSet.Count > 1 Then
intCount = intCount + 1
strTempName = strHostName & "(" & intCount & ")"
End If
Call AddLineToXLS(strCompName, strTempName, strDomain, strRole, strMake, _
strModel, strSerial, strRAM, strRAMFree, strRAMUsed, strOS, strSP, strBIOSrev, strProc, strSpeed, struser, _
strMask, strGate, strMAC, strDateInstalled, FormatNumber(Disk.FreeSpace/1024/1024), strNICmodel, Date & " - " & Time,softwareDataText )
Next
End If
End If
End If
Loop
End Sub
Function FixIP(Part)
If Len(Part) = 1 Then
Part = "00" & Part
ElseIf Len(Part) = 2 Then
Part = "0" & Part
End If
FixIP = Part
End Function
'*** Subroutine to Build XLS ***
Sub BuildXLS()
intRow = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXL = Wscript.CreateObject("Excel.Application")
If objFSO.FileExists(strDocName) Then
objXL.WorkBooks.Open(strDocName)
objXL.Sheets("Hardware Inventory").Select()
Else
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Hardware Inventory"
'** Set Row Height
objXL.Rows(1).RowHeight = 25
'** Set Column widths
objXL.Columns(1).ColumnWidth = 9
objXL.Columns(2).ColumnWidth = 14
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 17
objXL.Columns(5).ColumnWidth = 16
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 15
objXL.Columns(8).ColumnWidth = 10
objXL.Columns(9).ColumnWidth = 10
objXL.Columns(10).ColumnWidth = 10
objXL.Columns(11).ColumnWidth = 26
objXL.Columns(12).ColumnWidth = 12
objXL.Columns(13).ColumnWidth = 14
objXL.Columns(14).ColumnWidth = 24
objXL.Columns(15).ColumnWidth = 15
objXL.Columns(16).ColumnWidth = 19
objXL.Columns(17).ColumnWidth = 11
objXL.Columns(18).ColumnWidth = 11
objXL.Columns(19).ColumnWidth = 14
objXL.Columns(20).ColumnWidth = 22
objXL.Columns(21).ColumnWidth = 37
objXL.Columns(22).ColumnWidth = 35
objXL.Columns(23).ColumnWidth = 35
objXL.Columns(24).ColumnWidth = 35
objXL.Columns(25).ColumnWidth = 35
objXL.Columns(26).ColumnWidth = 35
objXL.Columns(27).ColumnWidth = 20
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:AB1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:AC").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
'*** Set Column Titles ***
Dim arrNicTitle(4)
arrNicTitle(0) = "NIC #1 Model"
arrNicTitle(1) = "NIC #2 Model"
arrNicTitle(2) = "NIC #3 Model"
arrNicTitle(3) = "NIC #4 Model"
arrNicTitle(4) = "NIC #5 Model"
' 15,16,17
Call AddLineToXLS("IP Address" , "Hostname" , "Domain" , "Role" , "Make" , "Model" , "Serial Number" , _
"RAM" , "RAM Free" , "RAM Used" , "Operating System" , "Service Pack" , "BIOS Revision" , "Processor Type" , "Processor Speed", _
"Logged in user" , "Subnet Mask" , "Default Gateway" , "MAC Address", "Date Installed","HDD", arrNicTitle, "Date & Time", "office")
End If
If WScript.Arguments.Count = 0 Then
objXL.Visible = True
Else
objXL.Visible = False
End If
End Sub
'=======================
'*** Subroutine Add Lines to XLS ***
objXL.Columns("A:AC").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 8
Sub AddLineToXLS(strCompName, strHostName, strDomain, strRole, strMake, strModel, strSerial, strRAM, strRAMFree, strRAMUsed, _
strOS, strSP, strBIOSrev, strProc, strSpeed, struser, strMask, strGate, strMAC, strDateInstalled, strHDD, byRef strNICmodel, strDateTime, retStrr )
If strHostName = "Hostname" Then
intRow = 1
Else
Set found = objXL.Sheets("Hardware Inventory").Cells.Find(strHostName)
If found Is Nothing Then
intRow = objXL.Sheets("Hardware Inventory").UsedRange.Rows.Count + 1
Else
intRow = found.Row
End If
End If
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strHostName
objXL.Cells(intRow, 3).Value = strDomain
objXL.Cells(intRow, 4).Value = strRole
objXL.Cells(intRow, 5).Value = strMake
objXL.Cells(intRow, 6).Value = strModel
objXL.Cells(intRow, 7).Value = strSerial
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strRAMFree
objXL.Cells(intRow, 10).Value = strRAMUsed
objXL.Cells(intRow, 11).Value = strOS
objXL.Cells(intRow, 12).Value = strSP
objXL.Cells(intRow, 13).Value = strBIOSrev
objXL.Cells(intRow, 14).Value = strProc
objXL.Cells(intRow, 15).Value = strSpeed
objXL.Cells(intRow, 16).Value = struser
objXL.Cells(intRow, 17).Value = strMask
objXL.Cells(intRow, 18).Value = strGate
objXL.Cells(intRow, 19).Value = strMAC
objXL.Cells(intRow, 20).Value = strDateInstalled
objXL.Cells(intRow, 21).Value = strHDD
objXL.Cells(intRow, 22).Value = strNICmodel(0)
objXL.Cells(intRow, 23).Value = strNICmodel(1)
objXL.Cells(intRow, 24).Value = strNICmodel(2)
objXL.Cells(intRow, 25).Value = strNICmodel(3)
objXL.Cells(intRow, 26).Value = strNICmodel(4)
objXL.Cells(intRow, 27).Value = strDateTime
objXL.Cells(intRow, 27).Value = retStrr
End Sub
'*** ErrorHandler ***
Sub Error()
fx.WriteLine(strPC)
End Sub
|
|
|
|
|
Great Job,
Is there any idea how to fill the error information into the host row
Some times i gather all the host information
Some time not all while all the computers running and working properley
can we expand the time out
thank you
|
|
|
|
|
Fantastic script, this thing as saved me about 200 hours of audits.
Odd issue I am getting, sometimes there are double entries for the same machine.
Another thing that would be nice to see added is to have it show IP's that came up with no ping. Reason for this is that the machine could be off, and the audit wouldn't get the info. If it still listed the IP then I could go back and find the machine and turn it on. Or find out why it wasn't scanning.
Once again fantastic Script!
Harm|
|
|
|
|
|
I have modified the script with the following:
1). Command-line parameters for silent-mode
example:
AssetScan.vbs output="C:\AssetScan\Computer Inventory.xls" subnet=192.168.1. start=1 end=100
You can use Scheduled Tasks to run this regularly and keep your inventory up-to-date.
2). Retention of old inventory items when using an existing file. It will now search the file by the HostName and update the item with the new information.
3). Added a Date & Time field to help identify old systems for removal from the inventory.
4). Added RAM Free, and RAM Used fields to help identify systems that require memory upgrades.
5). Removed the Footer, so that new computers could be easily added to an existing inventory.
6). Fixed the hard drive routine to add an inventory line for each hard drive in the system.
7). Removed "MB" from RAM and HD fields (for better sorting).
I think that's everything.
'***********************************************************
'AssetScan.vbs - Query PC's on your network with WMI and log
'the responses into an excel spreadsheet.
'
'© Sean Kelly - skelly@engineer.com
' rev 12 April 2005
'
' works with Windows NT, 2K, XP
On Error Resume Next
'***** DECLARATIONS*****************************
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Const ForReading = 1
Const ForWriting = 2
Const TITLE = "AssetScanLite"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB, strSubIP
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD, strKeyPath, strValueName
Dim strRAM, strRAMUsed, strRAMFree, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName, strDateTime
Dim pathlength, Scriptpath
Dim strDomain, strRole, strMake, strModel, strSerial, strBIOSrev, strNICmodel(4), strDateInstalled, strHDD
Dim intStartingAddress, intEndingAddress
intStartingAddress = -1
intEndingAddress = -1
set objArgs = WScript.Arguments
For each strArg in objArgs
If InStr(strArg,"output=") > 0 Then
strDocName = Replace(strArg,"output=","")
ElseIf InStr(strArg,"subnet=") > 0 Then
strSubIP = Replace(strArg,"subnet=","")
ElseIf InStr(strArg,"start=") > 0 Then
intStartingAddress = Replace(strArg,"start=","")
ElseIf InStr(strArg,"end=") > 0 Then
intEndingAddress = Replace(strArg,"end=","")
End If
next
outputFile = "IP_table.txt"
Set fsox = CreateObject("Scripting.FileSystemObject")
Set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
If strDocName = "" Then
' What is the name of the output file?
strDocName = InputBox ("What would you like to name the output file?", TITLE)
'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
strDocName = Scriptpath & strDocName & ".xls"
End If
' Create IP list to scan
Call IPCREATE()
Set adsi = CreateObject("ADSystemInfo")
Set wscr = CreateObject("WScript.Network")
inputFile = "IP_table.txt"
outputFile = "NA_IP.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(inputFile, ForReading, True)
Set fsox = CreateObject("Scripting.FileSystemObject")
Set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
'*****[ FUNCTIONS ]*******************************
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
Function IsConnectible(sHost, iPings, iTO)
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
'*****[ MAIN SCRIPT ]*****************************
If WScript.Arguments.Count = 0 Then
If Ask("Run AssetScan now?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
End If
Call BuildXLS()
Call Connect()
objXL.DisplayAlerts = False
objXL.AlertBeforeOverwriting = False
objXL.ActiveWorkbook.SaveAs strDocName
objXL.ActiveWorkbook.Close
If WScript.Arguments.Count = 0 Then
MsgBox "Your inventory run is complete!", vbInformation + vbOKOnly, TITLE
End If
'*****[ SUB ROUTINES ]****************************
'*** Subroutine create ip table
Sub IPCREATE()
If strSubIP = "" Then
currentIP = getip()
Dim Seps(2)
Seps(0) = "."
Seps(1) = "."
test2 = Tokenize(currentIP, Seps)
strSubIP = test2(0) & "." & test2(1) & "." & test2(2) & "."
strSubIP = InputBox ("Enter Subnet to Scan - ie: 192.168.5. Press <enter> to Scan Local Subnet", Title, strSubIP)
On Error Resume Next
End If
If intStartingAddress = -1 Then
intStartingAddress = InputBox ("Start at :", "Scanning Subnet: "&strSubIP, 1)
End If
If intEndingAddress = -1 Then
intEndingAddress = InputBox ("End at :", "Scanning Subnet: "&strSubIP&intStartingAddress, 200)
End If
For i = intStartingAddress to intEndingAddress
strComputer = strSubIP & i
fx.WriteLine(strComputer)
Next
End Sub
Function Tokenize(byVal TokenString, byRef TokenSeparators())
Dim NumWords, a()
NumWords = 0
Dim NumSeps
NumSeps = UBound(TokenSeparators)
Do
Dim SepIndex, SepPosition
SepPosition = 0
SepIndex = -1
For i = 0 to NumSeps-1
' Find location of separator in the string
Dim pos
pos = InStr(TokenString, TokenSeparators(i))
' Is the separator present, and is it closest to the beginning of the string?
If pos > 0 and ( (SepPosition = 0) or (pos < SepPosition) ) Then
SepPosition = pos
SepIndex = i
End If
Next
' Did we find any separators?
If SepIndex < 0 Then
' None found - so the token is the remaining string
ReDim preserve a(NumWords+1)
a(NumWords) = TokenString
Else
' Found a token - pull out the substring
Dim substr
substr = Trim(Left(TokenString, SepPosition-1))
' Add the token to the list
ReDim preserve a(NumWords+1)
a(NumWords) = substr
' Cutoff the token we just found
Dim TrimPosition
TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
TokenString = Trim(Mid(TokenString, TrimPosition))
End If
NumWords = NumWords + 1
Loop While (SepIndex >= 0)
Tokenize = a
End Function
Function GetIP()
Dim ws : Set ws = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP
If ws.Environment("SYSTEM")("OS") = "" Then
ws.run "winipcfg /batch " & TmpFile, 0, True
Else
ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If
With fso.GetFile(TmpFile).OpenAsTextStream
Do While NOT .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
Loop
.Close
End With
'WinXP (NT? 2K?) leaves a carriage return at the end of line
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If
GetIP = IP
fso.GetFile(TmpFile).Delete
Set fso = Nothing
Set ws = Nothing
End Function
function TranslateDomainRole(byVal roleID)
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
End function
'*********************************************************
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
'Call MsgNoPing()
Call Error()
Else
On Error Resume Next
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
'Call MsgNoConnect()
Call Error()
Else
'Get IP Address and "fix" it so that it is easily sorted
Dim parts
parts = Split(strPC,".")
StrCompName = FixIP(Parts(0)) & "." & FixIP(Parts(1)) & "." & FixIP(Parts(2)) & "." & FixIP(Parts(3))
'Get Hostname
Set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For each Host in HostName
strHostName = Host.DNSHostName
Next
'Get Domain and Role
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strDomain = objItem.Domain
strRole = TranslateDomainRole(objItem.DomainRole)
Next
'Get Make, Model, Serial Number
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strSerial = objItem.IdentifyingNumber
strModel = objItem.Name
strMake = objItem.Vendor
Next
'Get RAM (Total)
'Set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory from " & "Win32_LogicalMemoryConfiguration")
Set MemorySet = oWMI.ExecQuery("select TotalVisibleMemorySize, FreePhysicalMemory from Win32_OperatingSystem")
For each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalVisibleMemorySize/1024,1)
strRAMFree = FormatNumber(Memory.FreePhysicalMemory/1024,1)
strRAMUsed = FormatNumber((Memory.TotalVisibleMemorySize - Memory.FreePhysicalMemory)/1024,1)
Next
'Get Operating System and Service Pack Info
Set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber " & "from Win32_OperatingSystem")
For each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
Next
'Get BIOS Revision
Set colSettings = oWMI.ExecQuery ("Select * from Win32_BIOS")
For Each objBIOS in colSettings
strBIOSrev = objBIOS.Version
Next
'Get Processor Type
Set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
For each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed
Next
'Get Logged in user
Set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
For each logged in loggeduser
struser = logged.UserName
Next
'Get NIC Model 'ISOLATE PRIMARY NIC INFO
Set colSettings = oWMI.ExecQuery ("Select * from Win32_NetworkAdapter")
i=1
For Each objComputer in colSettings
If ObjComputer.AdapterType = "Ethernet 802.3" Then
strNICmodel(i-1) = strMsg & "Interface["& i & "]: " & ObjComputer.Name
i=i+1
End if
Next
'Get Subnet Mask, MAC Address, Default Gateway
Set IPConfigSet = oWMI.ExecQuery("select ServiceName, IPAddress, " & "IPSubnet, DefaultIPGateway, MACAddress from " & "Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
For each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
For each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
'Date Installed
Set colSettings = oWMI.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objComputer in colSettings
strDateInstalled = Objcomputer.InstallDate
Next
'Add line for each hard disk
Set DiskSet = oWMI.ExecQuery("select FreeSpace " & "from Win32_LogicalDisk where DriveType = '3'")
Dim strTempName, intCount
intCount = 0
strTempName = strHostName
For each Disk in DiskSet
If DiskSet.Count > 1 Then
intCount = intCount + 1
strTempName = strHostName & "(" & intCount & ")"
End If
Call AddLineToXLS(strCompName, strTempName, strDomain, strRole, strMake, _
strModel, strSerial, strRAM, strRAMFree, strRAMUsed, strOS, strSP, strBIOSrev, strProc, strSpeed, struser, _
strMask, strGate, strMAC, strDateInstalled, FormatNumber(Disk.FreeSpace/1024/1024), strNICmodel, Date & " - " & Time)
Next
End If
End If
End If
Loop
End Sub
Function FixIP(Part)
If Len(Part) = 1 Then
Part = "00" & Part
ElseIf Len(Part) = 2 Then
Part = "0" & Part
End If
FixIP = Part
End Function
'*** Subroutine to Build XLS ***
Sub BuildXLS()
intRow = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXL = Wscript.CreateObject("Excel.Application")
If objFSO.FileExists(strDocName) Then
objXL.WorkBooks.Open(strDocName)
objXL.Sheets("Hardware Inventory").Select()
Else
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Hardware Inventory"
'** Set Row Height
objXL.Rows(1).RowHeight = 25
'** Set Column widths
objXL.Columns(1).ColumnWidth = 9
objXL.Columns(2).ColumnWidth = 14
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 17
objXL.Columns(5).ColumnWidth = 16
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 15
objXL.Columns(8).ColumnWidth = 10
objXL.Columns(9).ColumnWidth = 10
objXL.Columns(10).ColumnWidth = 10
objXL.Columns(11).ColumnWidth = 26
objXL.Columns(12).ColumnWidth = 12
objXL.Columns(13).ColumnWidth = 14
objXL.Columns(14).ColumnWidth = 24
objXL.Columns(15).ColumnWidth = 15
objXL.Columns(16).ColumnWidth = 19
objXL.Columns(17).ColumnWidth = 11
objXL.Columns(18).ColumnWidth = 11
objXL.Columns(19).ColumnWidth = 14
objXL.Columns(20).ColumnWidth = 22
objXL.Columns(21).ColumnWidth = 37
objXL.Columns(22).ColumnWidth = 35
objXL.Columns(23).ColumnWidth = 35
objXL.Columns(24).ColumnWidth = 35
objXL.Columns(25).ColumnWidth = 35
objXL.Columns(26).ColumnWidth = 35
objXL.Columns(27).ColumnWidth = 20
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:AA1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:AC").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
'*** Set Column Titles ***
Dim arrNicTitle(4)
arrNicTitle(0) = "NIC #1 Model"
arrNicTitle(1) = "NIC #2 Model"
arrNicTitle(2) = "NIC #3 Model"
arrNicTitle(3) = "NIC #4 Model"
arrNicTitle(4) = "NIC #5 Model"
' 15,16,17
Call AddLineToXLS("IP Address" , "Hostname" , "Domain" , "Role" , "Make" , "Model" , "Serial Number" , _
"RAM" , "RAM Free" , "RAM Used" , "Operating System" , "Service Pack" , "BIOS Revision" , "Processor Type" , "Processor Speed", _
"Logged in user" , "Subnet Mask" , "Default Gateway" , "MAC Address", "Date Installed","HDD", arrNicTitle, "Date & Time")
End If
If WScript.Arguments.Count = 0 Then
objXL.Visible = True
Else
objXL.Visible = False
End If
End Sub
'*** Subroutine Add Lines to XLS ***
objXL.Columns("A:AC").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 8
Sub AddLineToXLS(strCompName, strHostName, strDomain, strRole, strMake, strModel, strSerial, strRAM, strRAMFree, strRAMUsed, _
strOS, strSP, strBIOSrev, strProc, strSpeed, struser, strMask, strGate, strMAC, strDateInstalled, strHDD, byRef strNICmodel, strDateTime)
If strHostName = "Hostname" Then
intRow = 1
Else
Set found = objXL.Sheets("Hardware Inventory").Cells.Find(strHostName)
If found Is Nothing Then
intRow = objXL.Sheets("Hardware Inventory").UsedRange.Rows.Count + 1
Else
intRow = found.Row
End If
End If
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strHostName
objXL.Cells(intRow, 3).Value = strDomain
objXL.Cells(intRow, 4).Value = strRole
objXL.Cells(intRow, 5).Value = strMake
objXL.Cells(intRow, 6).Value = strModel
objXL.Cells(intRow, 7).Value = strSerial
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strRAMFree
objXL.Cells(intRow, 10).Value = strRAMUsed
objXL.Cells(intRow, 11).Value = strOS
objXL.Cells(intRow, 12).Value = strSP
objXL.Cells(intRow, 13).Value = strBIOSrev
objXL.Cells(intRow, 14).Value = strProc
objXL.Cells(intRow, 15).Value = strSpeed
objXL.Cells(intRow, 16).Value = struser
objXL.Cells(intRow, 17).Value = strMask
objXL.Cells(intRow, 18).Value = strGate
objXL.Cells(intRow, 19).Value = strMAC
objXL.Cells(intRow, 20).Value = strDateInstalled
objXL.Cells(intRow, 21).Value = strHDD
objXL.Cells(intRow, 22).Value = strNICmodel(0)
objXL.Cells(intRow, 23).Value = strNICmodel(1)
objXL.Cells(intRow, 24).Value = strNICmodel(2)
objXL.Cells(intRow, 25).Value = strNICmodel(3)
objXL.Cells(intRow, 26).Value = strNICmodel(4)
objXL.Cells(intRow, 27).Value = strDateTime
End Sub
'*** ErrorHandler ***
Sub Error()
fx.WriteLine(strPC)
End Sub
|
|
|
|
|
Waoo excellent scripts! Congratulations!
I've been looking for this for a while now and I finally find what I need thank you!
I would like to ask a favor, see if you can:
1 - Allow run locally without IP (localhost).
2 - Add size of hard disks.
3 - Name of the NIC.
4 - Date of Installation.
Greetings and I sincerely appreciate your help!
Richard
|
|
|
|
|
First, thanks for doing this. The least I could do is add the HDD available space to the script and spreadsheet. We are doing an OS migration and this should help with figuring out if the CPU, RAM and, well, HDD space is sufficient.
This is the same thing with HDD.
'***********************************************************
'AssetScan.vbs - Query PC's on your network with WMI and log
'the responses into an excel spreadsheet.
'
'© Sean Kelly - skelly@engineer.com
' rev 12 April 2005
'
' works with Windows NT, 2K, XP
On Error Resume Next
'***** DECLARATIONS*****************************
CONST wbemFlagReturnImmediately = &h10
CONST wbemFlagForwardOnly = &h20
CONST ForReading = 1
CONST ForWriting = 2
CONST DEV_ID = 0
CONST FSYS = 1
CONST DSIZE = 2
CONST FSPACE = 3
CONST USPACE = 4
CONST TITLE = "AssetScanLite"
Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath
Dim strDomain, strRole, strMake, strModel, strSerial, strBIOSrev, strNICmodel(4), strDateInstalled, strHDD
outputFile = "IP_table.txt"
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
' What is the name of the output file?
strDocName = InputBox ("What would you like to name the output file?", TITLE)
' Create IP list to scan
Call IPCREATE()
'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)
set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")
inputFile = "IP_table.txt"
outputFile = "NA_IP.txt"
set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(inputFile, ForReading, True)
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1
'*****[ FUNCTIONS ]*******************************
Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function
Function IsConnectible(sHost, iPings, iTO)
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName
oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select
fFile.Close
oFSO.DeleteFile(sTempFile)
End Function
'*****[ MAIN SCRIPT ]*****************************
If Ask("Run AssetScan now?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If
Call BuildXLS()
Call Connect()
Call Footer()
objXL.ActiveWorkbook.SaveAs Scriptpath & strDocName & "-AssetScan.xls"
MsgBox "Your inventory run is complete!", vbInformation + vbOKOnly, TITLE
'*****[ SUB ROUTINES ]****************************
'*** Subroutine create ip table
Sub IPCREATE()
currentIP = getip()
dim Seps(2)
Seps(0) = "."
Seps(1) = "."
test2 = Tokenize(currentIP, Seps)
strSubIP = test2(0) & "." & test2(1) & "." & test2(2) & "."
strSubIP = InputBox ("Enter Subnet to Scan - ie: 192.168.5. Press <enter> to Scan Local Subnet", Title, strSubIP)
On Error Resume Next
intStartingAddress = InputBox ("Start at :", "Scanning Subnet: "&strSubIP, 61)
intEndingAddress = InputBox ("End at :", "Scanning Subnet: "&strSubIP&intStartingAddress, 254)
For i = intStartingAddress to intEndingAddress
strComputer = strSubIP & i
fx.WriteLine(strSubIP & i)
Next
End Sub
Function Tokenize(byVal TokenString, byRef TokenSeparators())
Dim NumWords, a()
NumWords = 0
Dim NumSeps
NumSeps = UBound(TokenSeparators)
Do
Dim SepIndex, SepPosition
SepPosition = 0
SepIndex = -1
for i = 0 to NumSeps-1
' Find location of separator in the string
Dim pos
pos = InStr(TokenString, TokenSeparators(i))
' Is the separator present, and is it closest to the beginning of the string?
If pos > 0 and ( (SepPosition = 0) or (pos < SepPosition) ) Then
SepPosition = pos
SepIndex = i
End If
Next
' Did we find any separators?
If SepIndex < 0 Then
' None found - so the token is the remaining string
redim preserve a(NumWords+1)
a(NumWords) = TokenString
Else
' Found a token - pull out the substring
Dim substr
substr = Trim(Left(TokenString, SepPosition-1))
' Add the token to the list
redim preserve a(NumWords+1)
a(NumWords) = substr
' Cutoff the token we just found
Dim TrimPosition
TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
TokenString = Trim(Mid(TokenString, TrimPosition))
End If
NumWords = NumWords + 1
loop while (SepIndex >= 0)
Tokenize = a
End Function
Function GetIP()
Dim ws : Set ws = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
Dim ThisLine, IP
If ws.Environment("SYSTEM")("OS") = "" Then
ws.run "winipcfg /batch " & TmpFile, 0, True
Else
ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
End If
With fso.GetFile(TmpFile).OpenAsTextStream
Do While NOT .AtEndOfStream
ThisLine = .ReadLine
If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
Loop
.Close
End With
'WinXP (NT? 2K?) leaves a carriage return at the end of line
If IP <> "" Then
If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
End If
GetIP = IP
fso.GetFile(TmpFile).Delete
Set fso = Nothing
Set ws = Nothing
End Function
function TranslateDomainRole(byVal roleID)
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
end function
'*********************************************************
Sub Connect()
Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then
strNoPing = "Couldn't ping " & strPC
'Call MsgNoPing()
Call Error()
Else
On Error Resume Next
set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")
If Err.Number <> 0 Then
strNoConnect = "Couldn't connect to " & strPC
'Call MsgNoConnect()
Call Error()
Else
'Get IP Address
strCompName = UCase(strPC)
'Get Hostname
set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
for each Host in HostName
strHostName = Host.DNSHostName
Next
'Get Domain and Role
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strDomain = objItem.Domain
strRole = TranslateDomainRole(objItem.DomainRole)
Next
'Get Make, Model, Serial Number
Set colItems = oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
strSerial = objItem.IdentifyingNumber
strModel = objItem.Name
strMake = objItem.Vendor
Next
'Get RAM (Total)
set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, " & "TotalVirtualMemory, TotalPageFileSpace from " & "Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mb"
Next
'Get Operating System and Service Pack Info
set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber " & "from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
Next
'Get BIOS Revision
Set colSettings = oWMI.ExecQuery ("Select * from Win32_BIOS")
For Each objBIOS in colSettings
strBIOSrev = objBIOS.Version
Next
'Get Processor Type
set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed & " MHZ"
Next
'Get Logged in user
set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
for each logged in loggeduser
struser = logged.UserName
Next
'Get NIC Model 'ISOLATE PRIMARY NIC INFO
Set colSettings = oWMI.ExecQuery ("Select * from Win32_NetworkAdapter")
i=1
For Each objComputer in colSettings
if ObjComputer.AdapterType = "Ethernet 802.3" Then
strNICmodel(i-1) = strMsg & "Interface["& i & "]: " & ObjComputer.Name
i=i+1
End if
NEXT
'Get Subnet Mask, MAC Address, Default Gateway
set IPConfigSet = oWMI.ExecQuery("select ServiceName, IPAddress, " & "IPSubnet, DefaultIPGateway, MACAddress from " & "Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
for each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
for each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
Next
'Date Installed
Set colSettings = oWMI.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objComputer in colSettings
strDateInstalled = Objcomputer.InstallDate
NEXT
'HDD
Set hddSet = oWMI.ExecQuery ("Select * from Win32_LogicalDisk where DriveType = '3'")
For Each objComputer in hddSet
strHDD = FormatNumber(Objcomputer.FreeSpace/1024/1024) & " MB"
'WScript.Echo strHDD
NEXT
'EXTRA LOOP to call Add lines
set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where DriveType = '3'")
ReDim strDisk(RowNum,4)
for each Disk in DiskSet
Call AddLineToXLS(strCompName, strHostName, strDomain, strRole, strMake, _
strModel, strSerial, strRAM, strOS, strSP, strBIOSrev, strProc, strSpeed, struser, _
strMask, strGate, strMAC, strDateInstalled, strHDD, strNICmodel)
Next
End If
End If
End If
Loop
End Sub
'*** Subroutine to Build XLS ***
Sub BuildXLS()
intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = " AssetScan Inventory"
'** Set Row Height
objXL.Rows(1).RowHeight = 25
'** Set Column widths
objXL.Columns(1).ColumnWidth = 9
objXL.Columns(2).ColumnWidth = 14
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 17
objXL.Columns(5).ColumnWidth = 16
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 15
objXL.Columns(8).ColumnWidth = 7
objXL.Columns(9).ColumnWidth = 26
objXL.Columns(10).ColumnWidth = 12
objXL.Columns(11).ColumnWidth = 14
objXL.Columns(12).ColumnWidth = 24
objXL.Columns(13).ColumnWidth = 15
objXL.Columns(14).ColumnWidth = 19
objXL.Columns(15).ColumnWidth = 11
objXL.Columns(16).ColumnWidth = 11
objXL.Columns(17).ColumnWidth = 14
objXL.Columns(18).ColumnWidth = 22
objXL.Columns(19).ColumnWidth = 37
objXL.Columns(20).ColumnWidth = 35
objXL.Columns(21).ColumnWidth = 35
objXL.Columns(22).ColumnWidth = 35
objXL.Columns(23).ColumnWidth = 35
objXL.Columns(24).ColumnWidth = 35
'*** Set Cell Format for Column Titles ***
objXL.Range("A1:Z1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:Z").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
'*** Set Column Titles ***
dim arrNicTitle(4)
arrNicTitle(0) = "NIC #1 Model"
arrNicTitle(1) = "NIC #2 Model"
arrNicTitle(2) = "NIC #3 Model"
arrNicTitle(3) = "NIC #4 Model"
arrNicTitle(4) = "NIC #5 Model"
' 15,16,17
Call AddLineToXLS("IP Address" , "Hostname" , "Domain" , "Role" , "Make" , "Model" , "Serial Number" , _
"RAM" , "Operating System" , "Service Pack" , "BIOS Revision" , "Processor Type" , "Processor Speed", _
"Logged in user" , "Subnet Mask" , "Default Gateway" , "MAC Address", "Date Installed","HDD", arrNicTitle)
End Sub
'*** Subroutine Add Lines to XLS ***
objXL.Columns("A:AA").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 8
Sub AddLineToXLS(strCompName, strHostName, strDomain, strRole, strMake, strModel, strSerial, strRAM, _
strOS, strSP, strBIOSrev, strProc, strSpeed, struser, strMask, strGate, strMAC, strDateInstalled, strHDD, byRef strNICmodel)
objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strHostName
objXL.Cells(intRow, 3).Value = strDomain
objXL.Cells(intRow, 4).Value = strRole
objXL.Cells(intRow, 5).Value = strMake
objXL.Cells(intRow, 6).Value = strModel
objXL.Cells(intRow, 7).Value = strSerial
objXL.Cells(intRow, 8).Value = strRAM
objXL.Cells(intRow, 9).Value = strOS
objXL.Cells(intRow, 10).Value = strSP
objXL.Cells(intRow, 11).Value = strBIOSrev
objXL.Cells(intRow, 12).Value = strProc
objXL.Cells(intRow, 13).Value = strSpeed
objXL.Cells(intRow, 14).Value = struser
objXL.Cells(intRow, 15).Value = strMask
objXL.Cells(intRow, 16).Value = strGate
objXL.Cells(intRow, 17).Value = strMAC
objXL.Cells(intRow, 18).Value = strDateInstalled
objXL.Cells(intRow, 19).Value = strHDD
objXL.Cells(intRow, 20).Value = strNICmodel(0)
objXL.Cells(intRow, 21).Value = strNICmodel(1)
objXL.Cells(intRow, 22).Value = strNICmodel(2)
objXL.Cells(intRow, 23).Value = strNICmodel(3)
objXL.Cells(intRow, 24).Value = strNICmodel(4)
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Subroutine Add Lines to XLS for Disk Info. ***
'objXL.Columns("A:AA").Select
'objXL.Selection.HorizontalAlignment = 3 'xlCenter
'objXL.Selection.Font.Size = 8
Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)
objXL.Cells(intRow, 11).Value = strDEV_ID
objXL.Cells(intRow, 12).Value = strFSYS
objXL.Cells(intRow, 13).Value = strDSIZE
objXL.Cells(intRow, 14).Value = strFSPACE
objXL.Cells(intRow, 15).Value = strUSPACE
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub
'*** Sub to add footer when speadsheet is complete ***
Sub Footer()
strFooter1 = "Inventory AssetScan"
strFooter2 = "Script was created by Sean Kelly and is free for personal/small business use"
strComplete = "Inventory run completed at: " & Date & " at " & time
intRow = intRow + 4
'** Set Cell Format for Row
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 4).Value = strFooter1
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 4).Value = strFooter2
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 4).Value = strStart
intRow = intRow + 1
'** Set Cell Format for Row
objXL.Cells(intRow, 4).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 4).Value = strComplete
intRow = intRow + 1
End Sub
'*** ErrorHandler ***
Sub Error()
fx.WriteLine(strPC)
End Sub
|
|
|
|
|
When the scan put inventory line on xls sometime the line duplicate and sometime the new line erase the before line.
Help me
|
|
|
|
|
Hi Kally,
This is really amezing script. Can you please revert how can I add HDD information? Thankx in advance.
Regards,
Prashant Joshi
|
|
|
|
|
I am having trouble populating the excel sheet. And i suspect it is becos of the fact that my laptop has a seperate Administrator password as opposed to that for my network. Kindly asssist
Awesome coding effort.
|
|
|
|
|
Hi,
if you are on a Windows Domain. Try to do this using Domain Admin Username and password
Regards,
Prashant Joshi
|
|
|
|
|
I couldn't receive any IP address(no result) on my xl file
kts
|
|
|
|
|
Firstly thank your for the script. I'm using it to find which servers are out of warrantee so I know which ones to look at for a service contract.
The script outputs the date as:
Date Installed
20031219131314.000000-300
Based on the output of dozens of machines it looks like this is Year: 2003 and maybe Dec 13th? but I don't know for sure. Can you provide direction on how to make this easier to read.
Thanks
Thanks,
mark
|
|
|
|
|
Is it possible to add the functionality to this script to pull the S/N for the monitor that is connected to it? So far this script is amazing and has worked flawlessly for me.
Thanks again!
CF.
|
|
|
|
|
how to retreive hdd information;)
|
|
|
|
|
How i can get the disk info to be added in teh XLS sheet?
thanks
|
|
|
|
|
how can i add the line to call the disks info in your great script?
|
|
|
|
|
Hi,
it is a excellent vbs (thanx to Sean), but this script scan the whole range (from 0.0.0.0 to 255.255.255.255) the problem is that it takes a lot of time.
How can I specify without creating a txt file the ip adresses I want to scan.
exemple:
I want to scan from "110.200.11.12" to "112.200.11.255" but i don't want to scan a full range when I recieve the code: TimeToLive Expired Transit on ip "x.x.x.1"
I had an idea how to program it, but can not find the correct instruction to pragram it.
exemple:
Dim A,B,C,D,Aend,Bend,Cend,Dend
A=100
B=200
C=11
D=12
Aend=112
Bend=200
Cend=11
Dend=255
For W=A To W=Aend
For X=B To X=Bend
For Y=C To Y=Cend
For Z=D To Z=Dend
Next
Next
Next
Next
ipadd= W & "." & X & "." & Y & "." & Z
Can you pleas help me adding this code into your script so you should never scan the 4228250625 ping commands.
Thanks for your help.
Erbisto
|
|
|
|
|
Sean, first off, GREAT JOB!!! Thanks for coming up with this tool.
Is there any way to run this against a list of IP addresses that I pre-define in a text file (such as the IPs of just servers)?
Second question, Is there any way to determine the OU location within AD of the computer object that you inventory?
Thanks again,
Ian
|
|
|
|
|