' NAME: RDPHistory.vbs
'
' AUTHOR:  Alan Kaplan, alan dot kaplan at va dot gov
' DATE  : 12/23/2008
' 
' COMMENT: Lists previous RDP sessions, which may be in as many as
' three places in the registry, plus the default.rdp file
'==========================================================================
Option Explicit

Const HKCU	= &H80000001
const strPath = "Software\Microsoft\Terminal Server Client"
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
const ForReading = 1 
const ForWriting = 2 
const ForAppending = 8 
Dim fso,logfile, appendout
Dim objReg, oFile

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote
	quote=chr(34)
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote , 1, true
    WScript.Quit            	'...and stop running as WScript
End If

set fso = CreateObject("Scripting.FileSystemObject")
Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")

Dim tArray, tArray1, aRDPList
dim arrEntryNames,arrValueTypes, arrSubKeys, subKey
Dim i
Dim strDefault, Text, strValue

tArray=array()

'From the Default.RDP file
strDefault = wshShell.ExpandEnvironmentStrings("%USERPROFILE%\My Documents\default.rdp")

wscript.echo "Getting info from default.rdp"

If fso.FileExists(strDefault) Then 
	set oFile = fso.OpenTextFile(strDefault, ForReading,,-1)
	Do while not oFile.atendofstream
      Text = oFile.readline
	  If InStr(Text,"address") Then 
	      tArray1 = Split(Text,":")
	      AddToArray tArray,tArray1(UBound(tArray1)) & " (Default)"
	      Exit Do 
      End If 
  Loop
End If 


On Error Resume Next 'lazy, but easier than testing for each

wscript.echo VbCrLf & "Getting info from " & strPath & "\default ......."

'from Default get all MRU REGSZ data
objReg.EnumValues HKCU, strPath & "\Default", arrEntryNames, arrValueTypes
For i=0 To UBound(arrEntryNames)
      objReg.GetStringValue HKCU, _
       strPath & "\Default", arrEntryNames(i), strValue
      addtoarray tArray, strValue
Next


wscript.echo VbCrLf & "Getting info from " & strPath & "\Servers ......"

'from Servers get subkkey names
objReg.EnumKey HKCU, strPath & "\Servers", arrSubKeys
For Each Subkey In arrSubKeys
    addtoarray tArray, Subkey
Next

'from UsernameHint get  names

wscript.echo VbCrLf & "Getting info from " & strPath & "\Usernamehint ...."

'from UserNameHint get all MRU REGSZ data
objReg.EnumValues HKCU, strPath & "\UserNameHint", arrEntryNames, arrValueTypes
For i=0 To UBound(arrEntryNames)
	  addtoarray tArray, arrEntryNames(i)
Next

'sort the array
aRDPlist = Sort(tarray)


'setup log

logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\RDPHistory.txt"  
If fso.FileExists(logfile) Then fso.DeleteFile logfile,True
set AppendOut = fso.OpenTextFile(logfile, ForAppending, True)

i=0
For i= 0 To UBound(aRDPList)
	EchoAndLog aRDPList(i)
Next 

wshShell.Popup "Done, Logfile RDPHistory.txt is on your desktop.",10,"Finished"

' **** Functions and Subs 

Sub AddToArray(aList, NewItem) 'check for new items
	If newItem = "`" Then Exit Sub 'kludge
	If IsIP(NewItem) Then 
		NewItem = NewItem & " (" & DNSName(NewItem) & ")"		
	End If
	 
	NewItem = UCase(NewItem)
	Dim j, ItemFound
	For j = LBound(aList) to UBound(aList)
	   If aList(j) = NewItem Then
	      ItemFound = True
	      Exit For
	   End If
	Next
	
	If Not ItemFound Then
	   ReDim Preserve aList(Ubound(aList) + 1)
	   alist(j)=newitem    
	   'WScript.Echo "Added " & Newitem & " to array"
	End If
End Sub

Function Sort(arrSort)
	Dim j, Temp
	for i = UBound(arrSort) - 1 To 0 Step -1
	    for j= 0 to i
	        if arrSort(j)>arrSort(j+1) Then
	            temp=arrSort(j+1)
	            arrSort(j+1)=arrSort(j)
	            arrSort(j)=temp
	        end if
	    Next
	Next 
	Sort = arrSort
End Function

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 DNSName(IP)
	dim k
	Wscript.echo "Getting name for " & IP
	Dim objExec,retstring
	Dim oRead
	Set objExec=wshShell.Exec("nslookup "  & IP)
	Set oRead = objExec.StdOut
	for k =0 to 2 : oRead.skipline :	Next
	If oRead.AtEndOfStream Then
		DNSName = "Not Resolved"
		Exit Function 
	Else
		objExec.StdOut.skip 9
		DNSName = Trim(oRead.Readline())
	End If 
End Function


Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function


Sub EchoAndLog (message)
'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub