/[cvs]/joko/ToolBox/Windows/VpnDial/src/Module_Main.bas
ViewVC logotype

Diff of /joko/ToolBox/Windows/VpnDial/src/Module_Main.bas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by joko, Fri Oct 7 20:25:24 2005 UTC revision 1.8 by joko, Sun Oct 9 18:42:25 2005 UTC
# Line 15  Option Explicit Line 15  Option Explicit
15  ' http://www.activevb.de/rubriken/apikatalog/deklarationen/rasenumentries.html  ' http://www.activevb.de/rubriken/apikatalog/deklarationen/rasenumentries.html
16  ' http://www.dotnet247.com/247reference/msgs/18/93960.aspx  ' http://www.dotnet247.com/247reference/msgs/18/93960.aspx
17    
18    ' contains all ras entry objects
19  Public RasEntries As New Collection  Public RasEntries As New Collection
20    
21    ' globals to store connection name and state
22  Public ConnectionName As String  Public ConnectionName As String
23  Public ConnectionOnline As Boolean  Public ConnectionOnline As Boolean
24  Public ScriptName_Up As String, ScriptName_Down As String  
25    ' globals to store information about action to do on up|down
26    Enum ActionTypes
27        RUN_SCRIPT
28        ADD_ROUTE
29    End Enum
30    Public ActionType As ActionTypes
31    
32    Public ScriptName As String
33    Public RouteNet As String, RouteMask As String
34    
35    Const RouteMaskDefault As String = "255.255.255.0"
36    
37    
38  Sub Main()  Sub Main()
39    
# Line 62  Sub Main() Line 77  Sub Main()
77      ElseIf cmdline.hasSwitch("script") And success = True Then      ElseIf cmdline.hasSwitch("script") And success = True Then
78          script_name = cmdline.getArgument("script")          script_name = cmdline.getArgument("script")
79          If script_name <> "" Then          If script_name <> "" Then
80              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)
81              Shell App.Path & "\" & script_name & " " & script_args, vbHide              Shell App.Path & "\" & script_name & " " & script_args, vbHide
82          End If          End If
83      'End If      'End If
# Line 72  Sub Main() Line 87  Sub Main()
87          conName = cmdline.getArgument("setup")          conName = cmdline.getArgument("setup")
88          If conName <> "" Then          If conName <> "" Then
89                    
90                On Error Resume Next
91              Set rasItem = RasEntries(conName)              Set rasItem = RasEntries(conName)
92                If Err.Number <> 0 Then
93                    MsgBox "Error while accessing RAS entry """ & conName & """." & vbCrLf & "Probably it does not exist?"
94                    End
95                End If
96                On Error GoTo 0
97                    
98              If cmdline.hasSwitch("gui") Then              If cmdline.hasSwitch("gui") Then
99                  With Form_Credentials                  With Form_Credentials
# Line 94  Sub Main() Line 115  Sub Main()
115          conName = cmdline.getArgument("monitor")          conName = cmdline.getArgument("monitor")
116          If conName <> "" Then          If conName <> "" Then
117                    
118              If cmdline.hasSwitch("up") Then              ' run script
119                  ScriptName_Up = cmdline.getArgument("up")              If cmdline.hasSwitch("script") Then
120                    ActionType = RUN_SCRIPT
121                    ScriptName = cmdline.getArgument("script")
122              End If              End If
123                    
124              If cmdline.hasSwitch("down") Then              ' add a route with target network via gateway
125                  ScriptName_Down = cmdline.getArgument("down")              If cmdline.hasSwitch("net") Then
126                    ActionType = ADD_ROUTE
127                    RouteNet = cmdline.getArgument("net")
128                    If cmdline.hasSwitch("mask") Then
129                        RouteMask = cmdline.getArgument("mask")
130                    Else
131                        RouteMask = RouteMaskDefault
132                    End If
133              End If              End If
134                    
135              'Set rasItem = RasEntries(conName)              'Set rasItem = RasEntries(conName)
136              'RasRetrieveConnectionHandler conName              'RasRetrieveConnectionHandler conName
137              ConnectionName = conName              ConnectionName = conName
138              ConnectionOnline = RasIsOnline(conName)              ConnectionOnline = RasIsOnline(conName)
139                
140                If cmdline.hasSwitch("gui") Then
141                    ShowTrayIcon Form_Main, getTrayIconTipText(ConnectionName, ConnectionOnline)
142                End If
143                
144              MonitorRASStatusAsync              MonitorRASStatusAsync
145          End If          End If
146    
# Line 134  Private Sub ReadRasEntries() Line 169  Private Sub ReadRasEntries()
169          rasItem.PhonebookPath = curEntry.PhonebookPath          rasItem.PhonebookPath = curEntry.PhonebookPath
170          rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook          rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook
171                    
172            'MsgBox rasItem.entryname
173            On Error Resume Next
174          RasEntries.add rasItem, rasItem.entryname          RasEntries.add rasItem, rasItem.entryname
175            If Err.Number = 457 Then
176                MsgBox "Error: Duplicate RAS entry. Don't know what to dial. This error should not occour."
177            End If
178            On Error GoTo 0
179      Next i      Next i
180    
181  End Sub  End Sub
182    
183  ' callback from MonitorRASStatusAsync  ' callback from MonitorRASStatusAsync
184  Public Sub detectOnlineOfflineChange()  Public Sub detectOnlineOfflineChange()
185      Dim newState As Boolean      Dim isOnline As Boolean
186      Dim script_name As String, script_args As String      Dim script_name As String, script_args As String
187      Dim cmd As String      Dim cmd As String
188            
189      newState = RasIsOnline(ConnectionName)      isOnline = RasIsOnline(ConnectionName)
190            
191      If ConnectionOnline <> newState Then      If ConnectionOnline <> isOnline Then
192          'MsgBox newState          'MsgBox isOnline
           
         ' connection goes online  
         If newState = True Then  
             If ScriptName_Up <> "" Then  
                 script_name = ScriptName_Up  
             End If  
           
         ' connection goes offline  
         Else  
             If ScriptName_Down <> "" Then  
                 script_name = ScriptName_Down  
             End If  
193                    
194          End If          Select Case ActionType
195                
196                Case RUN_SCRIPT:
197                    script_name = ScriptName
198                    If script_name <> "" Then
199                        script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)
200                        cmd = App.Path & "\" & script_name & " " & script_args
201                    End If
202                    
203                Case ADD_ROUTE:
204                    ' connection goes online
205                    If isOnline = True Then
206                        script_name = "route"
207                        script_args = "add " & RouteNet & " mask " & RouteMask & " " & DetermineClientIP(ConnectionName)
208                        cmd = script_name & " " & script_args
209                    
210                    ' connection goes offline
211                    Else
212                        ' Nothing to do in this case
213                    
214                    End If
215                
216            End Select
217                    
218          If script_name <> "" Then          If cmd <> "" Then
             script_args = Chr(34) & DetermineClientIP() & Chr(34) & " " & Chr(34) & DetermineServerIP() & Chr(34)  
             cmd = App.Path & "\" & script_name & " " & script_args  
219              'MsgBox cmd              'MsgBox cmd
220              On Error Resume Next              On Error Resume Next
221              Shell cmd, vbHide              Shell cmd, vbHide
222                'Shell cmd, vbNormalFocus
223                'If Err.Number <> 0 Then
224                '    MsgBox "Error while calling cmd: " & cmd & vbCrLf & "Error-Number: " & Err.Number
225                'End If
226              On Error GoTo 0              On Error GoTo 0
227          End If          End If
228                    
229          ConnectionOnline = newState          ConnectionOnline = isOnline
230            
231            UpdateTrayIcon getTrayIconTipText(ConnectionName, ConnectionOnline)
232            
233      End If      End If
234  End Sub  End Sub
235    
236    Private Function getTrayIconTipText(conName As String, isOnline As Boolean) As String
237        Dim TipText As String
238        TipText = "VpnDial monitoring """ & conName & """: "
239        If isOnline Then
240            TipText = TipText & "online"
241        Else
242            TipText = TipText & "offline"
243        End If
244        getTrayIconTipText = TipText
245    End Function
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed