Wenn durch einen VPN-Tunnel per Remotedesktopverbindung auf einen Server zugegriffen werden soll.

Voraussetzung:
Das Ausführen von VisualBasic-Script muss auf dem Client-PC erlaubt sein (Voreinstellung wenn nicht ein Virenscanner dazwischen funkt).
* Eine funtionsfähige VPN-Verbindung sollte bestehen.
* Eine RDP-Sitzung sollte darüber laufen.

Das Script verwendet den Shrew Soft VPN Client
Damit nicht ein schwarzen Fenster während der Laufzeit der RDP-Sitzung bestehen bleibt wird ein Hilfsscript verwendet.

Download gezippte Scripte

vpn_rdp.bat Batch-Datei um das Hilfsscript zu starten

cscript -nologo hidden_VBS.vbs


hidden_VBS.vbs Hilfsscript

Option Explicit
'*****************************************
' Script oder Programm augeblendet starten
'*****************************************

Dim oApp, oWSH, sApp, sPara, sScriptPath
Const cScriptName = "runRDPviaVPN.vbs"

Set oApp = CreateObject("Shell.Application")
Set oWSH = CreateObject("Wscript.shell")

'Das Programm bzw. Scriptinterpreter
sApp = "cscript.exe"
sScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString)

' Startparameter für die Anwendung oder Script-Datei
sPara = sScriptPath & cScriptName

' Programm / Script Ausführen mit Parametern, 0 => Ausführung versteckt (hidden) ohne auf das Beenden zu warten.
oApp.ShellExecute sApp, sPara, "", "", 0

Set oApp = Nothing
Set oWSH = Nothing

 
runRDPviaVPN.vbs Script um erst den VPN-Client dann die Remotedesktopverbindung starten

Option Explicit
' ************************************************************
' Verwendete folgende Software
' Remote Desktop Protokoll (RDP)
' Shrew Soft VPN Client -> https://www.shrew.net/download/vpn
' ************************************************************

' ************************************************************
' Persönliche Einstellungen 
' ************************************************************
' Datei-Name der RDP-Verbindungseinstellungen (Liegt sie im Script-Ordner muss nur der Dateiname angegeben werden, andernfalls der komplette Dateifpad). 
Const cRDP            = "RDP_Datei"  
' VPN-Verbindung aus dem VPN Access Manager
Const cVPN            = "VPN_Name"          
' ************************************************************


' ************************************************************
' Funktionen
' ************************************************************
'Funktion prüft ob eine Anwendung gestartet ist.
Function appInTask(sApp, fKill) '
  'On Error resume next
  'dim oSel, oObject, fappRunning
  Dim oSel, oObj, fappRunning
  Set oSel = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select Name from Win32_Process Where Name = '" & sApp & "'", , 48)
  fappRunning = False
  For Each oObj In oSel	 	
    fappRunning = True	  
    If fKill Then oObj.terminate
  Next  
  Set oSel = Nothing
  appInTask = fappRunning
End Function

Function GetInfoFromFile(sFile, sFind)
  Dim sTmp, oFile  
  Set oFile = oFS.OpenTextFile(sFile, 1, True, -2)
  With oFile
    Do
      sTmp = .ReadLine
      If InStr(1, sTmp, sFind) Then
       GetInfoFromFile= Trim(Replace(sTmp, sFind, vbNullString))          
       sTmp =.ReadAll
      End If
    Loop Until .AtEndOfStream
    .Close
  End With    
End Function

' Nachdem die VPN-Verbindung aufgebaut ist wird den RDP-Server (Terminalserver) angepingt ob dieser ereichbar ist
Function ping()
  Dim i, j, tmp, sPing    
  'Zeigt die Anzahl der Zeilen an welche die Zeichenfolge " TTL=" enthalten
  sPing = "ping -n 1 " & sTerminalServer & " | find /c "" TTL=""" 
  On Error Resume Next
  j = 0  
  do  
    oWsh.run sCMD & sPing & " > " & sTmpfile, 0, true
    i = CInt(Trim(oFS.OpenTextFile(sTmpfile).ReadLine()))
    WScript.Sleep 1000
    j = j + 1
  loop until i > 0 or j >= 20 
  ping = (i > 0) 
