'**************************************************************
'File:    xFinger.vbs
'Author: Gurgen Alaverdian (www.gurgensvbstuff.com)
'Date:    05.2000
'
'Script should retrieve a list of workstations
'specified user is logged on to.
'Very useful for System Administrators or Help Desk personal. 
'For the script to work properly user "Home Drive" UNC path 
'must be specified in the user account property. 
'When user logged on to the domain, chances are good, that 
'at list one resource is accessed on the home server. 
'By enumerating sessions on the home server, 
'code retrieves workstation name the user is connected from. 
'Running script on NT workstation require ADSI v2.5 installed.
'Syntax: xFinger.vbs [domain\user_name]

'***************************************************************
'6-2-03 modified by Alan Kaplan for prompted input.
'5-12-2009 modified by Alan Kaplan to return Computer name
'4-11-12 Alan Kaplan adds copy to clipboard

Option Explicit

Dim inputStr, UserName, Domain, splitInput, sName, oArgs, Session 
Dim oUser, userFullName, userHome, fService, LoggedOn, q, wshshell, strComputer,message, retval 

Set WshShell = WScript.CreateObject("WScript.Shell")
'On Error Resume Next
q = Chr(34)

Set oArgs = Wscript.Arguments

'Check for Script Argument. If not supplied, then
'display proper syntax calling "Syntax" help sub.

If oArgs.Count <> 1 Then 
	getinput
