--- joko/ToolBox/Windows/VpnDial/src/Module_Main.bas 2005/09/28 22:50:30 1.2 +++ joko/ToolBox/Windows/VpnDial/src/Module_Main.bas 2005/11/22 22:20:11 1.9 @@ -15,54 +15,135 @@ ' http://www.activevb.de/rubriken/apikatalog/deklarationen/rasenumentries.html ' http://www.dotnet247.com/247reference/msgs/18/93960.aspx +' contains all ras entry objects Public RasEntries As New Collection +' globals to store connection name and state +Public ConnectionName As String +Public ConnectionOnline As Boolean + +' globals to store information about action to do on up|down +Enum ActionTypes + RUN_SCRIPT + ADD_ROUTE +End Enum +Public ActionType As ActionTypes + +Public ScriptName As String +Public RouteNet As String, RouteMask As String + +Const RouteMaskDefault As String = "255.255.255.0" + + Sub Main() Dim cmdline As New CommandLine Dim conName As String - Dim script_name As String, script_args As String Dim rasItem As RasEntryData Dim success As Boolean + + Dim script_name As String, script_args As String + Dim setup_user As String, setup_pass As String ReadRasEntries cmdline.parse - If cmdline.hasSwitch("gui") Then - Form_Main.Show - Else - - If cmdline.hasSwitch("dial") Then + 'If cmdline.hasSwitch("gui") Then + ' Form_Main.Show + 'Else + + ' run script + If cmdline.hasSwitch("script") And success = True Then + script_name = cmdline.getArgument("script") + If script_name <> "" Then + script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34) + Shell App.Path & "\" & script_name & " " & script_args, vbHide + End If + 'End If + + ' setup + ElseIf cmdline.hasSwitch("setup") Then + conName = cmdline.getArgument("setup") + If conName <> "" Then - ' dial command - conName = cmdline.getArgument("dial") On Error Resume Next Set rasItem = RasEntries(conName) - If Err.Number = 0 Then - success = RasConnect(rasItem.entryname, rasItem.PhonebookPath) - Else - MsgBox "Unkown RAS-Connection """ & conName & """." + If Err.Number <> 0 Then + MsgBox "Error while accessing RAS entry """ & conName & """." & vbCrLf & "Probably it does not exist?" + End End If On Error GoTo 0 - ElseIf cmdline.hasSwitch("hangup") Then - ' hangup command - conName = cmdline.getArgument("hangup") - success = RasDisconnect(conName) - 'MsgBox success + If cmdline.hasSwitch("gui") Then + With Form_Credentials + .ras_connectionName = rasItem.entryname + .ras_phoneBook = rasItem.PhonebookPath + .Show + End With + + ElseIf cmdline.hasSwitch("user") And cmdline.hasSwitch("pass") Then + setup_user = cmdline.getArgument("user") + setup_pass = cmdline.getArgument("pass") + SetupRasEntry rasItem.entryname, rasItem.PhonebookPath, setup_user, setup_pass + End If End If + + ' monitor + ElseIf cmdline.hasSwitch("monitor") Then + conName = cmdline.getArgument("monitor") + If conName <> "" Then + + ' run script + If cmdline.hasSwitch("script") Then + ActionType = RUN_SCRIPT + ScriptName = cmdline.getArgument("script") + End If - ' run script - If cmdline.hasSwitch("script") And success = True Then - script_name = cmdline.getArgument("script") - If script_name <> "" Then - script_args = Chr(34) & DetermineClientIP() & Chr(34) & " " & Chr(34) & DetermineServerIP & Chr(34) - Shell App.Path & "\" & script_name & " " & script_args, vbHide + ' add a route with target network via gateway + If cmdline.hasSwitch("net") Then + ActionType = ADD_ROUTE + RouteNet = cmdline.getArgument("net") + If cmdline.hasSwitch("mask") Then + RouteMask = cmdline.getArgument("mask") + Else + RouteMask = RouteMaskDefault + End If End If - End If + 'Set rasItem = RasEntries(conName) + 'RasRetrieveConnectionHandler conName + ConnectionName = conName + ConnectionOnline = RasIsOnline(conName) + + If cmdline.hasSwitch("gui") Then + ShowTrayIcon Form_Main, getTrayIconTipText(ConnectionName, ConnectionOnline) + End If + + ' dial command + If cmdline.hasSwitch("dial") Then + doDial conName + End If + + ' monitor ras connection + MonitorRASStatusAsync + + End If + + ' dial command + ElseIf cmdline.hasSwitch("dial") Then + conName = cmdline.getArgument("dial") + doDial conName + + ' hangup command + ElseIf cmdline.hasSwitch("hangup") Then + conName = cmdline.getArgument("hangup") + success = RasDisconnect(conName) + 'MsgBox success + End If + + 'End If End Sub @@ -85,7 +166,94 @@ rasItem.PhonebookPath = curEntry.PhonebookPath rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook + 'MsgBox rasItem.entryname + On Error Resume Next RasEntries.add rasItem, rasItem.entryname + If Err.Number = 457 Then + 'MsgBox "Error: Duplicate RAS entry. Don't know what to dial. This error should not occour." + End If + On Error GoTo 0 Next i End Sub + +' callback from MonitorRASStatusAsync +Public Sub detectOnlineOfflineChange() + Dim isOnline As Boolean + Dim script_name As String, script_args As String + Dim cmd As String + + isOnline = RasIsOnline(ConnectionName) + + If ConnectionOnline <> isOnline Then + 'MsgBox isOnline + + Select Case ActionType + + Case RUN_SCRIPT: + script_name = ScriptName + If script_name <> "" Then + script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34) + cmd = App.Path & "\" & script_name & " " & script_args + End If + + Case ADD_ROUTE: + ' connection goes online + If isOnline = True Then + script_name = "route" + script_args = "add " & RouteNet & " mask " & RouteMask & " " & DetermineClientIP(ConnectionName) + cmd = script_name & " " & script_args + + ' connection goes offline + Else + ' Nothing to do in this case + + End If + + End Select + + If cmd <> "" Then + 'MsgBox cmd + On Error Resume Next + Shell cmd, vbHide + 'Shell cmd, vbNormalFocus + 'If Err.Number <> 0 Then + ' MsgBox "Error while calling cmd: " & cmd & vbCrLf & "Error-Number: " & Err.Number + 'End If + On Error GoTo 0 + End If + + ConnectionOnline = isOnline + + UpdateTrayIcon getTrayIconTipText(ConnectionName, ConnectionOnline) + + End If +End Sub + +Private Function getTrayIconTipText(conName As String, isOnline As Boolean) As String + Dim TipText As String + TipText = "VpnDial monitoring """ & conName & """: " + If isOnline Then + TipText = TipText & "online" + Else + TipText = TipText & "offline" + End If + getTrayIconTipText = TipText +End Function + + +Private Function doDial(conName As String) + + Dim rasItem As RasEntryData + Dim success As Boolean + + On Error Resume Next + Set rasItem = RasEntries(conName) + If Err.Number = 0 Then + success = RasConnect(rasItem.entryname, rasItem.PhonebookPath) + Else + MsgBox "Unknown RAS-Connection """ & conName & """." + End If + On Error GoTo 0 + +End Function