Terminal Services Control .HTA

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Terminal Services Control .HTA

Logged in as: Guest

arrSession:exec spGetSession 2,16,47187

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Terminal Services Control .HTA
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Terminal Services Control .HTA - 5/17/2007 8:04:17 PM

4scriptmoni

Posts: 192
Score: 0
Joined: 5/3/2007
Status: offline

Can also be downloaded from http:\\4scriptomini.webhop.net
SCREENSHOOTs:
http://www.xoroz.com/work/data/img_tscontrol2.jpg
AND
http://www.xoroz.com/work/data/img_tscontrol.jpg

I have tested with 400 servers in W2003 Servers enviroment, it works correctly!
I have never tested in multiply remote workstations, but would be very happy to know how it works! (PLEASE FEEDBACK ME)
This is version 6, and is my first .HTA sorry if code is not so clean (let me know of any bugs or questions)

UPDATED! Now it gets/check the Server List AUTOMATIC (only in DOMAIN env)
IMPORTANT To check all users just type user: all

Notes:

Requires : quser.exe (included in W2003 Server) -can be copyed from W2k3 to WinXp and works
'

<html>
<!-- 
==========================================================================
'##----------------------------------------------------------------------------------------
'THIS SCRIPT (HTA) should control activity related to Terminal Servers
'date: 10/05/2007, updated 11/06/2007
'author: Felipe Ferreira fel.h2o@gmail.com
'Version: 6.0 (working)
'Requires : quser.exe (included in W2003 Server)
'-----------------------
'v6 new features:
'GetServersB (use net view cmd to gather server list)
'Edit servers.txt
'Check servers.txt file size fixed
' TODO: 
'nbtstat FOR NON DOMAIN users gather or some other way? when not in Domain!
'BUG- active logoff from LOCAL SERVER!!!
''Could also use the progress bar!  ?? maybe too much
'CheckTXTFile only says OK if size is more then 0KB, if so try to get list different way, 'netview?, DONE AND WORKING!
'HOW TO, Link msgbox Popup
'Edit/View servers.txt From HTA, code from monitorpc.hta
'Display Number of Total Disconn and Number of Total Acti and Total Servers... on SpanText

xport directly to Excel
'display output in a dynamic table or form
'##----------------------------------------------------------------------------------------

========================================================================== -->
<title>TS Sessions Control by Felipe</title>
<head>

<HTA:APPLICATION 
   APPLICATIONNAME="TS Sessions Control by Felipe"
   SCROLL="yes"
   SINGLEINSTANCE="yes"
   WINDOWSTATE="normal"
   border="dialog"
   borderstyle="normal"
   caption="TS Sessions Control by Felipe"
   contextmenu="no"
   maximizebutton="no"
   minimizebutton="yes"
   navigable="yes"
   selection="no"
   showintaskbar="yes"
   sysmenu="yes"
   version="6.0"
>
</head>
<style>

