'************************************************************************ 'DESCRIPTION: Computer Analysis 'WRITTEN BY: Daniel M. Jones 'DATE: August 12, 2009 'COMMENT: '************************************************************************ 'on error resume next '************************************************************************************************************************************************ ' VARIABLE DEFINITION '************************************************************************************************************************************************ CONST HKEY_LOCAL_MACHINE = &H80000002 CONST HKEY_USERS = &H80000003 CONST CURRENT_USER = "None" CONST LOGON_AUDIT_PATH = "\\server\share\logonAudits" CONST MSO_2003 = "Microsoft Office 2003" CONST MSO_2007 = "Microsoft Office 2007" CONST NOT_INSTALLED = "Not Installed" CONST OBSOLETE_AGE = 30 'Days CONST OPEN_OFFICE = "Open Office" CONST SELF_VERSION = "1.5" CONST SELF_SCRIPT = "Analyze Computer" CONST SSO_DOCTOR = "ssodoctor" CONST SSO_PILOT = "ssopilot" CONST SSO_TYPE_1 = 1 CONST SSO_TYPE_2 = 2 CONST SSO_TYPE_3 = 3 CONST SSO_TYPE_2_BGCOLOR = "Green" CONST TOMBSTONE_CHARS = "0123456789abcdef:\" CONST WINDOWS_2000 = "Microsoft Windows 2000" CONST WINDOWS_XP = "Microsoft Windows XP" CONST WINDOWS_VISTA = "Microsoft Windows Vista" CONST WINDOWS_7 = "Windows 7 Ultimate" CONST UNKNOWN = "Unknown" CONST NIC_DESCRIPTION = 0 CONST NIC_DHCP = 1 CONST NIC_DNS = 2 CONST NIC_GATEWAY = 3 CONST NIC_IP = 4 CONST NIC_MAC = 5 CONST NIC_SUBNET = 6 CONST NIC_SPEEDDUPLEX = 7 CONST USR_WINDOWS_USERNAME = 0 CONST USR_FULL_NAME = 1 CONST BROADCOM = 0 CONST INTEL = 1 CONST MARVELLYUKON = 2 dim arrInvalidProfiles(8) dim arrNetworkProperties() dim arrSpeedDuplexEnum(2, 6) dim arrSpeedDuplexKey(2, 0) dim arrUserProperties() dim arrVendorID(2, 0) dim boolBadReg dim intLocalProfiles dim intObsoleteProfiles dim intTombstoneFolders dim objReg dim objRootFolders dim objSMS dim objSysinfo dim objUser dim objWMI dim strAntiVirus dim strComputer dim strComputerCPU dim strComputerMake dim strComputerMem dim strComputerModel dim strComputerOS dim strComputerType dim strCurrentUser dim strDomain dim strOfficeSuite dim strIEVersion dim strNIC dim strNICClassKey dim strPrinters dim strProcessor dim strSerialNumber dim strSMSVersion dim strSSOType dim strSystemType dim strTitle dim strUNCComputer dim strWindowsRoot dim tblBIOS dim tblComputer dim tblNIC dim tblProcessor arrInvalidProfiles(0) = "Administrator" arrInvalidProfiles(1) = "All Users" arrInvalidProfiles(2) = "LocalService" arrInvalidProfiles(3) = "NetworkService" arrInvalidProfiles(4) = "NMH" arrInvalidProfiles(5) = "NMH Default" arrInvalidProfiles(6) = "Default User" arrInvalidProfiles(7) = "systemprofile" arrInvalidProfiles(8) = "guest" arrSpeedDuplexEnum(BROADCOM, 0) = "Auto" arrSpeedDuplexEnum(BROADCOM, 3) = "10Mbps \ Half Duplex" arrSpeedDuplexEnum(BROADCOM, 4) = "10Mbps \ Full Duplex" arrSpeedDuplexEnum(BROADCOM, 5) = "100Mbps \ Half Duplex" arrSpeedDuplexEnum(BROADCOM, 6) = "100Mbps \ Full Duplex" arrSpeedDuplexEnum(INTEL, 0) = "Auto" arrSpeedDuplexEnum(INTEL, 1) = "10Mbps \ Half Duplex" arrSpeedDuplexEnum(INTEL, 2) = "10Mbps \ Full Duplex" arrSpeedDuplexEnum(INTEL, 3) = "100Mbps \ Half Duplex" arrSpeedDuplexEnum(INTEL, 4) = "100Mbps \ Full Duplex" arrSpeedDuplexEnum(INTEL, 5) = "1000Mbps \ Full Duplex" arrSpeedDuplexEnum(MARVELLYUKON, 0) = "Auto" arrSpeedDuplexEnum(MARVELLYUKON, 1) = "10Mbps \ Half Duplex" arrSpeedDuplexEnum(MARVELLYUKON, 2) = "10Mbps \ Full Duplex" arrSpeedDuplexEnum(MARVELLYUKON, 3) = "100Mbps \ Half Duplex" arrSpeedDuplexEnum(MARVELLYUKON, 4) = "100Mbps \ Full Duplex" arrSpeedDuplexKey(BROADCOM, 0) = "RequestedMediaType" arrSpeedDuplexKey(INTEL, 0) = "SpeedDuplex" arrSpeedDuplexKey(MARVELLYUKON, 0) = "ConnectionType_A" arrVendorID(BROADCOM, 0) = "14E4" arrVendorID(INTEL, 0) = "8086" arrVendorID(MARVELLYUKON, 0) = "11AB" intLocalProfiles = 0 intObsoleteProfiles = 0 intTombstoneFolders = 0 strAntiVirus = "None" strComputer = "." strCurrentUser = CURRENT_USER strNICClassKey = "System\Currentcontrolset\Control\Class\{4D36E972-E325-11CE-BFC1-08002be10318}" strSSOType = NOT_INSTALLED strSMSVersion = NOT_INSTALLED strTitle = SELF_SCRIPT & " " & SELF_VERSION strUserProfiles = "Documents and Settings" set objArgs = Wscript.Arguments set objFSO = WScript.CreateObject("Scripting.FileSystemObject") set objShell = WScript.CreateObject("WScript.Shell") set objSysinfo = CreateObject("ADSystemInfo") set objUser = GetObject("LDAP://" & objSysinfo.UserName & "") '************************************************************************************************************************************************ ' FUNCTIONS '************************************************************************************************************************************************ '****************************** ' COMPUTER/USER PROPERTIES '****************************** sub getComputerProperties on error resume next objReg.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName", strComputerOS objReg.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "SystemRoot", strWindowsRoot objReg.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "DefaultUserName", strCurrentUser objReg.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "DefaultDomainName", strDomain strWindowsRoot = right(strWindowsRoot, len(strWindowsRoot) - inStr(strWindowsRoot, "\")) for each objItem in tblBIOS strSerialNumber = objItem.SerialNumber next for each objComputer in tblComputer strComputerModel = objComputer.Model strComputerMake = objComputer.Manufacturer strComputerMem = objComputer.TotalPhysicalMemory next for each objProcessor in tblProcessor strSystemType = objProcessor.Architecture strProcessor = objProcessor.Description next end sub sub getNetworkProperties on error resume next i = 0 for each objItem in tblNIC redim preserve arrNetworkProperties(i, 7) strDescription = right(objItem.Caption, len(objItem.Caption) - inStrRev(objItem.Caption, "]") - 1) arrNetworkProperties(i, NIC_DESCRIPTION) = strDescription arrNetworkProperties(i, NIC_IP) = join(objItem.IPAddress, " ") arrNetworkProperties(i, NIC_MAC) = objItem.MACAddress arrNetworkProperties(i, NIC_DNS) = join(objItem.DNSServerSearchOrder, ", ") arrNetworkProperties(i, NIC_DHCP) = objItem.DHCPServer arrNetworkProperties(i, NIC_GATEWAY) = join(objItem.DefaultIPGateway, " ") arrNetworkProperties(i, NIC_SUBNET) = join(objItem.IPSubnet, vbNewLine) arrNetworkProperties(i, NIC_SPEEDDUPLEX) = getNetworkSpeedDuplex(strDescription) i = i + 1 next end sub function getNetworkSpeedDuplex(strDescription) objReg.EnumKey HKEY_LOCAL_MACHINE, strNICClassKey, arrSubKeys strSpeedDuplex = UNKNOWN for each strSubKey in arrSubKeys objReg.GetStringvalue HKEY_LOCAL_MACHINE, strNICClassKey & "\" & strSubKey, "DriverDesc", strDriverDesc if (strDescription = strDriverDesc) then objReg.GetStringvalue HKEY_LOCAL_MACHINE, strNICClassKey & "\" & strSubKey, "ComponentID", strComponentID if (left(ucase(strComponentID), 8) = "PCI\VEN_") then strVendorID = mid(strComponentID, 9, 4) select case ucase(strVendorID) case arrVendorID(BROADCOM, 0) : strVendorID = BROADCOM case arrVendorID(INTEL, 0) : strVendorID = INTEL case arrVendorID(MARVELLYUKON, 0) : strVendorID = MARVELLYUKON case else : strVendorID = UNKNOWN end select if (strVendorID <> UNKNOWN) then objReg.GetStringvalue HKEY_LOCAL_MACHINE, strNICClassKey & "\" & strSubKey, arrSpeedDuplexKey(strVendorID, 0), intValue if NOT (isNull(intValue)) then strSpeedDuplex = arrSpeedDuplexEnum(strVendorID, intValue) end if end if end if next getNetworkSpeedDuplex = strSpeedDuplex end function sub getPrinters strPrinterFile = strUNCComputer & "\" & strWindowsRoot & "\printers.vbs" if (objFSO.FileExists(strPrinterFile)) then set objStream = objFSO.GetFile(strPrinterFile).OpenAsTextStream(1, -2) do until (objStream.AtEndOfStream) strLine = lcase(objStream.ReadLine) if (inStr(strLine, "'") <> 1) then if (inStr(strLine, "\\")) then strPrinter = mid(strLine, inStrRev(strLine, "\\"), inStrRev(strLine, """") - inStrRev(strLine, "\\")) if (inStr(lcase(strLine), "addwindowsprinterconnection")) then strPrinters = strPrinters & strPrinter & "," if (inStr(lcase(strLine), "setdefaultprinter")) then strPrinters = replace(strPrinters, strPrinter, strPrinter & " * ") end if end if loop end if end sub sub getSoftwareConfig on error resume next if (objFSO.FolderExists(strUNCComputer & "\Program Files\Imprivata")) then objReg.GetDWORDValue HKEY_LOCAL_MACHINE, "SOFTWARE\SSOProvider\ISXAgent", "Type", strValue if (typename(strValue) <> "Null") then strSSOType = strValue end if if (objFSO.FileExists(strUNCComputer & "\Program Files\Symantec AntiVirus\vptray.exe")) then strAntiVirus = "Symantec" if (objFSO.FileExists(strUNCComputer & "\Program Files\ESET\ESET NOD32 Antivirus\egui.exe")) then strAntiVirus = "ESET" objReg.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer", "Version", strIEVersion if (objFSO.FileExists(strUNCComputer & "\Program Files\OpenOffice.org 3\program\version.ini")) then set objStream = objFSO.OpenTextFile(strUNCComputer & "\Program Files\OpenOffice.org 3\program\version.ini") do until objStream.AtEndOfStream strLine = objStream.ReadLine if (inStr(ucase(strLine), "OOOBASEVERSION")) then strOfficeSuite = OPEN_OFFICE & " " & right(strLine, len(strLine) - inStrRev(strLine, "=")) & vbNewLine & vbTab & vbTab loop end if if (objFSO.FileExists(strUNCComputer & "\Program Files\Microsoft Office\Office12\winword.exe")) then strOfficeSuite = strOfficeSuite & MSO_2007 & vbNewLine & vbTab & vbTab if (objFSO.FileExists(strUNCComputer & "\Program Files\Microsoft Office\Office11\winword.exe")) then strOfficeSuite = strOfficeSuite & MSO_2003 & vbNewLine & vbTab & vbTab strOfficeSuite = left(strOfficeSuite, len(strOfficeSuite) - 4) set colItems = objSMS.ExecQuery("Select ClientVersion from SMS_Client") for each objItem in colItems strSMSVersion = objItem.ClientVersion next end sub function getUserProfiles on error resume next if (strComputerOS = WINDOWS_7) then msgbox "Windows 7 is not supported" : wscript.quit set objProfiles = objFSO.GetFolder(strUNCComputer & "\" & strUserProfiles).SubFolders for each objProfile in objProfiles if (isValidProfile(objProfile.Name)) then intLocalProfiles = intLocalProfiles + 1 if (objProfile.Name <> strCurrentUser) then if (cint(now - objProfile.DateLastModified) > OBSOLETE_AGE) then intObsoleteProfiles = intObsoleteProfiles + 1 end if end if next end function sub tombstoneFolders (strAction) intCount = 0 for each objFolder in objRootFolders if (isTombstone(objFolder)) then 'msgbox objFolder.Path select case ucase(strAction) case "DELETE" : objFSO.DeleteFolder objFolder.Path, true : intTombstoneFolders = intTombstoneFolders - 1 case "GET" : intTombstoneFolders = intTombstoneFolders + 1 end select end if next end sub '************************** ' CONTROL '************************** function analyzeComputer getComputerProperties getPrinters getNetworkProperties getSoftwareConfig getUserProfiles tombstoneFolders "GET" analyzeComputer = compileData end function function compileData strAnalysis = ucase(strComputer) & " (" & strSerialNumber & ") - " & strDomain & "\" & strCurrentUser & vbNewLine & vbNewLine strAnalysis = strAnalysis & strComputerOS & vbNewLine & trim(strComputerMake) & " " & strComputerModel & vbNewLine strAnalysis = strAnalysis & "Processor: " & vbTab & strProcessor & vbNewLine strAnalysis = strAnalysis & "Memory: " & vbTab & (strComputerMem \ 1048576) & " MB" & vbNewLine & vbNewLine strAnalysis = strAnalysis & "Local Profiles: " & vbTab & intLocalProfiles & vbNewLine strAnalysis = strAnalysis & "Obsolete Profiles: " & vbTab & intObsoleteProfiles & " (" & cint(intObsoleteProfiles / intLocalProfiles * 100) & "%)" & vbNewLine strAnalysis = strAnalysis & "Tombstone Folders: " & intTombstoneFolders & vbNewLine & vbNewLine strAnalysis = strAnalysis & "Software Configuration" & vbNewLine & "******************************" & vbNewLine strAnalysis = strAnalysis & "Anti-Virus Program: " & vbTab & strAntiVirus & vbNewLine strAnalysis = strAnalysis & "Imprivata SSO Type: " & strSSOType & vbNewLine strAnalysis = strAnalysis & "Internet Explorer: " & vbTab & strIEVersion & vbNewLine strAnalysis = strAnalysis & "SMS Client Version: " & vbTab & strSMSVersion & vbNewLine strAnalysis = strAnalysis & "Office Suite(s): " & vbTab & strOfficeSuite & vbNewLine & vbNewLine strAnalysis = strAnalysis & "Network Interface Card(s)" & vbNewLine & "******************************" & vbNewLine for i = 0 to ubound(arrNetworkProperties) strAnalysis = strAnalysis & arrNetworkProperties(i, NIC_DESCRIPTION) & vbNewLine strAnalysis = strAnalysis & "MAC Address: " & vbTab & arrNetworkProperties(i, NIC_MAC) & vbNewLine strAnalysis = strAnalysis & "IP Address: " & vbTab & arrNetworkProperties(i, NIC_IP) & vbNewLine strAnalysis = strAnalysis & "IP Subnet: " & vbTab & arrNetworkProperties(i, NIC_SUBNET) & vbNewLine strAnalysis = strAnalysis & "IP Gateway: " & vbTab & arrNetworkProperties(i, NIC_GATEWAY) & vbNewLine strAnalysis = strAnalysis & "DNS Server(s): " & vbTab & arrNetworkProperties(i, NIC_DNS) & vbNewLine strAnalysis = strAnalysis & "DHCP Servers: " & vbTab & arrNetworkProperties(i, NIC_DHCP) & vbNewLine strAnalysis = strAnalysis & "Speed/Duplex: " & vbTab & arrNetworkProperties(i, NIC_SPEEDDUPLEX) & vbNewLine & vbNewLine next intPrinters = ubound(split(strPrinters, ",")) if (intPrinters < 0) then intPrinters = 0 strAnalysis = strAnalysis & "Installed Network Printers: " & strTab & intPrinters & " ( * default)" & vbNewLine & "******************************" & vbNewLine strAnalysis = strAnalysis & " " & replace(strPrinters, ",", vbNewLine & " ") & vbNewLine compileData = strAnalysis end function function initialize(strComputer) on error resume next Err.Number = 0 set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") set objSMS = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\ccm") set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") set objRootFolders = objFSO.GetFolder(strUNCComputer).SubFolders set tblComputer = objWMI.ExecQuery("Select * From Win32_ComputerSystem") set tblNIC = objWMI.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=1",,48) set tblProcessor = objWMI.ExecQuery("Select * from Win32_Processor") set tblBIOS = objWMI.ExecQuery("Select * from Win32_BIOS",,48) initialize = Err.Number end function function isTombstone (objFolder) isTombstone = true strName = objFolder.Name for i = 1 to len(strName) strChar = mid(strName, i, 1) if (inStr(TOMBSTONE_CHARS, strChar) = false) then isTombstone = false exit function end if next end function function isValidProfile(strProfile) isValidProfile = true if (inStr(strProfile, "\")) then strProfile = right(strProfile, len(strProfile) - inStrRev(strProfile, "\")) for each strInvalidProfile in arrInvalidProfiles if (lcase(strProfile) = lcase(strInvalidProfile)) then isValidProfile = false next end function sub openLogonAudit(strComputer) strLogonAudit = LOGON_AUDIT_PATH & "\" & strComputer & "\All Users\logonAudit.txt" if (objFSO.FileExists(strLogonAudit)) then objShell.Run(chr(34) & strLogonAudit & chr(34)) else strLogonAudit = "\\" & strComputer & "\c$\documents and settings\All Users\logonAudit.txt" if (objFSO.FileExists(strLogonAudit)) then objShell.Run(chr(34) & strLogonAudit & chr(34)) end if end sub function ping (strComputer) ping = false set objExec = objShell.Exec("%comspec% /c ping.exe " & strComputer & " -n 1 -w 100") do until objExec.Stdout.AtEndOfStream strLine = objExec.StdOut.ReadLine if (inStr(strLine, "Reply")) then ping = mid(strLine, 12, inStr(12, strLine, " ") - 13) exit function end if loop end function '************************************************************************************************************************************************ ' BEGIN '************************************************************************************************************************************************ if (objArgs.count) then for i = 0 to objArgs.count - 1 strArg = objArgs(i) select case ucase(strArg) case "/C" : strComputer = objArgs(i + 1) end select next else strComputer = ucase(inputBox("Analyze computer:", strTitle)) end if if (strComputer = ".") then strComputer = objShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName") if (ping(strComputer) = false) then if (msgbox("Computer unreachable, View logonAudit?", vbYesNo, strTitle) = vbYes) then openLogonAudit(strComputer) wscript.quit end if strUNCComputer = "\\" & strComputer & "\c$" openLogonAudit(strComputer) boolInitialize = initialize(strComputer) strAnalysis = analyzeComputer msgbox strAnalysis