<job id="pcinfo">
<script language="VBScript">
' ##################################################
' Base2Base()
' ##################################################
Function Base2Base(InputNumber,InputBase,OutputBase)
Dim J, K, DecimalValue, X, MaxBase, InputNumberLength
Dim NumericBaseData, OutputValue
NumericBaseData = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
MaxBase = Len(NumericBaseData)
if (InputBase > MaxBase) OR (OutputBase > MaxBase) then
Base2Base = "N/A"
Exit Function
end if
'Convert InputNumber to Base 10
InputNumberLength = Len(InputNumber)
DecimalValue = 0
for J = 1 to InputNumberLength
for K = 1 to InputBase
if mid(InputNumber, J, 1) = mid(NumericBaseData, K, 1) then
DecimalValue = DecimalValue+int((K-1)*(InputBase^(InputNumberLength-J))+.5)
end if
next
next
'Convert the Base 10 value (DecimalValue) to the desired output base
OutputValue = ""
while DecimalValue > 0
X = int(((DecimalValue/OutputBase)-int(DecimalValue/OutputBase))*OutputBase+1.5)
OutputValue = mid(NumericBaseData, X, 1)+OutputValue
DecimalValue = int(DecimalValue/OutputBase)
Wend
Base2Base = OutputValue
Exit Function
End Function
' ##################################################
' CheckIt()
' ##################################################
Function CheckIt()
oStatus.document.all.status.InnerText = "Checking for hardware info file..."
oDiagFile.WriteLine("Checking for hardware info file...")
strPCInfoString = ""
strInfActive = "Yes"
bPCInfoMissing = False
If NOT oFS.FileExists(strHardwareFile) Then
If (bHomePC = False) Then
oStatus.document.all.status.InnerText = "Hardware.ini not found!"
Response = MsgBox("Is this a home PC?", VBYesNo, "Home PC?")
if Response = VBYes Then
oStatus.document.all.status.InnerText = "This is a home PC"
bHomePC = True
ElseIf Response = VBNo Then
oStatus.document.all.status.InnerText = "This is not a home PC"
CreateHWFile
Else
msgBox "WTF!?!"
End If
End If
bPCInfoMissing = True
If oFS.FileExists(strPCInfoFile) Then
Set oPCInfoFile = oFS.OpenTextFile(strPCInfoFile)
strPCInfoString = oPCInfoFile.ReadAll()
oPCInfoFile.Close
End If
If (bHomePC = True) Then
if Not oFS.FileExists(strHomeFile) Then
Set oHomeFile = oFS.OpenTextFile(strHomeFile, 2, true)
oHomeFile.WriteLine("This is a home PC")
oHomeFile.Close
End If
End If
End If
End Function
' ##################################################
' CheckMcAfeeVersion()
' ##################################################
Function CheckMcAfeeVersion()
oStatus.document.all.status.InnerText = "Checking McAfee Version"
oDiagFile.WriteLine("Checking McAfee Version")
On Error Resume Next
strMcAfeeVersion = WshShell.RegRead("HKLM\SOFTWARE\McAfee\DesktopProtection\szProductVer")
If Err.Number = 0 Then
strMcAfeeDAT = _
WshShell.RegRead("HKLM\SOFTWARE\McAfee\AVEngine\AVDATVersion")
strMcAfeeEngine = _
WshShell.RegRead("HKLM\SOFTWARE\McAfee\AVEngine\EngineVersionMajor") & "." & _
WshShell.RegRead("HKLM\SOFTWARE\McAfee\AVEngine\EngineVersionMinor")
Else
strMcAfeeVersion = _
WshShell.RegRead("HKLM\SOFTWARE\NetworkAssociates\TVD\VirusScan Enterprise\CurrentVersion\szProductVer")
If Err.Number = 0 Then
strMcAfeeDAT = _
WshShell.RegRead("HKLM\SOFTWARE\NetworkAssociates\TVD\VirusScan Enterprise\CurrentVersion\szVirDefVer")
strMcAfeeEngine = _
WshShell.RegRead("HKLM\SOFTWARE\NetworkAssociates\TVD\VirusScan Enterprise\CurrentVersion\szEngineVer")
Else
strMcAfeeVersion = _
WshShell.RegRead("HKLM\SOFTWARE\Network Associates\TVD\VirusScan\szCurrentVersionNumber")
If Err.Number = 0 Then
strMcAfeeDAT = _
WshShell.RegRead("HKLM\SOFTWARE\Network Associates\TVD\Shared Components\VirusScan Engine\4.0.xx\szDatVersion")
strMcAfeeEngine = _
WshShell.RegRead("HKLM\SOFTWARE\Network Associates\TVD\Shared Components\VirusScan Engine\4.0.xx\szEngineVer")
End If
End If
End If
oDiagFile.WriteLine("VirusScan: " & strMcAfeeVersion & vbCrLf _
& "DAT File: " & strMcAfeeDAT & vbCrLf & "Engine: " & strMcAfeeEngine)
End Function
' ##################################################
' Set Optmio Registry Settings
' ##################################################
Function Optimo()
oStatus.document.all.status.InnerText = "Writing Optimo registry information."
programFilesDir = WshShell.ExpandEnvironmentStrings("%PROGRAMFILES(X86)%")
If InStr(programFilesDir, "%") Then programFilesDir = WshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
WshShell.RegWrite "HKCR\optimo\", "URL:Optimo Protocol", "REG_SZ"
WshShell.RegWrite "HKCR\optimo\URL Protocol", "", "REG_SZ"
WshShell.RegWrite "HKCR\optimo\DefaultIcon\", programFilesDir & "\Optimo\Optimo.exe", "REG_SZ"
WshShell.RegWrite "HKCR\optimo\shell\", "", "REG_SZ"
WshShell.RegWrite "HKCR\optimo\shell\open\", "", "REG_SZ"
WshShell.RegWrite "HKCR\optimo\shell\open\command\", programFilesDir & "\Optimo\Optimo.exe %1", "REG_SZ"
End Function
' ##################################################
' CollectInfo()
' ##################################################
Function CollectInfo()
oStatus.document.all.status.InnerText = "Collecting system information"
oDiagFile.WriteLine("Collecting system information")
WshShell.RegWrite "HKCU\Control Panel\International\sShortDate", "MM/dd/yy"
WshShell.RegWrite "HKCU\Control Panel\International\sLongDate", "MMMM/dd/yyyy"
oDiagFile.WriteLine("Reading HW Information")
oStatus.document.all.status.InnerText = "Getting Make, Model and Serial number"
If bHomePC = False Then
If Not oFS.FileExists(strHardwareFile) Then
CreateHWFile
End If
ReadHWFile
End If
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strCPU = GetProcessorInfo
oDiagFile.WriteLine(strCPU)
intRAM = GetMemoryInfo / 1024 / 1024
oDiagFile.WriteLine(intRAM & "MB")
GetDriveInfo
oDiagFile.WriteLine(strDriveList)
CheckMcAfeeVersion
'Read PCinfo file to check for Active and Comment
strInfActive = ""
strInfComment = ""
If oFS.FileExists(strPCInfoFile) Then
strInfActive = GetINIString("Other", "Active", "Yes", strPCInfoFile)
If bHomePC = True Then
strInfActive = "HomePC"
Else
strInfActive = "Yes"
End If
strInfComment = GetINIString("Other", "Comment", "", strPCInfoFile)
End If
oDiagFile.WriteLine("Checking various PC Information")
oStatus.document.all.status.InnerText = "Checking various PC Information"
SoftwareVersions
End Function
' ##################################################
' CreateHWFile()
' ##################################################
Function CreateHWFile()
oStatus.document.all.status.InnerText = "Creating hardware information file"
oDiagFile.WriteLine("Creating Hardware Information File")
ReadHWFile
aSysInfo = GetSysInfo
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
.Navigate "about:blank"
.Resizable = False
.Height = 400
.Width = 400
.AddressBar = False
.MenuBar = False
.ToolBar = False
.StatusBar = False
Do until oIE.ReadyState=4 : Wscript.Sleep 100 : Loop
With .document
.open
.write "<html><head><title>PCInfo</title><" _
& "script>bboxwait=true;</" & "script>" &vbCrLf & "<" _
& "script type='text/javascript'>" & vbCrLf _
& "function populatedropdown(dayfield, monthfield, yearfield){" & vbCrLf _
& "var today=new Date()" & vbCrLf _
& "var dayfield=document.getElementById(dayfield)" & vbCrLf _
& "var monthfield=document.getElementById(monthfield)" & vbCrLf _
& "var yearfield=document.getElementById(yearfield)" & vbCrLf _
& "for (var i=0; i<31; i++) {" & vbCrLf _
& "dayfield.options[i]=new Option(i+1, i+1) }" & vbCrLf _
& "dayfield.options[today.getDate()]=new Option(today.getDate(), today.getDate(), true, true)" & vbCrLf _
& "for (var m=0; m<12; m++) {" & vbCrLf _
& "monthfield.options[m]=new Option(m+1, m+1) }" & vbCrLf _
& "monthfield.options[today.getMonth()]=new Option(today.getMonth()+1, today.getMonth()+1, true, true)" & vbCrLf _
& "var thisyear=today.getFullYear() -9" & vbCrLf _
& "for (var y=0; y<20; y++) {" & vbCrLf _
& "yearfield.options[y]=new Option(thisyear, thisyear)" & vbCrLf _
& "thisyear+=1" & vbCrLf _
& "}" & vbCrLf _
& "yearfield.options[9]=new Option(today.getFullYear(), today.getFullYear(), true, true)" & vbCrLf _
& "}</" _
& "script></head>" & vbCrLf _
& "<body bgcolor=white scroll=no>" _
& "Please enter the following information:" _
& "<form name=pcinfo>"_
& "<table align=center border=0 cellpadding=1 cellspacing=5>" _
& "<tr><td>Make:</td><td><input name=Make type=TEXT size=10 " _
& "value='" & aSysInfo(0) & "'></td></tr>" _
& "<tr><td>Model:</td><td><input name=Model type=TEXT size=10 " _
& "value='" & aSysInfo(1) & "'></td></tr>" _
& "<tr><td>Serial Number:</td><td><input name=Serial type=TEXT size=10 " _
& "value='" & aSysInfo(2) & "'></td></tr>" _
& "<tr><td>Service Code:</td><td><input name=ServiceCode type=TEXT size=10 " _
& "value='" & aSysInfo(3) & "'></td></tr>" _
& "<tr><td>Asset Tag:</td><td><input name=Asset type=TEXT size=10></td></tr>" _
& "<tr><td>Language:</td><td><select name=Language>" _
& "<option value='English' selected='selected'>English</option>" _
& "<option value='Spanish'>Spanish</option>" _
& "</select></td></tr>" _
& "<tr><td>Purchase Date:</td><td><select id='pday'></select>" _
& "<select id='pmonth'></select><select id='pyear'></select></td></tr>" _
& "<tr><td>Lojack Key:</td><td><input name=LojackKey type=TEXT size=10 " _
& "></td></tr>" _
& "<tr><td style='height:50px' colspan=2 align=center>" _
& "<button onclick='bboxwait=false;'>Submit</button></td></tr></table>" _
& "</form>" & vbCrLf & "<" _
& "script type='text/javascript'>" & vbCrLf _
& "window.onload=function(){ " & vbCrLf _
& "populatedropdown('pday', 'pmonth', 'pyear')" & vbCrLf _
& "}" & vbCrLf & "</" & "script></body></html>"
.close
'Do Until .ReadyState = "complete" : WScript.Sleep 100 : Loop
.all.Make.focus
.all.Make.select
oIE.visible = true
Do While .parentWindow.bBoxWait
if Err Then Exit Function
WScript.Sleep 100
Loop
oIE.visible = false
strMake = .all.Make.value
strModel = .all.Model.value
strSerial = .all.Serial.value
strServiceCode = .all.ServiceCode.value
strAsset = .all.Asset.value
strLanguage = .all.Language.value
strPurchaseDate = .all.pmonth.value & "/" & .all.pday.value & "/" & .all.pyear.value
strLojackKey = .all.LojackKey.value
End With 'document
End With 'oIE
strOS = GetOS
strCPU = GetProcessorInfo
oIE.Quit
WriteHWFile
End Function
' ##################################################
' GetDriveInfo()
' ##################################################
Function GetDriveInfo()
oStatus.document.all.status.InnerText = "Getting drive info"
oDiagFile.WriteLine("Getting drive info")
Dim strHardDrives, strHardDrivesShort
Dim strOpticalDrives, strOpticalDrivesShort
Set colDrives = oFS.Drives
hdcount = 1
cdcount = 1
For Each oDrive in colDrives
IF oDrive.DriveType = 2 Then
hdSize = (Int (oDrive.TotalSize / 1024 / 1024 / 1024))
hdFree = (Int (oDrive.FreeSpace / 1024 / 1024 / 1024))
strHardDrives = strHardDrives & "HardDrive" & hdcount & "=" & oDrive.DriveLetter & ":|" _
& hdSize & "GB|" & hdFree & "GB" & vbCrLf
strHardDrivesShort = strHardDrivesShort & oDrive.DriveLetter & ":|" _
& hdSize & "|" & hdFree & "-"
hdcount = hdcount + 1
End If
If oDrive.DriveType = 4 Then
strOpticalDrives = strOpticalDrives & "CDROM" & cdcount & "=" & oDrive.DriveLetter & ":" & vbCrLf
strOpticalDrivesShort = strOpticalDrivesShort & oDrive.DriveLetter & ":-"
cdcount = cdcount + 1
End If
Next
strDriveList = strHardDrives & vbCrLf & strOpticalDrives
strDriveListShort = strHardDrivesShort & strOpticalDrivesShort
strDriveList = Replace(strDriveList, vbCrLf & vbCrLf, vbCrLf)
End Function
' ##################################################
' GetFile()
' ##################################################
'File functions
Function GetFile(ByVal FileName)
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
'Go To windows folder If full path Not specified.
If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
FileName = FS.GetSpecialFolder(0) & "\" & FileName
End If
On Error Resume Next
GetFile = FS.OpenTextFile(FileName).ReadAll
End Function
' ##################################################
' GetINIString()
' ##################################################
Function GetINIString(Section, KeyName, Default, FileName)
Dim INIContents, PosSection, PosEndSection, sContents, Value, Found
'Get contents of the INI file As a string
INIContents = GetFile(FileName)
'Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
'Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
'?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
'Separate section contents
sContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare)>0 Then
Found = True
'Separate value of a key.
Value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
End If
End If
If isempty(Found) Then Value = Default
GetINIString = Value
End Function
' ##################################################
' GetMemoryInfo()
' ##################################################
Function GetMemoryInfo()
oStatus.document.all.status.InnerText = "Getting memory info"
oDiagFile.WriteLine("Getting memory info")
intPhysMem = 0
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
For Each objItem in colItems
intPhysMem = intPhysMem + objItem.Capacity
Next
GetMemoryInfo = intPhysMem
End Function
' ##################################################
' GetOS()
' ##################################################
Function GetOS()
oStatus.document.all.status.InnerText = "Checking Operating System version"
iOSVer = GetOsVersionNumber
sOSVersion = "Unknown"
Select Case iOSVer
Case 1
sOSVersion = "Windows 95"
Case 2
sOSVersion = "Windows 98"
Case 3
sOSVersion = "Windows ME"
Case 5.0
sOSVersion = "Windows 2000"
Case 5.1
sOSVersion = "Windows XP"
Case 5.2
sOSVersion = "Windows Server 2003"
Case 6
sOSVersion = "Windows Vista"
Case 6.1
sOSVersion = "Windows 7"
End Select
If (iOSVer >= 5.0) Then
set oShell = CreateObject("Wscript.Shell")
On Error Resume Next
sSP = oShell.RegRead(_
"HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CSDVersion")
If Err.Number<>0 Then
' - Could not find key - no service pack installed
Err.Clear
sSP = ""
End If
sOSVersion = sOSVersion & " " & sSP
End If
GetOS = sOSVersion
End Function
' ##################################################
' GetOsVersionNumber()
' ##################################################
Function GetOsVersionNumber()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Determines OS by reading reg val & comparing to known values
' OS version number returned as number of type double:
' Windows 95: 1
' Windows 98: 2
' Windows ME: 3
' Windows NT4: 4
' Windows 2k: 5
' Windows XP: 5.1
' Windows Server 2003: 5.2
' Windows x: >5.2
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim oShell, sOStype, sOSversion
Set oShell = CreateObject("Wscript.Shell")
On Error Resume Next
sOStype = oShell.RegRead(_
"HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
If Err.Number<>0 Then
' Hex(Err.Number)="80070002"
' - Could not find this key, OS must be Win9x
Err.Clear
sOStype = oShell.RegRead(_
"HKLM\SOFTWARE\Microsoft\Windows" & _
"\CurrentVersion\VersionNumber")
Select Case sOStype
Case "4.00.950"
sOSversion = 1 ' Windows 95A
Case "4.00.1111"
Dim sSubVersion
sSubVersion = oShell.RegRead(_
"HKLM\SOFTWARE\Microsoft\Windows" & _
"\CurrentVersion\SubVersionNumber")
Select Case sSubVersion
Case " B"
sOSversion = 1 ' Windows 95B
Case " C"
sOSversion = 1 ' Windows 95C
Case Else
sOSversion = 1 ' Unknown Windows 95
End Select
Case "4.03.1214"
sOSversion = 1 ' Windows 95B
Case "4.10.1998"
sOSversion = 2 ' Windows 98
Case "4.10.2222"
sOSversion = 2 ' Windows 98SE
Case "4.90.3000"
sOSversion = 3 ' Windows Me
Case Else
sOSversion = 1 ' Unknown W9x/Me
End Select
Else ' OS is NT based
sOSversion = oShell.RegRead(_
"HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
If Err.Number<>0 Then
GetOsVersion = "Unknown NTx"
' Could not determine NT version
Exit Function ' >>>
End If
End If
' Setting Locale to "en-us" to be indifferent to country settings.
' CDbl might err else
SetLocale "en-us"
GetOsVersionNumber = CDbl(sOSversion)
End Function
' ##################################################
' GetProcessorInfo()
' ##################################################
Function GetProcessorInfo()
oStatus.document.all.status.InnerText = "Getting processor info"
oDiagFile.WriteLine("Getting processor info")
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
For Each objItem in colItems
GetProcessorInfo = objItem.Name & " @ " & objItem.CurrentClockSpeed & "MHz"
Next
End Function
' ##################################################
' GetSysInfo()
' ##################################################
Function GetSysInfo()
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSMBIOS = objWMIService.ExecQuery _
("Select * from Win32_SystemEnclosure")
For Each objSMBIOS in colSMBIOS
strSerial = trim(objSMBIOS.SerialNumber)
strMake = trim(objSMBIOS.Manufacturer)
strModel = trim(objSMBIOS.Model)
Next
strServiceCode = Base2Base(strSerial, 36, 10)
GetSysInfo = Array(strMake, strModel, strSerial, strServiceCode)
End Function
' ##################################################
' MapNetworkDrives()
' ##################################################
Function MapNetworkDrives()
oStatus.document.all.status.InnerText = "Mapping network drives to " & strLocalServer
oDiagFile.WriteLine("VB: Mapping drives to " & strLocalServer)
Set WshNetwork = CreateObject("WScript.Network")
On Error Resume Next
'oDiagFile.WriteLine("VB: Mapping G: to " & strLocalServer & "\Bluebook.dsk")
'WshNetwork.MapNetworkDrive "G:", strLocalServer & "\bluebook.dsk"
'if Err.Number<>0 Then
' oDiagFile.WriteLine("VB: Cannot map G: - " & Err.Description)
' Err.Clear
'End If
oDiagFile.WriteLine("VB: Mapping N: to " & strLocalServer & "\BigShare")
WshNetwork.MapNetworkDrive "N:", strLocalServer & "\BigShare"
if Err.Number<>0 Then
oDiagFile.WriteLine("VB: Cannot map N: - " & Err.Description)
Err.Clear
End If
oDiagFile.WriteLine("VB: Mapping M: to \\VAN-MARKETING02\Marketing")
WshNetwork.MapNetworkDrive "M:", "\\VAN-MARKETING02\Marketing"
if Err.Number<>0 Then
oDiagFile.WriteLine("VB: Cannot map M: - " & Err.Description)
Err.Clear
End If
oDiagFile.WriteLine("VB: Mapping T: to \\VAN-SERVER\TeamShare")
WshNetwork.MapNetworkDrive "T:", "\\VAN-SERVER\TeamShare"
if Err.Number<>0 Then
oDiagFile.WriteLine("VB: Cannot map T: - " & Err.Description)
Err.Clear
End If
oDiagFile.WriteLine("VB: Mapping S: to " & strHomeServer & "\Share")
WshNetwork.MapNetworkDrive "S:", strHomeServer & "\Share"
if Err.Number<>0 Then
oDiagFile.WriteLine("VB: Cannot map S: - " & Err.Description)
Err.Clear
End If
If oFS.FolderExists(strHomeServer & "\Share\" & strUserName) Then
' User share folder exists
'Wscript.echo "User share folder exists"
Else
oDiagFile.WriteLine("Creating user folder " & strHomeServer & "\Share\" & strUserName)
Set objFolder = oFS.CreateFolder(strHomeServer & "\Share\" & strUserName)
If (Err.Number <> 0) then
oDiagFile.WriteLine("Error creating share folder - " & Err.Description)
End if
Set objFolder = Nothing
End if
End Function
' ##################################################
' ReadHWFile()
' ##################################################
Function ReadHWFile()
oDiagFile.WriteLine("Reading HW Info File")
oStatus.document.all.status.InnerText = "Reading Hardware File"
If oFS.FileExists(strHardwareFile) Then
strMake = GetINIString("Hardware", "Make", "Unknown", strHardwareFile)
strModel = GetINIString("Hardware", "Model", "Unknown", strHardwareFile)
strSerial = GetINIString("Hardware", "Serial", "Unknown", strHardwareFile)
strServiceCode = GetINIString("Hardware", "ServiceCode", "Unknown", strHardwareFile)
strAsset = GetINIString("Hardware", "AssetTag", "Unknown", strHardwareFile)
strPurchaseDate = GetINIString("Hardware", "PurchaseDate", "Unknown", strHardwareFile)
strLanguage = GetINIString("OS", "Language", "Unknown", strHardwareFile)
strLojackKey = GetINIString("Software", "LojackKey", "N/A", strHardwareFile)
WriteHWFile
End If
End Function
' ##################################################
' SeparateField()
' ##################################################
'Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
Dim PosB: PosB = InStr(1, sFrom, sStart, 1)
If PosB > 0 Then
PosB = PosB + Len(sStart)
Dim PosE: PosE = InStr(PosB, sFrom, sEnd, 1)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(sFrom, PosB, PosE - PosB)
End If
End Function
' ##################################################
' SetFirewall()
' ##################################################
Function SetFirewall()
oDiagFile.WriteLine("Setting firewall rules")
oStatus.document.all.status.InnerText = "Setting firewall rules"
Dim fwPolicy2
Set fwPolicy2 = CreateObject("HNetCfg.FwPolicy2")
Dim RulesObject
Set RulesObject = fwPolicy2.Rules
Dim CurrentProfile
CurrentProfile = fwPolicy2.CurrentProfileTypes
if fwPolicy2.IsRuleGroupEnabled(CurrentProfile, "Remote Assistance") = FALSE then
oDiagFile.WriteLine("Setting firewall rule for Remote Assistance...")
fwPolicy2.EnableRuleGroup CurrentProfile, "Remote Assistance", TRUE
End if
End Function
' ##################################################
' SetHomeServer()
' ##################################################
Function SetHomeServer()
oDiagFile.WriteLine("Computer Name=" & strHostName)
oStatus.document.all.status.InnerText = "Computer Name: " & strHostName
strOffice = Left(strHostName,3)
strHomeOffice = strOffice
strHomeServer = "\\" & strOffice & "-SERVER"
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled= True")
boolDHCP = False
For Each objAdapter in colAdapters
if InStr(objAdapter.Caption, "VMware") = 0 Then
strNIC = objAdapter.Caption
If objAdapter.DHCPEnabled = True Then
boolDHCP = True
End If
For Each strIP in objAdapter.IPAddress
if strIP <> "0.0.0.0" then
if InStr(strIP, ":") = 0 Then
strIPAddress = strIP
' MsgBox "IP Address: " & strIPAddress
End If
End If
Next
End If
Next
strSubnet = Left(strIPAddress, (InStrRev(strIPAddress, ".") -1))
strOfficeIP = Right(strSubnet, (Len(strSubnet) - InStrRev(strSubnet, ".")))
oDiagFile.WriteLine("Real IP Address=" & strIPAddress)
oStatus.document.all.status.InnerText = "IP Address: " & strIPAddress
strOfficeList = "\\" & strHQServer & "\install\remote Sync\pc inventory\officedata.txt"
If (oFS.FileExists(strOfficeList) <> True) Then
strOfficeList = "\\wil-server01\install\remote sync\pc inventory\officedata.txt"
End if
If (oFS.FileExists(strOfficeList) <> True) Then
MsgBox "Error: PCInfo Aborted Cannot Connect to" & vbCrLf & strOfficeList
Wscript.Quit 1
End If
oDiagFile.WriteLine("Using Office List " & strOfficeList)
strTimeZoneOffset = 0
strLocalServer = "\\" & strHQServer
strOffice = "Unknown"
strOfficeData = ""
strProxyServer = ""
If oFS.FileExists(strOfficeList) Then
set objOfficeListFile = oFS.OpenTextFile(strOfficeList, 1, True)
Do while objOfficeListFile.AtEndOfStream = False
strOfficeData = objOfficeListFile.ReadLine
Line = split(strOfficeData, " ")
If strComp(strOfficeIP, (trim(Line(1)))) = 0 Then
strOffice = Line(0)
strTimeZoneOffset = Line(2)
strLocalServer = Line(3)
strProxyServer = Line(4)
oStatus.document.all.status.InnerText = "Office: " & strOffice & vbCrLf _
'& "Server: " & strLocalServer & vbCrLf _
'& "Proxy: " & strProxyServer
oDiagFile.WriteLine("Home Office: " & strHomeOffice)
oDiagFile.WriteLine("Local Office: " & strOffice)
oDiagFile.WriteLine("Timezone Offset: " & strTimeZoneOffset)
oDiagFile.WriteLine("Local Server: " & strLocalServer)
oDiagFile.WriteLine("Proxy: " & strProxyServer)
If strHomeOffice = strOffice Then
strHomeServer = strLocalServer
End If
End If
Loop
objOfficeListFile.Close()
If (oFS.FolderExists(strLocalServer & "\Install") <> True) Then
MsgBox "Error: PCInfo Aborted!" & vbCrLf & "Cannot connect to " & strLocalServer & "\Install"
WScript.Quit 1
End If
Else
MsgBox "Error: PCInfo Aborted!" & vbCrLf & "Cannot connect to " & strHQServer
WScript.Quit 1
End If
End Function
' ##################################################
' SoftwareVersions()
' ##################################################
Function SoftwareVersions()
Dim strFileVersion
oStatus.document.all.status.InnerText = "Checking software versions"
oDiagFile.WriteLine("Checking software versions")
If oFS.FileExists(strAppData & strOppyDir & strPCInfoDir & "\ITMember.txt") Then
oDiagFile.WriteLine("IT Member!")
strSoftwareFile = "\\" & strHQServer & "\Install\Remote Sync\PC Inventory\MIS\softwareversions.txt"
Else
strSoftwareFile = "\\" & strHQServer & "\Install\Remote Sync\PC Inventory\softwareversions.txt"
End If
If oFS.FileExists(strSoftwareFile) Then
Set oSoftwareFile = oFS.OpenTextFile(strSoftwareFile, 1, true)
Do Until oSoftwareFile.AtEndOfStream
strLine = oSoftwareFile.ReadLine
arrLine = Split(strLine, VBTab)
If oFS.FileExists(arrLine(2)) Then
oStatus.document.all.status.InnerText = "Found: " & arrLine(1)
strFileVersion = oFS.GetFileVersion(arrLine(2))
If strFileVersion = "" Then
strFileVersion = "N/A"
End If
strFileVersion = Replace(strFileVersion, ",", ".")
oDiagFile.WriteLine(arrLine(1) & "=" & strFileVersion)
arrSoftware(arrLine(0)) = arrLine(1) & "=" & strFileVersion
Else
If arrSoftware(arrLine(0)) = "" Then
arrSoftware(arrLine(0)) = arrLine(1) & "= N/I"
End If
End If
Loop
Else
MsgBox "Missing file:" & vbCrLf & strSoftwareFile
Wscript.quit 1
End If
End Function
' ##################################################
' WriteFile()
' ##################################################
Function WriteFile(ByVal FileName, ByVal Contents)
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
'Go To windows folder If full path Not specified.
If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
FileName = FS.GetSpecialFolder(0) & "\" & FileName
End If
Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)
OutStream.Write Contents
End Function
' ##################################################
' WriteHWFile()
' ##################################################
Function WriteHWFile()
oStatus.document.all.status.InnerText = "Writing hardware file to disk"
oDiagFile.WriteLine("Writing HW Info File")
if Not oFS.FileExists(strHardwareFile) Then
Set oHardwareFile = oFS.OpenTextFile(strHardwareFile, 2, true)
'oHardwareFile.WriteLine(" ")
oHardwareFile.Close
End If
WriteINIString "Hardware", "Make", strMake, strHardwareFile
WriteINIString "Hardware", "Model", strModel, strHardwareFile
WriteINIString "Hardware", "Serial", strSerial, strHardwareFile
WriteINIString "Hardware", "ServiceCode", strServiceCode, strHardwareFile
WriteINIString "Hardware", "AssetTag", strAsset, strHardwareFile
WriteINIString "Hardware", "PurchaseDate", strPurchaseDate, strHardwareFile
WriteINIString "OS", "Language", strLanguage, strHardwareFile
WriteINIString "Software", "LojackKey", strLojackKey, strHardwareFile
End Function
' ##################################################
' WriteINIString()
' ##################################################
Sub WriteINIString(Section, KeyName, Value, FileName)
Dim INIContents, PosSection, PosEndSection
'Get contents of the INI file As a string
INIContents = GetFile(FileName)
'Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
'Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
'?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
'Separate section contents
Dim OldsContents, NewsContents, Line
Dim sKeyName, Found
OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
OldsContents = split(OldsContents, vbCrLf)
'Temp variable To find a Key
sKeyName = LCase(KeyName & "=")
'Enumerate section lines
For Each Line In OldsContents
If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
Line = KeyName & "=" & Value
Found = True
End If
NewsContents = NewsContents & Line & vbCrLf
Next
If isempty(Found) Then
'key Not found - add it at the end of section
NewsContents = NewsContents & KeyName & "=" & Value
Else
'remove last vbCrLf - the vbCrLf is at PosEndSection
NewsContents = Left(NewsContents, Len(NewsContents) - 2)
End If
'Combine pre-section, new section And post-section data.
INIContents = Left(INIContents, PosSection-1) & _
NewsContents & Mid(INIContents, PosEndSection)
else'if PosSection>0 Then
'Section Not found. Add section data at the end of file contents.
If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then
INIContents = INIContents & vbCrLf
End If
INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
KeyName & "=" & Value
end if'if PosSection>0 Then
WriteFile FileName, INIContents
End Sub
' ##################################################
' WritePCInfo()
' ##################################################
Function WritePCInfo()
Dim strSoftwareHeader, strSoftwareData, arrSoftwareElement
oStatus.document.all.status.InnerText = "Writing local PCInfo file"
oDiagFile.WriteLine("Writing local PCInfo file")
strCombinedSerial = strSerial & "_" & strServiceCode
If boolDHCP = True Then
strIPAddress = "DHCP"
End If
Set oPCInfoFile = oFS.OpenTextFile(strPCInfoFile, 2, True)
oPCInfoFile.WriteLine("# PC Information File")
oPCInfoFile.WriteLine(" ")
oPCInfoFile.WriteLine("[Main]")
oPCInfoFile.WriteLine("DateLastChecked=" & Date)
oPCInfoFile.WriteLine("CurrentLocalServer=" & strLocalServer)
oPCInfoFile.WriteLine("DatePurchased=" & strPurchaseDate)
oPCInfoFile.WriteLine(" ")
oPCInfoFile.WriteLine("[ComputerInfo]")
oPCInfoFile.WriteLine("PCName=" & strHostName)
oPCInfoFile.WriteLine("IPAddress=" & strIPAddress)
oPCInfoFile.WriteLine("Make=" & strMake)
oPCInfoFile.WriteLine("Model=" & strModel)
oPCInfoFile.WriteLine("SerialNumber=" & strSerial)
oPCInfoFile.WriteLine("ServiceCode=" & strServiceCode)
oPCInfoFile.WriteLine("Processor=" & strCPU)
oPCInfoFile.WriteLine("RAM=" & intRAM & "MB")
oPCInfoFile.WriteLine(strDriveList)
oPCInfoFile.WriteLine("OperatingSystem=" & strOS)
oPCInfoFile.WriteLine(" ")
oPCInfoFile.WriteLine("[SoftwareInfo]")
oPCInfoFile.WriteLine("McAfeeVersion=" & strMcAfeeVersion)
oPCInfoFile.WriteLine("McAfeeDAT=" & strMcAfeeDAT)
oPCInfoFile.WriteLine("McAfeeEngine=" & strMcAfeeEngine)
For each element in arrSoftware
If Not element = "" Then
oPCInfoFile.WriteLine(element)
arrSoftwareElement=split(element,"=",2)
strSoftwareHeader = strSoftwareHeader & ", " & arrSoftwareElement(0)
strSoftwareData = strSoftwareData & ", " & arrSoftwareElement(1)
End If
Next
'MsgBox(strSoftwareHeader & vbCrLf & strSoftwareData)
oPCInfoFile.WriteLine(" ")
oPCInfoFile.WriteLine("[Other]")
oPCInfoFile.WriteLine("Active=" & strInfActive)
oPCInfoFile.WriteLine("Comment=" & strInfComment)
oPCInfoFile.WriteLine("NIC=" & strNIC)
oPCInfoFile.Close
oStatus.document.all.status.InnerText = "Writing PCInfo file to " & strInventoryServer
oDiagFile.WriteLine("Writing PCInfo file to " & strInventoryServer)
If oFS.FileExists(strPCInfoFile) Then
strPCInfoServerFile = "\\" & strInventoryServer & "\PCInventory\" & strCombinedSerial & ".inf"
Set oPCInfoServerFile = oFS.OpenTextFile(strPCInfoServerFile, 2, True)
oPCInfoServerFile.WriteLine(strInfActive & ", " & strIPAddress & ", " & strHostName & ", " & Date _
& ", " & strMake & ", " & strModel & ", " & strCombinedSerial & ", " & strCPU & ", " & intRAM & "MB" _
& ", " & strDriveListShort & ", " & strOS & ", " & strMcAfeeVersion & ", " & strMcAfeeDAT _
& ", " & strMcAfeeEngine & ", " & strInfComment & ", " & strNIC & ", " & strVPN _
& ", " & strProxyServer & strSoftwareData & ", " & bFileShare & ", " & strPurchaseDate & ", " & strLojackKey)
oPCInfoServerFile.WriteLine("Active, IP Address, User, Checked, Make, Model, Serial, " _
& "Processor, RAM, Hard Drive List, OS, McAfee, DAT, Engine, Comment, NIC, VPN, ProxyServer" _
& strSoftwareHeader & ", File Sharing Enabled, PurchaseDate, LojackKey")
oPCInfoServerFile.Close
End If
End Function
' ##################################################
' Main
' ##################################################
' Check for CITRIX
dim strAppData, strOppyDir, strPCInfoDir
Set WshShell = CreateObject( "WScript.shell" )
Set oFS = CreateObject("Scripting.FileSystemObject")
strAppData = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\" _
& "Shell Folders\Common AppData")
strOppyDir = "\Oppy"
strPCInfoDir = "\PCInfo"
If oFS.FileExists(strAppData & strOppyDir & strPCInfoDir & "\citrix.txt") Then
' MsgBox "Found Citrix.txt"
WScript.Quit 0
End If
dim bHomePC
dim oDiagFile
dim oStatus
dim strMake, strModel, strSerial, strServiceCode, strAsset
dim strPurchaseDate, strLojackKey, strLanguage
dim strHomeServer, strLocalServer, strHQServer
dim strProxyServer
dim strInventoryServer, strHostName, strPCInfoString
dim strPCInfoFile, strHardwareFile, strHomeFile
dim strDriveList, strDriveListShort, strNIC, strIPAddress
dim strMcAfeeVersion, strMcAfeeDAT, strMcAfeeEngine
dim strInfActive, strInfComment, strCPU, intRAM
dim arrSoftware(50), strUserName, bFileShare
dim boolDHCP
strDiagFileName = "\Diagnostics.txt"
strHQServer = "Van-Server"
strInventoryServer = "Van-Oppy"
Set WshNetwork = WScript.CreateObject("WScript.Network")
strHostName = ucase(WshNetwork.ComputerName)
strUserName = ucase(WshNetwork.UserName)
Set oStatus = CreateObject("InternetExplorer.Application")
Do while oStatus.Busy : WScript.Sleep 100 : Loop
With oStatus
.Navigate "about:blank"
.Resizable = False
.Height = 100
.Width = 400
.AddressBar = False
.MenuBar = False
.ToolBar = False
.StatusBar = False
With .document
.open
.write "<html><head><title>PCInfo</title></head>" _
& "<body bgcolor=white scroll=no>" _
& "<P align=center id=status> </P>" _
& "</body>"
.close
End With 'document
End With 'oIE
oStatus.visible = true
oStatus.document.all.status.InnerText= "Running PCInfo"
strPCInfoFile = strAppData & strOppyDir & strPCInfoDir & "\" & strHostName & ".inf"
strHardwareFile = strAppData & strOppyDir & strPCInfoDir & "\hardware.ini"
strHomeFile = strAppData & strOppyDir & strPCInfoDir & "\home.txt"
Set oFS = CreateObject("Scripting.FileSystemObject")
If Not (oFS.FolderExists(strAppData & strOppyDir)) Then
oFS.CreateFolder strAppData & strOppyDir
If Err.Number <> 0 Then
MsgBox "Failed to create " & strAppDir & strOppyDir _
& vbCrLf & Err.Description
WScript.Quit 1
End If
End If
If Not (oFS.FolderExists(strAppData & strOppyDir & strPCInfoDir)) Then
oFS.CreateFolder strAppData & strOppyDir & strPCInfoDir
If Err.Number <> 0 Then
MsgBox "Failed to create " & strAppData & strOppyDir & strPCInfoDir _
& vbCrLf & Err.Description
WScript.Quit 1
End if
End If
strOS = GetOS
Set oDiagFile = oFS.OpenTextFile(strAppData & strOppyDir & strPCInfoDir _
& strDiagFileName, 2, true)
oDiagFile.WriteLine("Running PCInfo")
oDiagFile.WriteLine("OS Version: " & strOS)
bHomePC = False
If oFS.FileExists(strAppData & strOppyDir & strPCInfoDir & "\home.txt") Then
bHomePC = True
oDiagFile.WriteLine("This is a home PC")
End If
SetHomeServer
Checkit
CollectInfo
Optimo
MapNetworkDrives
If InStr(strOS, "Vista") <> 0 Then ' only set remote desktop firewall exception if running Vista
SetFirewall
End If
WritePCInfo
Set oVerCheckFile = oFS.OpenTextFile(strAppData & strOppyDir & strPCInfoDir & "\VerCheck.ini", 2, True)
oVerCheckFile.WriteLine("# Version Check File")
oVerCheckFile.WriteLine("[Date]")
oVerCheckFile.WriteLine("DateLastChecked=" & Date)
oVerCheckFile.WriteLine(" ")
oVerCheckFile.WriteLine("[McAfee]")
oVerCheckFile.WriteLine("CurrentDatFileVersion=" & strMcAfeeDAT)
oVerCheckFile.WriteLine("CurrentMcAfeeEngine=" & strMcAfeeEngine)
oVerCheckFile.Close
oDiagFile.Close
oStatus.visible = False
oStatus.Quit
</script>
</job>
ASKER
ASKER
ASKER
ASKER
ASKER
ASKER
<job id="pcinfo">
<script language="VBScript">
' ##################################################
' Copy Oppenheimer Screensaver
' ##################################################
Function ScreensaverCopy()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
' global variables
source = "M:\OppyScreenSaver\*.scr"
dest = "C:\"
objFSO.CopyFile source, dest, False
End Function
Function SomeOtherScript()
ScreensaverCopy
SomeOtherScript
</script>
</job>
ASKER
VBScript (Visual Basic Scripting Edition) is an interpreted scripting language developed by Microsoft that is modeled on Visual Basic, but with some important differences. VBScript is commonly used for automating administrative and other tasks in Windows operating systems (by means of the Windows Script Host) and for server-side scripting in ASP web applications. It is also used for client-side scripting in Internet Explorer, specifically in intranet web applications.
TRUSTED BY
Open in new window
Therefore - you don't need to wait for your VBS to execute.Info on PoSh startup/logon scripts:
http://technet.microsoft.com/en-us/library/dd367856%28v=ws.10%29.aspx