如何使用VBScript运行RDP文件?

时间:2009-11-20 18:37:22

标签: vbscript scripting remote-desktop rdp

到目前为止,我有:

Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run("""C:\Server01.rdp""")

但是当我运行它时,没有任何反应。是否可以使用VBScript运行RDP文件?如果是这样,那么我做错了什么?

3 个答案:

答案 0 :(得分:2)

尝试使用传入的.rdp文件名调用mstsc.exe:

objShell.Run(""mstsc C:\server01.rdp"")

答案 1 :(得分:0)

我认为您需要运行mstsc.exe并将rdp文件作为参数传递。

http://technet.microsoft.com/en-us/library/cc753907%28WS.10%29.aspx

答案 2 :(得分:0)

这将起作用:(在PHP中使用VBSCRIPT):

<script type="text/vbscript" language="vbscript">
<!--
const L_FullScreenWarn1_Text = "Your current security settings do not allow automatically switching to fullscreen mode."
const L_FullScreenWarn2_Text = "You can use ctrl-alt-pause to toggle your remote desktop session to fullscreen mode"
const L_FullScreenTitle_Text = "Remote Desktop Web Connection "
const L_ErrMsg_Text         = "Error connecting to remote computer: "
const L_ClientNotSupportedWarning_Text = "Remote Desktop 6.0 does not support CredSSP over TSWeb."
const L_RemoteDesktopCaption_ErrorMessage =  "Remote Desktop Connection"
const L_InvalidServerName_ErrorMessage = "An invalid server name was specified."

sub window_onload()
   if not autoConnect() then
       msgbox("VB")
   end if
end sub

function autoConnect()

    Dim sServer
    Dim iFS, iAutoConnect

    sServer = getQS ("Server")
    iAutoConnect = getQS ("AutoConnect")
    iFS = getQS ("FS")

    if NOT IsNumeric ( iFS ) then
        iFS = 0
    else
        iFS = CInt ( iFS )
    end if

    if iAutoConnect <> 1 then
        autoConnect = false
        exit function
    else


        if IsNull ( sServer ) or sServer = "" then
            sServer = window.location.hostname
        end if

        btnConnect ()
        autoConnect = true
    end if

end function

function getQS ( sKey )
    Dim iKeyPos, iDelimPos, iEndPos
    Dim sURL, sRetVal
    iKeyPos = iDelimPos = iEndPos = 0
    sURL = window.location.href

    if sKey = "" Or Len(sKey) &lt; 1 then
        getQS = ""
        exit function
    end if

    iKeyPos = InStr ( 1, sURL, sKey )

    if iKeyPos = 0 then
        sRetVal = ""
        exit function
    end if

    iDelimPos = InStr ( iKeyPos, sURL, "=" )
    iEndPos = InStr ( iDelimPos, sURL, "&" )

    if iEndPos = 0 then
        sRetVal = Mid ( sURL, iDelimPos + 1 )
    else
        sRetVal = Mid ( sURL, iDelimPos + 1, iEndPos - iDelimPos - 1 )
    end if

    getQS = sRetVal
end function


sub OnControlLoadError
    Msgbox("You wont be able to connect trough Remote Desktop")
end sub

sub OnControlLoad
   set Control = Document.getElementById("MsRdpClient")
   if Not Control is Nothing then
      if Control.readyState = 4 then
        BtnConnect()
      else
          Msgbox("You wont be able to connect trough Remote Desktop")
      end if
   else 
       Msgbox("You wont be able to connect trough Remote Desktop")
   end if
end sub


sub BtnConnect
Dim serverName

serverName = "<?=$_POST["RDserver"]?>"
serverName = trim(serverName)

On Error Resume Next
MsRdpClient.server = serverName
If Err then
msgbox
L_InvalidServerName_ErrorMessage,0,L_RemoteDesktopCaption_ErrorMessage
Err.Clear
exit sub
end if
On Error Goto 0

Dim ClientUserName
ClientUserName = "<?=trim($_POST["RDuser"])?>"
MsRdpClient.UserName = ClientUserName
MsRdpClient.AdvancedSettings.ClearTextPassword = "<?=trim($_POST["RDpass"])?>"
MsRdpClient.FullScreen = TRUE
resWidth = screen.width
resHeight = screen.height
MsRdpClient.DesktopWidth = resWidth
MsRdpClient.DesktopHeight = resHeight
MsRdpClient.Width = resWidth
MsRdpClient.Height = resHeight
MsRdpClient.AdvancedSettings2.RedirectDrives = FALSE
MsRdpClient.AdvancedSettings2.RedirectPrinters = FALSE
MsRdpClient.AdvancedSettings2.RedirectPorts = FALSE
MsRdpClient.AdvancedSettings2.RedirectSmartCards = FALSE
MsRdpClient.FullScreenTitle = L_FullScreenTitle_Text & "-" & serverName & "-"
MsRdpClient.Connect
end sub

-->
    </script>
    <object id="MsRdpClient" language="vbscript" onreadystatechange="OnControlLoad" onerror="OnControlLoadError"  classid="CLSID:4eb89ff4-7f78-4a0f-8b8d-2bf02e94e4b2" width="800" height="600"></object>

<script language="VBScript">
<!--
sub ReturnToConnectPage()
me.close
end sub

sub MsRdpClient_OnConnected()

end sub

sub MsRdpClient_OnDisconnected(disconnectCode)
   extendedDiscReason = MsRdpClient.ExtendedDisconnectReason
   majorDiscReason = disconnectCode And &hFF

   if (disconnectCode = &hB08 or majorDiscReason = 2 or majorDiscReason = 1) and not (extendedDiscReason = 5) then
      ReturnToConnectPage
      exit sub
   end if

   errMsgText = MsRdpClient.GetErrorDescription(disconnectCode, extendedDiscReason)
   if not errMsgText = "" then
         msgbox errMsgText,0,L_RemoteDesktopCaption_ErrorMessage
   end if

   ReturnToConnectPage

end sub
-->
</script>

问题是,这只适用于IE,仍然在寻找Firefox / Safari ......运气好吗?