VBScript to gather info then report to excel

[ByronJohnson]

I am trying to edit this script so that I can gather who the currently logged in user is to the machine. Stuck on where to add the userID string

Here is the code

Option Explicit
On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Dim strFileName : strFileName = "desktops.txt"

Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim oXLS : Set oXLS = WScript.CreateObject("Excel.Application")
Dim WshShell : Set WshShell = createobject("wscript.shell")

Dim i
Dim intIndex
Dim oFile
Dim png
Dim strComputer()
Dim strIpAddress
Dim strPing
Dim strReply
Dim strRet
Dim struser

If Not Fso.FileExists(strFileName) then
strRet = Msgbox("The file, " & strFileName & " is not available" & vbCr _
& "The file must be located in the same folder as the script." & vbCR _
& "Please check for the file <<" & strFileName & ">> in the folder" & vbCR _
& "<<" & Fso.GetParentFolderName(Wscript.ScriptFullName) & ">>")
Wscript.Quit
End if

Set oFile = FspenTextFile(strFileName, 1)


'Open and configure Excel
oXLS.Visible = TRUE
oXLS.WorkBooks.Add
oXLS.Columns(1).ColumnWidth = 20
oXLS.Columns(2).ColumnWidth = 30
oXLS.Columns(3).ColumnWidth = 40
oXLS.Columns(4).ColumnWidth = 40

'Set column headers
oXLS.Cells(1, 1).Value = "Computer Name"
oXLS.Cells(1, 2).Value = "Return"
oXLS.Cells(1, 3).Value = "IP Address"
oXLS.Cells(1, 4).Value = "Logged-on user"

'Format text (bold)
oXLS.Range("A11").Select
oXLS.Selection.Font.Bold = True
oXLS.Selection.Interior.ColorIndex = 1
oXLS.Selection.Interior.Pattern = 1 'xlSolid
oXLS.Selection.Font.ColorIndex = 2
'Left Align text
oXLS.Columns("B:B").Select
oXLS.Selection.HorizontalAlignment = &hFFFFEFDD ' xlLeft

intIndex = 2
i = 0
Do Until oFile.AtEndOfStream
Redim Preserve strComputer(i)
strComputer(i) = oFile.ReadLine
'Ping Computers
set png = WshShell.exec("ping -n 1 " & strComputer(i))
do until png.status = 1 : wscript.sleep 10 : loop
strPing = png.stdout.readall

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer(i) & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")


'NOTE: The string being looked for in the Instr is case sensitive.
'Do not change the case of any character which appears on the
'same line as a Case InStr. AS this will result in a failure.
Select Case True
Case InStr(strPing, "Request timed out") > 1
strReply = "Request timed out"
strIpAddress = GetIP(strPing)
struser = struser
Case InStr(strPing, "could not find host") > 1
strReply = "Host not reachable"
strIpAddress = "N/A"
Case InStr(strPing, "Reply from") > 1
strReply = "Ping Succesful"
strIpAddress = GetIP(strPing)
struser = struser
End Select
Call Show(strComputer(i), strReply, strIPAddress, struser)
i = i + 1
Loop

Function GetIP(ByVal reply)
Dim P
P = Instr(reply,"[")
If P=0 Then Exit Function
reply = Mid(reply,P+1)
P = Instr(reply,"]")
If P=0 Then Exit Function
GetIP = Left(Reply, P-1)
End Function

Sub Show(strName, strValue, strIP, strUSER)
oXLS.Cells(intIndex, 1).Value = strName
oXLS.Cells(intIndex, 2).Value = strValue
oXLS.Cells(intIndex, 3).Value = strIP
oXLS.Cells(intIndex, 4).Value = strUSER
intIndex = intIndex + 1
oXLS.Cells(intIndex, 1).Select
End Sub

 

[Geates]

A ping does not indicate the currently logged on user yet you seemed to have added code to parsing of a succssful ping. I can only assume that is because you understand that the current user can only be obtained from remote machines that are pingable.

The current user is found in the registry at HKLM\Software\Microsoft\CurrentVersion\WinLogon\DefaultUserName for Windows XP. As far as I can tell, it's unavailable in Win7. You'll have to connect to the remote registry WMI and read the above key. Checkout these simple examples on how to do it:

http://www.activexperts.com/activmonitor/windowsmanagement/scripts/operatingsystem/registry/

and then

...
Case InStr(strPing, "Reply from") > 1
  strReply = "Ping Succesful"
  strIpAddress = GetIP(strPing)
  [red]objReg.GetStringValue HKLM, "software\...\winlogon", "defaultusername", [b]strUser[/b][/red]
End Select

Hope this helps

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding