Submitted By: Chris Maiura

Provides a graphical user interface for connecting to a remote Desktop server.

Visual Basic
Edit|Remove
<head>
<title>RDP Console</title>
<HTA:APPLICATION
     APPLICATIONNAME="RDP Console"
     SCROLL="no"
     SINGLEINSTANCE="yes"
>
</head>

<SCRIPT LANGUAGE="VBScript">

Sub Window_Onload

      self.Focus()

      LoadServerNameTextbox
End Sub

Sub LoadServerNameTextbox

      strHTML = "<select style=""width:250px;"" name=NamespacesPulldown>"
      Const SORT_KEYS  = 1
      Const SORT_ITEMS = 2
      'Code for Domain Search from http://www.rlmueller.net/products.htm
      Dim objRootDSE, strDNSDomain, objConnection, objCommand, strQuery
      Dim objRecordSet, strComputerDN, strOS, d, i

      Set d = CreateObject("Scripting.Dictionary")

      ' Determine DNS domain name from RootDSE object.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strDNSDomain = objRootDSE.Get("defaultNamingContext")

      ' Use ADO to search Active Directory for all computers.
      Set objCommand = CreateObject("ADODB.Command")
      Set objConnection = CreateObject("ADODB.Connection")
      objConnection.Provider = "ADsDSOObject"
      objConnection.Open "Active Directory Provider"
      objCommand.ActiveConnection = objConnection

      strQuery = "<LDAP://" & strDNSDomain _
        & ">;(objectCategory=computer);" _
        & "cn,operatingSystem;subtree"

      objCommand.CommandText = strQuery
      objCommand.Properties("Page Size") = 100
      objCommand.Properties("Timeout") = 30
      objCommand.Properties("Cache Results") = False

      Set objRecordSet = objCommand.Execute

      ' Enumerate computer objects with server operating systems.
      Do Until objRecordSet.EOF
        strOS = objRecordSet.Fields("operatingSystem")
              If InStr(UCase(strOS), "SERVER") > 0 Then
                strComputerDN = objRecordSet.Fields("cn")
                d.add strComputerDN, ""
               End If
        objRecordSet.MoveNext
      Loop
If d.count Then
      LoadSortDictionary d,SORT_KEYS
      SERVER_LIST.InnerHTML = ""

      For Each i In d.Keys
          strHTML = strHTML & "<option value= " & Chr(34) & i & Chr(34) & ">" & i
      Next

      SERVER_LIST.InnerHTML = strHTML
Else
End If
      ' Clean up.
      objConnection.Close
      Set objRootDSE = Nothing
      Set objCommand = Nothing
      Set objConnection = Nothing
      Set objRecordSet = Nothing

End Sub

Sub LoadSortDictionary(objDict,intSort)
'Code from http://support.microsoft.com/kb/q246067/
      Const dictKey  = 1
      Const dictItem = 2

      ' declare our variables
      Dim strDict()
      Dim objKey
      Dim strKey,strItem
      Dim X,Y,Z

      ' get the dictionary count
      Z = objDict.Count

      ' we need more than one item to warrant sorting
      If Z > 1 Then
            ' create an array to store dictionary information
            Redim strDict(Z,2)
            X = 0
            ' populate the string array
            For Each objKey In objDict
              strDict(X,dictKey)  = CStr(objKey)
              strDict(X,dictItem) = CStr(objDict(objKey))
              X = X + 1
            Next

            ' perform a a shell sort of the string array
            For X = 0 to (Z - 2)
                  For Y = X To (Z - 1)
                    If
StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
                        strKey  = strDict(X,dictKey)
                        strItem = strDict(X,dictItem)
                        strDict(X,dictKey)  = strDict(Y,dictKey)
                        strDict(X,dictItem) = strDict(Y,dictItem)
                        strDict(Y,dictKey)  = strKey
                        strDict(Y,dictItem) = strItem
                    End If
                  Next
            Next

            ' erase the contents of the dictionary object
            objDict.RemoveAll

            ' repopulate the dictionary with the sorted information
            For X = 0 to (Z - 1)
                  objDict.Add strDict(X,dictKey), strDict(X,dictItem)
            Next

      End If

End Sub

Window.ResizeTo 300, 250
Window.MoveTo 512, 384

Dim ws

Sub RunScript

      If DisplayOption(0).Checked Then
          DisplayOpt = DisplayOption(0).Value
      End If

      If DisplayOption(1).Checked Then
          DisplayOpt = DisplayOption(1).Value
      End If

      If DisplayOption(2).Checked Then
          DisplayOpt = DisplayOption(2).Value
      End If

      If DisplayOpt = "" Then
            Exit Sub
      End If

      Set ws = CreateObject("WScript.Shell")
            ws.Run "mstsc /console /v:" & NamespacesPulldown.Value & " " & DisplayOpt
      Set ws = Nothing

End Sub

Sub CancelScript
   Self.Close()
End Sub

</SCRIPT>

<BODY STYLE="font:14 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1,
StartColorStr='#000000', EndColorStr='#696969')"> Connect To<BR> <span id="SERVER_LIST"></span><BR><BR> <input type="radio" name="DisplayOption" value="/w:640 /h:480">640x480<BR> <input type="radio" name="DisplayOption" value="/w:800 /h:600"
CHECKED>800x600<BR>
<input type="radio" name="DisplayOption" value="/w:1024 /h:768">1024x768<P>

<input id=runbutton class="button" type="button" value="Connect Me!!"
name="ok_button"
onClick="RunScript">
&nbsp;&nbsp;&nbsp;
<input id=runbutton class="button" type="button" value="Close"
name="cancel_button"
onClick="CancelScript">

</BODY>