--- joko/ToolBox/Windows/VpnDial/src/Module_Main.bas	2005/10/06 20:15:34	1.3
+++ joko/ToolBox/Windows/VpnDial/src/Module_Main.bas	2005/10/09 18:42:25	1.8
@@ -15,8 +15,26 @@
 ' 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
@@ -59,7 +77,7 @@
     ElseIf 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)
+            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
@@ -69,7 +87,13 @@
         conName = cmdline.getArgument("setup")
         If conName <> "" Then
         
+            On Error Resume Next
             Set rasItem = RasEntries(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
         
             If cmdline.hasSwitch("gui") Then
                 With Form_Credentials
@@ -85,6 +109,41 @@
             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)
+            
+            If cmdline.hasSwitch("gui") Then
+                ShowTrayIcon Form_Main, getTrayIconTipText(ConnectionName, ConnectionOnline)
+            End If
+            
+            MonitorRASStatusAsync
+        End If
+
     End If
         
     'End If
@@ -110,7 +169,77 @@
         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