2009-11-20 4 views
1

Jusqu'à présent, j'ai:Comment puis-je exécuter un fichier RDP avec VBScript?

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

Mais quand je le lance, rien ne se passe. Est-il même possible d'exécuter un fichier RDP avec VBScript? Si oui, alors qu'est-ce que je fais mal?

+1

eu à travailler tout le monde: objShell.Run "mstsc.exe server01.rdp" Merci pour toute l'aide! – wahle509

Répondre

2

essayer d'appeler mstsc.exe avec le nom de fichier .rdp passé dans:

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

Non, je reçois "Le système ne trouve pas le fichier spécifié". – wahle509

+0

vous devrez vous assurer que les variables de votre chemin d'environnement pointent correctement (si vous pouvez démarrer start-> run -> mstsc c: \ server01.rdp, alors vous devriez être d'accord). Vérifiez également les guillemets sur ma réponse - je n'ai pas inclus le supplément que vous aviez à l'origine! –

+0

En guise de réflexion, vous pouvez utiliser un fichier batch à la place de VBScript si vous le souhaitez, car il s'agit d'une opération relativement simple. –

0

Cela fonctionne: (en PHP avec 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> 

Le problème est, cela ne fonctionne que dans IE, toujours à la recherche de Firefox/Safari ... une chance ??

Questions connexes