Else 
	inputStr = oArgs(0)
	If InStr(inputStr, "\") <> 0 Then
		splitarg inputstr
 		else GetInput 
	End If
End If 

'Connect to SAM database. Error will be raised if
'domain or user name is invalid.

Set oUser = GetObject("WinNT://" & Domain & "/" & UserName & ",user")
If Err.Number <> 0 Then
	MsgBox "Cannot locate Domain " & _
         q & Domain & q & " or user account " & _
        q & UserName & q & " does not exists.", _
         64, "Error:": Wscript.Quit
End If

'Get user's Full Name and Home Drive account property.
'User home drive property is used to retrieve "Home" server name. 'If this property is not defined then display error and exit.

userFullName = oUser.FullName
userHome = oUser.HomeDirectory
If userHome = "" Then
	MsgBox "Home Server for user " & _
        q & UserName & q & " not specified." , _
        64, "Error:": Wscript.Quit
End If

'Retrieve server name.

sName = Split(userHome, "\")

'Connect to home server and create a session object.

Set fService = GetObject("WinNT://" & sName(2) & "/LanmanServer")

If Err.Number <> 0 Then
	MsgBox "Can not connect to user Home Server. Server is down, or you do not have enough privileges!",64, "Error:":
	Wscript.Quit
End If
'Enumerate current sessions on the server matching session users 'to the given user name. 
'If match is found retrieve computer name 'the user is connected from and build a 
'"LoggedOn" list string.

For Each Session In fService.Sessions
    If LCase(Session.User) = LCase(UserName) Then
    	
    	If IsIP( Session.Computer) Then 
    		strComputer = GetName(Session.Computer)
    	Else
    		strComputer = Session.computer
    	End If
    	
        LoggedOn = LoggedOn & vbcrlf & strComputer
    End If
Next

'If string is not empty then display it in the message box.
If LoggedOn = "" then
    MsgBox "User " & q & UserName & q & " (" & _
    userFullName & ") is not logged on.", 64, "Query:"
	WScript.Quit
End If
 
message = "User " & q & UserName & q & " (" &   userFullName & ") found logged on to the following systems: " & _
    vbcrlf & LoggedOn &  VbCrLf & VbCrLf & "Copy List to clipboard?"
retval = msgbox(message,vbYesNo+vbQuestion,"Servers Found")

If retval = vbYes Then 
	LoggedOn =trim(replace(LoggedOn,vbcrlf,space(1)))
	Copy2Clip(LoggedOn)
End If 


'==========================================================================

Function IsIP(strTest)
	IsIP = False
	Dim oRegEx, match, matches, strPattern
	Set oRegEx = New RegExp
	strPattern = "^(25[0-4]|2[0-4][0-9]|1[0-9]{2}|[1-9]{1}[0-9]{1}|[1-9])\.(25[0-4]|2[0-4][0-9]|1[0-9]{2}|[1-9]{1}[0-9]{1}|[1-9]|0)\.(25[0-4]|2[0-4][0-9]|1[0-9]{2}|[1-9]{1}[0-9]{1}|[1-9]|0)\.(25[0-4]|2[0-4][0-9]|1[0-9]{2}|[1-9]{1}[0-9]{1}|[1-9])$"
    oRegEx.Pattern = strPattern
	Set matches = oRegEx.Execute(strTest)   ' Execute search.
	For Each match In matches 
		If Matches.count = 1 Then
		   IsIP = True
		End If 
	Next 
	set oRegEx = Nothing
End Function

Function  GetName(strText)
	dim objEx, data
	set objEx = WshShell.Exec("nslookup " & strText)
	
	'one line at a time
	While Not objEx.StdOut.AtEndOfStream
		data = objEx.StdOut.Readline()
		'Works with XP.  Not sure if other OS have same results
		
		if instr(data,"Name:") Then 
			GetName = data
			GetName = Trim(Mid(GetName,6)) 'get rid of start of line
			Exit Function 
		End If 
	Wend
		GetName = strText & " failed to resolve to a name"
End Function  


Sub Syntax()
	MsgBox "SYNTAX: xFinger.vbs [Domain\User_Name]" & vbcrlf & vbcrlf & _
	"Domain        - Focus domain." & vbcrlf & _
	"User_Name    - User name to query for." & vbcrlf & vbcrlf & _
	"NOTE:    For the script to work, user must" & _
	                " have a home drive specified" & vbcrlf &_
	"    in the domain account properties." & vbcrlf, 64, "Syntax:"
End Sub

Function splitarg (inputStr)
	If Len(inputStr) = 0 Then WScript.Quit
	If InStr(inputStr,"\") = 0 Then
		wshshell.Popup "Parameter must be in form domain\username",15,"Bad Input"
		WScript.Quit
	End If 
	
    splitInput = Split(inputStr, "\")
	Domain = splitInput(0)
	UserName = splitInput(1)
End Function 

Sub getinput

	Domain = wshshell.ExpandEnvironmentStrings("%userdomain%")
	Dim myname 
	myname = wshshell.ExpandEnvironmentStrings("%username%")
	UserName = InputBox("Enter Domain\Username as shown:","Locate user logons",Domain&"\"&myname)
'If domain or user name is empty call a help sub.
	splitarg username
	
	If Domain = "" Or UserName = "" Then
	Syntax
	End If
End Sub 



Function Copy2Clip(strMessage)
	Dim objWord
 	'Sets what you want to put in the clipboard using Word object
	'Variation of code by Tony Bothwell, posted at
	'http://stackoverflow.com/questions/128463/use-clipboard-from-vbscript
	
	' Declare an object for the word application  
	On Error Resume Next
	Set objWord = CreateObject("Word.Application")
	If Err = 0 Then 
		' Using the object
		With objWord    
			.Visible = False             	' Don't show Word
			.Documents.Add               	' Create a document
			.Selection.TypeText strMessage	' Put text into it    
			.Selection.WholeStory        	' Select everything in the doc
			.Selection.Copy              	' Copy contents to clipboard    
			.Quit False                  	' Close Word, don't save
		End With
		WshShell.Popup "Data copied to clipboard",15,"Done"
	Else
		Err.Clear
		If(MsgBox ("Could not copy to clipboard, send to notepad instead?",_
			vbYesNo + vbQuestion, "Send to Notepad") = vbYes) then
			wshshell.Run("notepad.exe")

			While wshshell.appactivate("Untitled - Notepad") = False
				Wscript.Sleep 10
			Wend
			
			wshshell.SendKeys strMessage
		End If 
	End If 
	On Error GoTo 0
End Function