RDP-Verbindung via Shrew Soft VPN Client per Script starten

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