BODY
{
     background-color: buttonface;
        Font: arial,sans-serif
     margin-top: 10px;`
     margin-left: 20px;
     margin-right: 20px;
     margin-bottom: 5px;
}
.button
{
     
     width: 91px;
     height: 25px;
     font-family: arial,sans-serif;
     font-size: 8pt;
}

td
{
     font-family: arial,sans-serif;
     font-size: 10pt;
     
}                     
#scroll
{
  height:100%;
  overflow:auto;
}
#Status
{
   color:#000000;
   font-size:11px;
   font-family:"Times New Roman", Times, serif;
   text-decoration:none;
   font-style: normal;
   font-variant: normal;
}
SELECT.FixedWidth 
{
width: 17em;  /* maybe use px for pixels or pt for points here */
}   
a:link {
   color:#000000;
   font-size:11px;
   font-family:"Times New Roman", Times, serif;
   text-decoration:none;
   font-style: normal;
   font-variant: normal;
}
a:visited {
   color:#000000;
   font-size:11px;
   font-family:"Times New Roman", Times, serif;
   text-decoration:none;
   font-style: normal;
   font-variant: normal;
}
a:hover {
   color:#000000;
   font-size:11px;
   font-family:"Times New Roman", Times, serif;
   text-decoration:underline;
   font-style: normal;
   font-variant: normal;
}
</style>

'Global Variables 
Dim rcontrol                  'RADIO Buttons Control rcontrol = 0 (all) 1 (DISC) 2 (ACTIVE)
Dim intTserverChecked           'Number of Servers Checked
Dim logoffC                     ' Control Disc or Act to be logoff
Dim servernameG, sessionidG   'Needed for disconnection
Dim username, userdomain       ' Username Entered by User, Default to %username% loged in PC, also DOMAIN user is IN
Dim admin                      'Controls Administrator level
Dim strPingit                       'To Check serverlist
Dim getServersType               'Witch way to get the server list A=DC based (default), B=net view way (non domain)
Const ForReading = 1, ForWriting = 2, ForAppending=8 ' FileObject use
'Dim userStatusD, userStatusA   'Status Bar  display 
'Admin mode = 1 (query all users), user mode = 0 (ONLY one user at a time) 3 only loggedin user
Set objShell = CreateObject("WScript.Shell")   ' Run cmds

'###################'TO BE EDITED#####################
Dim inputfile, outputfile   
inputfile = "servers.txt"
outputfile = "TSControl.log"
admin = 0                      'SET ADMIN LEVEL
'###############################################
Sub Window_OnLoad
'Code to run when HTA loads goes here
btnDisconnect.Disabled=True
'get username from username logged in PC, should rewrite in Run mode
Set objExecObject = objShell.Exec("cmd /c echo %username%")
Do While Not objExecObject.StdOut.AtEndOfStream
           username = objExecObject.StdOut.ReadLine()   'gets %username%
           trim(username)
loop
'get DOMAIn
Set objExecObject = objShell.Exec("cmd /c echo %USERDOMAIN%")
Do While Not objExecObject.StdOut.AtEndOfStream
           userdomain = objExecObject.StdOut.ReadLine()   'gets %userdomain%
           trim(userdomain)
loop
TextArea.InnerText="Weclome " & username &"!Ready to Load TS Sessions from "& inputfile
StatusArea.InnerText="Idle"
window.document.getElementById("userid").value = "all"
'LOCK USER TO ITSELF
if admin = 2 then
btnOK.Disabled=True
end if

StatusBar.InnerText="User Active: 0, Users Disconnected: 0"
End Sub

'START BUTTON
Sub ButtonClick
'Timer, who long the script takes to execute
Dim t1
t1 = Timer
UpdateTxt   'Calls the Sub bellow, the MAIN PROGRAM!
RunTime = Timer  - t1
RunTime = Left(RunTime, 3)
MsgBox "Checked in: " & intTserverChecked & " servers." &  VbCrLf &_
       "Script executed in: " & RunTime & " seconds."
End Sub

':::::::::::::::::::::::MAIN PROGRAM::::::::::::::::::::::::
Sub UpdateTxt
'on error resume next
Dim strTime, strDate, arrTxt
Dim strTxt,  objShell, servername, strText, strall, arrValues, i, dt
Dim usernameA, strTimeA, strDateA, strTxtA
Dim output, StrSession, intUser, intUser1, resultid
Dim tempfile, tfile, userStatusTA, userStatusTD, userStatusA, userStatusD
Dim strStatusBar

Set objShell = CreateObject("WScript.Shell")   'To Run cmds
Set iFSO = CreateObject("Scripting.FilesyStemObject")    
Set oFSO = CreateObject("Scripting.FilesyStemObject")    
Set ofile = oFso.OpenTextFile(outputfile,ForAppending, True)
Set ifile = iFSO.OpenTextFile(inputfile)      
Set tFSO = CreateObject("Scripting.FilesyStemObject")

oFile.Writeline "######################################################"
oFile.Writeline "This command executed in " & Date & " at " & Time & VbCrLf 
tempfile = "c:\tempfile.txt"

'reset User/Servers counter
intTserverChecked = 0
userStatusD = 0
userStatusA = 0
userStatusTA = 0 
userStatusTD = 0
'-----------------     go inside servers.txt LIST and extract each line ---------
Do until ifile.AtEndOfLine 
servername = ifile.ReadLine    
statusArea.InnerText=servername 'Dynamicly changes the HTML code (display current server)
'Execute the cmd for each server      if ADMIN mode then user can query ALL USERNAMES
if admin = 1 then   
objShell.Run "%comspec% /c quser /server:" & servername & " > c:\tempfile.txt",0,True
else if admin = 0 or username <> "all" then 
objShell.Run "%comspec% /c quser " & username & " /server:" & servername & " > c:\tempfile.txt",0,True
'else if admin = 2 then
' user can only query itself %USERNAME%  , OPTIONAL MODE
'objShell.Run "%comspec% /c quser %username% /server:" & servername & " > 
'c:\tempfile.txt",0,True
'end if
end if
end if
       strText = ""
       Set tfile = tFSO.OpenTextFile(tempfile)      
       Do until tfile.AtEndOfLine 
        strText = tfile.ReadLine
        'CHECKS IF LINE IS NOT EMPTY
        If Not (IsNull(strText) Or strText = "" or strText = VbCrLf) Then
           arrTxt = ""
           strall = ""
           i = 0
           strTxtA = ""
           strTxtD = ""

'-------------------------------------------DISCONNECTED SESSIONS--------------------------------------            
    If Instr(strText, "Disc") > 0 Then   ' Found Disconnect session
                     userStatusD = userStatusD + 1
                   strTxtA = ""
                   ReDim arrValues(4)
                   arrValues = Split(strText) 
'put strText into Array, used to retrive only values wanted, username(1), date(ubond -2), 'time(ubound -1) -- needs 
               Do While i < UBound(arrValues) 
                       strall = strall & arrValues(i)
                       i = i + 1
                     ' oFile.Writeline "ArrValues(DISC): " & arrValues(i)
                    'get Last Logon date+time ,last 2 of Array
                   loop
                   Trim(strall)                            
                   dt = ""
                   'GET VALUES, DATE and TIME
                   dt = UBound(arrValues)
                   strTime = arrValues(dt - 1)   'Time
                   strDate = arrValues(dt - 2)   'Date
                   username = arrValues(1)       'Username
                   Trim(servername)              'Servername from .txt
                   'Write the String of the DISCONNECTED data
                   strTxtD = servername & ", " & username & ", DISCONNECT, " &_
                   StrDate & ", " & StrTime 
                   trim(strTxtD)
                   'GET SESSION ID
                   intUser = Len(username)
                   intUser1 = intUser + 1
                   resultid = Mid(strall, intUser1,2)
                   If IsNumeric(resultid)  Then
                      resultid = resultid
                   Else
                      resultid = Left(resultid,1)
                   End if
                   sessionidG = resultid
                   'oFile.Writeline "STRALL: " & strall
                   oFile.Writeline "SESSION ID(DISC): " & sessionidG
'-----------------------------SHOULD EXEC LOGOFF HERE -------------------------------------------
                  if logoffC = 1 then   'check if logoff Discon is true then EXEC logoff
objShell.Run "%comspec% /c logoff " & sessionidG & " /server:" & servername,0,True
oFile.Writeline "Disconnected DISC USER: " & username & " SESSION ID: " &_
               sessionidG & " from SERVER: " & servername 
                   end if 'FINISH DISCONNECT
          
'----------------------------------ONLY FOR ACTIVE SESSIONS-----------------------------------------
          Else If InStr(StrText, "rdp-tcp#") > 0 Then 'Found ACTIVE connections
                   userStatusA = userStatusA + 1
                      strTxtD = ""
                   ReDim arrValues(4)  '37 = total values in array
                   arrValues = Split(strText) 
                      dt = ""
                      i = 0
                   Do While i < UBound(arrValues) 
                       strall = strall & arrValues(i)
                       i = i + 1    
                   'oFile.Writeline "ArrValues(ACT): " & arrValues(i)                        
                   Loop
                   
                   'GET ACTIVE SESSION ID pass to Global var sessionidG
                    'ReDim arrSession(4)
                    arrSession = Filter(arrValues,"rdp-tcp#")
                    StrSession = arrSession(0) 
                     sessionidG = Trim(StrSession)
                    oFile.Writeline "SessionIDG (ACT): " & sessionidG    
                    
                   'get date and time of LastLogon, and cleans data
                   dt = UBound(arrValues)
                   strTimeA = arrValues(dt - 1 )
                   strDateA = arrValues(dt - 2)
                   usernameA = arrValues(1)
                   Trim(servername)
                   strTxtA = servername & ", " & usernameA & ", ACTIVE, " &_
                   StrDateA & ", " & StrTimeA
                   trim(strTxtA)
                   
if logoffC = 2 then   'check if logoff Discon is true then EXEC 
objShell.Run "%comspec% /c logoff " & sessionidG & " /server:" & servername,0,True

'Logs disconnections  -should do a count and could also set in STATUS TXT BOX
oFile.Writeline "Disconnected ACTIVE USER: " & username & " SESSION ID: " &_
               sessionidG & " from SERVER: " & servername 
                  end if            
           End If        
           End If     
           'Should check for empty lines and not add
           'Should ONLY write to output if session is either disc or act
           trim(arrTxt)
           trim(output)            
           if rcontrol = 0 then   'RadioButtonCheck
               arrTxt = strTxtD & strTxtA
           else if rcontrol = 1 then 'Only Disc sessions
               arrTxt = strTxtD
           else if rcontrol = 2 then 'Only ACT sessions
               arrTxt = strTxtA
           end if 
           end if
           end if
           If Not (IsNull(arrTxt) Or arrTxt = "" or arrTxt = VbCrLf) Then
             oFile.Writeline arrTxt 
             output = output & VbCrLf & arrTxt 
           end if ' check if arrText is NOT EMPTY                
         End if ' Check IF LINE IS EMPTY        
       
       loop  'loop thru each LINE of TEMPFILE c:\tempfile.txt

userStatusTA = userStatusTA + userStatusA
userStatusTD = userStatusTD + userStatusD
userStatusA = 0
userStatusD = 0
intTserverChecked = intTserverChecked + 1
loop ' loop thru each SERVER

'---------------Finally Write to Screen, and log---------------------------
trim(output)    
oFile.Writeline  "Checked in : " & intTserverChecked 
TextArea.InnerText = output 
strStatusBar = "Users Active: " & userStatusTA & ",Users Disconnected: "& UserStatusTD 
oFile.Writeline strStatusBar
'MsgBox strStatusBar
StatusBar.InnerText=strStatusBar
btnDisconnect.Disabled=False   'enable to be disconnected
End sub 'FINISH UpdateTxt sub

'DISCONNECT USERS FROM TS
Sub Disconnect
   TextArea.InnerText = "Disconnecting..."
   'here should execute the logoff of all Disconnected sessions...
   'check Radio box FOR discon or acti  --> BAD CODE, disconn and START button do the same thing!!!!
   if rcontrol = 1 then
       logoffC = 1
   end if
   if rcontrol = 2 then
       logoffC = 2
   end if
   if rcontrol = 0 then
   msgbox "Sorry will not disconnect all sessions, check DISCO or ACTIVE sessions"
   end if
   UpdateTxt
   logoffC = 0  'Otherwise will keep disconnecting when press Start
   'SpanArea.InnerText="Disconnecting TS Sessions:"
   btnDisconnect.Disabled=True   
End Sub

'EXPORT TO EXCEL SUB!
Sub Export
   'Exports output to ts_log.csv
   On Error Resume Next
       msgbox "Just copy and Paste screen data to excel, also look at TSControl.log"
       Set objExcel = CreateObject("Excel.Application")
         If objExcel=Nothing Then
            MsgBox "Excel not found! Please check that Excel is installed!",48
             Exit Sub
         End If       
End Sub

'GET USERNAME FROM TXT FIELD AND SET USERNAME PARAMETER
Sub EnterUserID
   ' Get host/computer name defined in the text field
   username = window.document.getElementById("userid").value
   msgbox "Username: " & username
   if username = "all" then
       admin = 1
   end if
   if username <> "all" then
       admin = 0
   end if
End Sub

Sub CheckTxtFile()
   'CHECK IF THE SPECIFIED inputfile EXISTS AND COUNT HOW MANY LINES.
   'SHOULD CHECK file size > 0
   
   Dim fs                    'obj FileSystem
   Dim f                    'folder 
   Dim f1                    'file 
   Set fs = CreateObject("Scripting.FileSystemObject")
   If (fs.FileExists(inputfile)) then
       Set f1 = fs.GetFile(inputfile)    
           If f1.size = 0 then   'IF SERVERS.TXT is Okb then delete it and try again
               msgbox "Server List file: " & f1.name & ",has Size: " & f1.size
               f1.delete
               msgbox "Maybe you are not part of Domain. Please Try again."    
               getServersType = "B" ' try to get using net view way...
               exit sub            
           end if
       'COUNT LINES AND DISPLAY FILE NAME AND LINES
       Dim iFSO : Set iFSO = CreateObject("Scripting.FileSystemObject")
       Dim ifile : ifile = iFSO.OpenTextFile(inputfile,ForReading).ReadAll
       Set reLines     = New RegExp
       reLines.Pattern = vbCrLf
       reLines.Global  = True
       Set oMTS = reLines.Execute(ifile) 
       'MsgBox "Line Counts : " & oMTS
       SpanArea.InnerText = "OK! Found: " & oMTS.Count & " servers."
       StatusArea.InnerText="Host list loaded"
       'ifile.close
   else  'create the servers.txt list
      msgbox "Server List Not Found!"
      SpanArea.InnerText = "Server list: " & inputfile & " NOT FOUND!"
      StatusArea.InnerText="Loading..."
      msgbox "Getting list... (PLEASE WAIT)"
          'A = if PC is in a Domain, uses AD vry FAST, B = for PCs in workgroup, uses net view command
         if getServersType = "" then
           GetServers
          end if
          if getServersType = "B" then
           GetServersB
          end if
      SpanArea.InnerText="Servers.txt Loaded ok"
      StatusArea.InnerText="Verifying list..."
      CheckTxtFile
   end if
end sub

Sub GetServers()
'IF THE inputfile IS INVALID OR USER WANTS TO GET THE SERVER LIST DO THIS AND WRITES TO inputfile
'Get a List of Servers from a DC
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim F : Set F = Fso.CreateTextFile(inputfile, TRUE)
'Should HAVE GOTTEN  %USERDOMAIN% get parameter on_LOAD 
Set oContainer = GetObject("WinNT://" & userdomain)
oContainer.Filter = Array("computer")
For Each oComputer1 in oContainer
     'StatusArea.InnerText=oComputer1.name  -->DOSENT WORK.. maybe too fast 
     PingStatus(oComputer1.name)
     if strPingit = "Success" then
       F.WriteLine(oComputer1.name)   'ADD TO SERVERLIST
     end if
Next
f.close

end sub

Sub GetServersB()
   'net view parser, get all servers clean \\ and set into a .txt just with server names
   'Shuold DELETE the tempfile2.txt
   Set tFSO = CreateObject("Scripting.FilesyStemObject")
   Set objShell = CreateObject("WScript.Shell")   ' Run cmds
   Dim strLine, arrPCs, i, t2file
   Const ForWriting = 2, ForAppending=8
   Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
   Dim F : Set F = Fso.CreateTextFile(inputfile, TRUE)
   i=0
   redim arrPCs(500)   'estimated max number of PCs to retrive
'RUNS THE COMMAND NET VIEW AND OUTPUTS TO TEMP TXT FILE
   objShell.Run "%comspec% /c net view>c:\tempfile2.txt",0,True
   Set t2file = tFSO.OpenTextFile("c:\tempfile2.txt")      
'need to Loop thru Entire File
Do Until t2file.AtEndOfStream   'go thru Entier FILE, result of net view dumped in .txt
               strLine = t2file.ReadLine  'get line
               If Instr(strLine, "Errore") > 0 Then   ' Found error
                   MsgBox "Error: " &  strLine
               end if
               If Instr(strLine, "\\") > 0 Then   ' Found Parse and set in servers.txt
                   'Remove \\ and spaces and store in Array 
                   strLine = Replace(strLine,"\\","")
                   trim(strLine)
                   Dim RegEx : Set RegEx = New RegExp
                   RegEx.Global = True : RegEx.MultiLine = True
                   RegEx.Pattern = "\s+$" 'Remove Spaces
                   strLine = RegEx.Replace(strLine, "")            
                   arrPCs = split(strLine)'Still needs to remove if a computer has comments
                   StatusArea.InnerText=arrPCs(0) 'Display each server in HTML 
                     F.WriteLine(arrPCs(0))   'ADD TO SERVERLIST
               end if 
               i = i + 1 'control array
loop
msgBox "Workgroup Server List OK, Found:" & i
end Sub

'---------------------------------------
'Ping Status function
Function PingStatus(strComputer)
On Error Resume Next
  strWorkstation = "."
  Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
  Set colPings = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
  For Each objPing in colPings
      'Quickly Identify, Ping Status is 0 then OK, otherwise do not add server to list, no ping response!
               
      If objPing.StatusCode = 0 then
           strPingit = "Success"
           
      else if objPing.StatusCode <> 0 then
           strPingit = "False"
      end if
      end if
      
  Next
on error goto 0
End Function

Sub ViewList
        On Error Resume Next
       Dim objFile, strHTML
       ' Read the current host/computer names from the text file
       Set objFile = FileObject(ForReading)
       ' Output data from text file to text area to review/modify as needed
       TextArea.InnerText = objFile.ReadAll
       objFile.Close
       Set objFile = Nothing
       
End Sub

Sub About

TextArea.InnerText = "This Program should monitor user Login.  "& VbCrLf &_
"Created: 10/05/2007, Updated 11/06/2007 " & VbCrLf &_
"Author: Felipe Ferreira, Version= 6.0 " & VbCrLf &_
"Special Usage:   USERNAME = all (Display all USERS!)" & VbCrLf &_
"Start-> Should List users from Host List" & VbCrLf &_
"Any Bugs/Comments to: fel.h2o@gmail.com" & VbCrLf &_
"More information at http:\\4scriptomini.webhop.net"

end Sub

Function FileObject(strMethod)
'         On Error Resume Next
       Dim objFSO:    Set objFSO = CreateObject("Scripting.FileSystemObject")
       ' Open text file using the method specified
       Set FileObject = objFSO.OpenTextFile(inputfile, strMethod)
       Set objFSO = Nothing
End Function

Sub CheckRadioButtons
'ALL TYPES OF SESSIONS from all list
rcontrol = 0
End Sub
Sub CheckRadioButtons1
'ONLY DISCON SESSIONS
rcontrol = 1
End Sub
Sub CheckRadioButtons2
'ONLY ACTIVE SESSIONS
rcontrol = 2
End Sub

</script>

<br><br>
<span id="SpanArea" class="FixedWidth"><h3>Get Teminal Login Sessions:</h3></span>
&nbsp;<b>Status:</b><span id="StatusArea" class="FixedWidth"><i>idle</i></span>

<br /><br />
<input type="radio" name="Radio" title="All" onclick="CheckRadioButtons" CHECKED>All
<input type="radio" name="Radio" title="Disconnected" onclick="CheckRadioButtons1">Disconnected
<input type="radio" name="Radio" title="Active" onclick="CheckRadioButtons2">Active 
<BR><BR>
Servername, Username, Session, LastLogon, Time
<textarea style="overflow:auto" rows="9" name="TextArea" cols="64" readonly></textarea><P align="LEFT">

<a href="" onclick="About">About</a> | <a href="" onclick="ViewList">View Host List</a>
|<a href="http:\\4scriptomini.webhop.net">http:\\4scriptomini.webhop.net</a> |
<span id="StatusBar" class="Status"></span>

</body>
</html>

cheers,
Felipe

< Message edited by 4scriptmoni -- 6/12/2007 2:11:26 AM >

_____________________________

Enterprise Microsoft Scripts
Exchange, Login/Logout Monitor,TS, Monitoring, Security, AD, etc...
http://www.felipeferreira.net