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).
* Lancom-Router auf Empfänger/Serverseite
* Eine funtionsfähige VPN-Verbindung via Lancom Advanced VPN-Client sollte bestehen.
* Eine RDP-Sitzung sollte darüber laufen.
Das Script verwendet denLancom Advanced VPN-Clien
Damit nicht ein schwarzen Fenster während der Laufzeit der RDP-Sitzung bestehen bleibt wird ein Hilfsscript verwendet.
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
runRDPviaLancomAdvancedVPNClient.vbs Script um erst den VPN-Client dann die Remotedesktopverbindung starten
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