/[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.3 by joko, Thu Oct 6 20:15:34 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
23    Public ConnectionOnline As Boolean
24    
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    
40      Dim cmdline As New CommandLine      Dim cmdline As New CommandLine
# Line 59  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 69  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 85  Sub Main() Line 109  Sub Main()
109              End If              End If
110                    
111          End If          End If
112        
113        ' monitor
114        ElseIf cmdline.hasSwitch("monitor") Then
115            conName = cmdline.getArgument("monitor")
116            If conName <> "" Then
117            
118                ' run script
119                If cmdline.hasSwitch("script") Then
120                    ActionType = RUN_SCRIPT
121                    ScriptName = cmdline.getArgument("script")
122                End If
123            
124                ' add a route with target network via gateway
125                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
134            
135                'Set rasItem = RasEntries(conName)
136                'RasRetrieveConnectionHandler conName
137                ConnectionName = conName
138                ConnectionOnline = RasIsOnline(conName)
139                
140                If cmdline.hasSwitch("gui") Then
141                    ShowTrayIcon Form_Main, getTrayIconTipText(ConnectionName, ConnectionOnline)
142                End If
143                
144                MonitorRASStatusAsync
145            End If
146    
147      End If      End If
148                    
149      'End If      'End If
# Line 110  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
184    Public Sub detectOnlineOfflineChange()
185        Dim isOnline As Boolean
186        Dim script_name As String, script_args As String
187        Dim cmd As String
188        
189        isOnline = RasIsOnline(ConnectionName)
190        
191        If ConnectionOnline <> isOnline Then
192            'MsgBox isOnline
193            
194            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 cmd <> "" Then
219                'MsgBox cmd
220                On Error Resume Next
221                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
227            End If
228            
229            ConnectionOnline = isOnline
230            
231            UpdateTrayIcon getTrayIconTipText(ConnectionName, ConnectionOnline)
232            
233        End If
234    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.3  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed