VBscript optimizing RDP Query Script, avoid infinite loop, hide cmd

[matth12582]

I've recompiled a version of a tool I've previously made in batch

the goal is to shorten execution time and only allow the commands a few seconds to execute, rather than wait for command timeout, based on the assumption if the server is responding the commands usually takes less than a second to complete. I originally designed this tool as part of s suite to help our helpdesk troubleshoot user profile / session issues, so it's important the query outputs fast.

the batch tool is able to return query results in about 4 seconds, but that's because it calls another batch that just starts multiple threads of the query in the background and redirects the output to hidden text files.

something like this, my version of multi-threading

::REM starts batch processing for Query session commands

START /B QWINSTA /Server:ismeta %profile% >C:\ProfileTools\Temp\ismeta.txt 2>&1 2>&1
START /B QWINSTA /Server:ismeta01 %profile% >C:\ProfileTools\Temp\ismeta01.txt 2>&1
START /B QWINSTA /Server:ismeta02 %profile% >C:\ProfileTools\Temp\ismeta02.txt 2>&1
START /B QWINSTA /Server:ismeta03 %profile% >C:\ProfileTools\Temp\ismeta03.txt 2>&1
START /B QWINSTA /Server:meta01 %profile% >C:\ProfileTools\Temp\meta01.txt 2>&1
START /B QWINSTA /Server:meta02 %profile% >C:\ProfileTools\Temp\meta02.txt 2>&1

then a for loop in the main batch parses the text and outputs using the "type" command

The Issue I'm having in VBscript is that

1. despite using WshShell.Exec which is supposedly supposed to suppress the command windows I still see them popping up wildly and currently I'm using the below loop so the commands takes at least 2 min to output after it queries about 60 servers

Set oExec = WshShell.Exec("QWINSTA /SERVER:" & server & " " & profile)


'We wait for the end of process
Do While oExec.Status = 0
     WScript.Sleep 500
Loop

if I contain the execution string into a variable and call the variable like

WshShell.Exec(StrCmd)

it will suppress the command windows, but the script seems to hang indefinitely, with the output file that launches upon completion remaining emtpy.

I commented out the status loop, and used this loop to determine if the stdout conditions were met to write to the output file.

Do While oExec.StdOut.AtEndOfStream <> True
          Results.WriteLine("__________________________________________________________")
			Results.WriteLine(server)
			Results.WriteLine oExec.StdOut.ReadLine
Loop

ideally the script will only write entries that generated output to the file, but this locks the script up as well and never seems to generate output and never seems to meet the textstream conditions because the output file just grows exponentially full of just the header info that is written for the very first server in the list references in my For Each statement.

here's the script in entirety, any suggestions are welcome.

if you want to test it just create a text file with a list of windows servers on your domain. map it to

Set oTextStream = oFSO.OpenTextFile("\\userdata\isshare$\ProfileTools\phlist.txt")

'SessionFinder 2.0 - searches for RDP Sessions on Terminal Servers
'
'declares variables
Dim objFSO, objShell, StrDir, profile, title, server, objResults, fileloc
fileloc = "notepad C:\windows\temp\SessionFinder.txt"

'Inputbox that collects username
title = "Please enter the username you'd like to Query"
profile = inputbox(title)

'Creates Class Objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set Results = objFSO.CreateTextFile("C:\Windows\Temp\SessionFinder.txt", True)

Results.WriteLine("SESSION FINDER 2.0")
Results.WriteLine("compiled by ######")
Results.WriteLine(" ")
Results.WriteLine("RDP Sessions for user " & profile & " exists on the following servers")
Results.WriteLine("_________________________________________________________________")
Results.WriteLine("#################################################################")
Results.WriteLine(" ")

Wscript.Echo("Results will display in self-opening TXT file upon completion")

On Error Resume Next

'open the file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")
set WSHShell = wscript.createObject("wscript.shell")
'open the data file
Set oTextStream = oFSO.OpenTextFile("\\userdata\isshare$\ProfileTools\phlist.txt")
'make an array from the data file
RemotePC = Split(oTextStream.ReadAll, vbNewLine)
'close the data file
oTextStream.Close

'Parses text file
For Each server In RemotePC


Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set StrDir = "QWINSTA /SERVER:" & server & " " & profile


'The Query is launched
Set oExec = WshShell.Exec(StrDir)


'We wait for the end of process
Do While oExec.Status = 0
    WScript.Sleep 500
Loop

'We scan and only display the command output of commands without NULL output
Do While oExec.StdOut.AtEndOfStream <> True
          Results.WriteLine("__________________________________________________________")
			Results.WriteLine(server)
			Results.WriteLine oExec.StdOut.ReadLine
Loop
	


NEXT

'End of Query - Display Results
objShell.run fileloc