RDP-Verbindung via Lancom Advanced VPN-Client per Script starten

cscript -nologo hidden_VBS.vbs

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

Option Explicit
' ************************************************************
' Das Script etabliert eine VPN-Verbindung zu einem LANCOM-Router via LANCOM Advanced VPN Client.
' Sobald die VPN-Verbindung zwischen dem lokalen PC und dem Router besteht wird im Anschluss eine 
' RDP-Verbindung zu einem Server/PC innerhalb des Netzwerkes des LANCOM-Routers aufgebaut.
' Funktionsweise des Scripts:
' 1. Prüfen ob der VPN-Client schon gestartet ist

' Verwendete Software
' Remote Desktop Protokoll (RDP)
' LANCOM Advanced VPN Client -> https://www.lancom-systems.de/produkte/router-vpn-gateways/lancom-advanced-vpn-client-windows/
' ************************************************************

' ************************************************************
' Persönliche Einstellungen 
' ************************************************************
' Datei-Name der RDP-Verbindungseinstellungen: Remotedesktopverbindung starten -> Optionen einblenden -> Verbindungseinstellungen speichern unter... aufrufen 
' In diesem Bsp. liegt die Datei auf dem Desktop des Benutzers und wurde remotedesktop genannt.
Const cRDP            =  "%HOMEDRIVE%%HOMEPATH%\desktop\remotedesktop.rdp"  

' Für den Verbindungsaufbau wird dieser Client-Monitor nicht benötigt. Kann also auch leer gelassen werden wenn die VPN-Verbindung korret funktioniert.
Const cAppAVPNC      = "ncpmon.exe" 'VPN Client 'ncpmon.exe

' Verbindungs-Profil-Name das gestartet werden soll.
' Wird hier nichts eingetragen muss ein Profil als Standard im VPN Client markiert sein. Konfiguration -> Profile
Const cVPN            = ""          

' Ist der Verbindungsaufbau des Profils auf "immer" im VPN Client eingestellt, muss eine Wartezeit für die Zeit des Verbindungsaufbaus eingetragen werden (~2-3 Sek.). Sonst 0
Const cWartezeit      = 0 'In Sekunden 
' ************************************************************

Dim oWsh, oApp, oFS, appAVPNC, appAVPNCCMD, appRDPP, argRDP
Dim sScriptPath, sTerminalServer, fAppAVPNC, sCMD, i, sTmp, sTmpfile
Const cAppAVPNCCMD = "ncpclientcmd.exe" 'VPN Client Commandline. 
Const cAppAVPNCPath = "\LANCOM\Advanced VPN Client\" 'VPN Client SubPath
Const cAppRDP    = "mstsc.exe" 'RemoteDesktop-Client

' ************************************************************
' Funktionen
' ************************************************************
'Funktion prüft ob eine Anwendung gestartet ist.
Function appInTask(sApp) '
  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	  
  Next  
  Set oSel = Nothing
  appInTask = fappRunning
End Function

' Nachdem die VPN-Verbindung aufgebaut ist wird den RDP-Server (Terminalserver) angepingt ob dieser ereichbar ist
Function ping(j)
  Dim i, sTmp, sPing    
  'Zeigt die Anzahl der Zeilen an welche die Zeichenfolge " TTL=" enthalten
  sPing = "ping -n 1 " & sTerminalServer & " | find /c "" TTL=""" 
  On Error Resume Next   
  i = 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 <= 0  
  ping = (i > 0)
End Function  

Function wrap(s)
  If InStr(1, s, " ", vbTextCompare) Then s = """" & s & """"
  wrap = s 
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

' ************************************************************
' Script
' ************************************************************
' sollen die CMD-Fenster angezeigt werden? 0 = versteckt [default], 1 = anzeigen 

Set oWSH = CreateObject("Wscript.shell")
Set oApp = CreateObject("Shell.Application")
Set oFS  = CreateObject("Scripting.FileSystemObject")
sCMD = oWsh.ExpandEnvironmentStrings("%COMSPEC%") & " /C "
' Pfad des Scripts.
sScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString)
sTmpfile = oWsh.ExpandEnvironmentStrings("%tmp%") & "\~info.txt"
' kompletter Dateipfad des VPN Clients 
appAVPNC = oWsh.ExpandEnvironmentStrings("%ProgramFiles%") & + cAppAVPNCPath + cAppAVPNC
appAVPNCCMD = oWsh.ExpandEnvironmentStrings("%ProgramFiles%") & + cAppAVPNCPath + cAppAVPNCCMD
If Not oFS.FileExists(appAVPNCCMD) Then
  appAVPNC = oWsh.ExpandEnvironmentStrings("%ProgramFiles(x86)%") & + cAppAVPNCPath + cAppAVPNC
  appAVPNCCMD = oWsh.ExpandEnvironmentStrings("%ProgramFiles(x86)%") & + cAppAVPNCPath + cAppAVPNCCMD
  If Not oFS.FileExists(appAVPNCCMD) Then
    oWsh.popup "Lancom Advanced VPN Client wurde nicht gefunden" , 15, "Fehler in der Installation", vbOKOnly
    WScript.Quit
  End If
End If

appAVPNC = wrap(appAVPNC)
appAVPNCCMD = wrap(appAVPNCCMD)
' RDP - Remotedesktopverbindung 
appRDPP = oWsh.ExpandEnvironmentStrings("%windir%") + "\system32\" + cAppRDP

' 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 InStr(1, cRDP, "%") > 0 Then
  argRDP = Replace(argRDP, "%HOMEDRIVE%", oWsh.ExpandEnvironmentStrings("%HOMEDRIVE%"))
  argRDP = Replace(argRDP, "%HOMEPATH%", oWsh.ExpandEnvironmentStrings("%HOMEPATH%"))
End If

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

If cAppAVPNC <> "" Then ' Soll der Client gestartet werden
  fAppAVPNC = appInTask(cAppAVPNC)
  If Not fAppAVPNC Then   
    oWsh.Exec appAVPNC                
  End If  
Else
  fAppAVPNC = False
End If

sTmp = appAVPNCCMD & " /writeClientInfoCenterData " & sTmpfile
oWsh.Run sTmp, 0, True  
sTmp = GetInfoFromFile(sTmpfile, "State")

If sTmp = "= disconnected" Then
  sTmp = appAVPNCCMD & " " & Trim("/connect " & cVPN)
  oWsh.Run sTmp, 0, True   
End If

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

'Wenn kein RDP mehr läuft VPN schließen
if Not appInTask(cAppRDP) Then  
  oWsh.run appAVPNCCMD & " /disconnect", 0, True
  If Not fAppAVPNC Then oWsh.Run appAVPNCCMD & " /stop", 0, True   
End If
On Error Resume Next
oFS.DeleteFile sTmpfile
Set oWSH = Nothing
Set oApp = Nothing
Set oFS  = Nothing