--- joko/ToolBox/Windows/VpnDial/src/Module_Main.bas 2005/09/28 20:36:46 1.1 +++ joko/ToolBox/Windows/VpnDial/src/Module_Main.bas 2005/10/08 00:22:10 1.6 @@ -15,22 +15,127 @@ ' 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 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 - conName = cmdline.getArgument(conName) - MsgBox conName + 'If cmdline.hasSwitch("gui") Then + ' Form_Main.Show + 'Else + + ' dial command + If cmdline.hasSwitch("dial") Then + + 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 & """." + End If + On Error GoTo 0 + + ' hangup command + ElseIf cmdline.hasSwitch("hangup") Then + conName = cmdline.getArgument("hangup") + success = RasDisconnect(conName) + 'MsgBox success + + 'End If + + ' run script + ElseIf 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 + + Set rasItem = RasEntries(conName) + + 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 + + ' 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 + + 'Set rasItem = RasEntries(conName) + 'RasRetrieveConnectionHandler conName + ConnectionName = conName + ConnectionOnline = RasIsOnline(conName) + MonitorRASStatusAsync + End If + End If + + 'End If End Sub @@ -57,3 +162,49 @@ 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 + On Error GoTo 0 + End If + + ConnectionOnline = isOnline + End If +End Sub