end Function

' ************************************************************
' Script
' ************************************************************
Dim oWsh, oApp, oFS
Dim appIPSecP, argIPSec, appRDPP, argRDP, sScriptPath, sTerminalServer, sCMD, sTmp, sTmpfile 
Const cAappIPSec = "ipsecc.exe" 'VPN Client-Dateiname 
Const cAppRDP    = "mstsc.exe"
Set oWSH = CreateObject("Wscript.shell")
Set oApp = CreateObject("Shell.Application")
set oFS  = CreateObject("Scripting.FileSystemObject")
sCMD = oWsh.ExpandEnvironmentStrings("%COMSPEC%") & " /C "
sTmpfile = oWsh.ExpandEnvironmentStrings("%tmp%") & "\~info.txt"
' Pfad des Scripts.
sScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString)
' kompletter Dateipfad des VPN Clients 
appIPSecP = oWsh.ExpandEnvironmentStrings("%ProgramFiles%") & + "\ShrewSoft\VPN Client\" + cAappIPSec
' VPN Connection im VPN Access Manager
' c:\Users\[USERNAME]\AppData\Local\Shrew Soft VPN\sites\[Connection-Name]
argIPSec = "-r " & cVPN & " -a" ' Connection-Name aus "VPN Access Manager"
' RDP - Remotedesktopverbindung 
appRDPP = oWsh.ExpandEnvironmentStrings("%windir%") + "\system32\" + cAppRDP


' RDP Verbindungs-Datei wenn sie im Scriptordner liegt
argRDP = sScriptPath & cRDP
' Wenn der Komplette Pfad in der Konstante eingetragen wurde
'argRDP = cRDP
' ************************************************************

' Wenn der komplette Pfad in der Konstante eingetragen wurde, wird nichts angefügt. 
' Sonst wird der Scriptordner vorangestellt.
If InStr(1, cRDP, "\") = 0 Then
  argRDP = sScriptPath & cRDP
Else
  argRDP = cRDP
End If
If Right(LCase(cRDP), 4) <> ".rdp" Then argRDP = argRDP & ".rdp"

If Not oFS.FileExists(argRDP) Then
  oWsh.popup "Die RemoteDesktop Verbindungsdatei wurde nicht gefunden." & vbCrLf & vbCrLf & argRDP, 15, "", vbOKOnly
  WScript.Quit
End If
sTerminalServer = GetInfoFromFile(argRDP, "full address:s:")

' VPN-Tunnel aufbauen, falls noch nicht gestartet
If not appInTask(cAappIPSec, false) Then oApp.ShellExecute appIPSecP, argIPSec, "", "", 1


'Prüfen ob der Zielhost erreichbar ist
If ping() Then
  oWsh.run appRDPP & " " & argRDP, 3, True 'RDP maximiert starten und aktiviere. Warten bis Anwendung geschlossen wird.
Else
  oWsh.popup "Ping-Anforderung konnte den Host '" & sTerminalServer & "' nicht finden" , 15, "", vbOKOnly
End If

'Wenn kein RDP mehr läuft VPN schließen

If Not appInTask(cAppRDP, False) Then appInTask cAappIPSec, true 'oWsh.run sCMD & "taskkill /T /F /IM " & cAappIPSec, 0, False
On Error Resume Next
oFS.DeleteFile sTmpfile
Set oWSH = Nothing
Set oApp = Nothing
Set oFS  = Nothing

 

Wir nutzen Cookies auf unserer Website. Einige von ihnen sind essenziell für den Betrieb der Seite, während andere uns helfen, diese Website und die Nutzererfahrung zu verbessern (Tracking Cookies). Sie können selbst entscheiden, ob Sie die Cookies zulassen möchten. Bitte beachten Sie, dass bei einer Ablehnung womöglich nicht mehr alle Funktionalitäten der Seite zur Verfügung stehen.