/[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.5 by joko, Fri Oct 7 20:59:27 2005 UTC revision 1.9 by joko, Tue Nov 22 22:20:11 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 37  Sub Main() Line 52  Sub Main()
52      '    Form_Main.Show      '    Form_Main.Show
53      'Else      'Else
54                    
     ' 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  
       
55      ' run script      ' run script
56      ElseIf cmdline.hasSwitch("script") And success = True Then      If cmdline.hasSwitch("script") And success = True Then
57          script_name = cmdline.getArgument("script")          script_name = cmdline.getArgument("script")
58          If script_name <> "" Then          If script_name <> "" Then
59              script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)              script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
# Line 72  Sub Main() Line 66  Sub Main()
66          conName = cmdline.getArgument("setup")          conName = cmdline.getArgument("setup")
67          If conName <> "" Then          If conName <> "" Then
68                    
69                On Error Resume Next
70              Set rasItem = RasEntries(conName)              Set rasItem = RasEntries(conName)
71                If Err.Number <> 0 Then
72                    MsgBox "Error while accessing RAS entry """ & conName & """." & vbCrLf & "Probably it does not exist?"
73                    End
74                End If
75                On Error GoTo 0
76                    
77              If cmdline.hasSwitch("gui") Then              If cmdline.hasSwitch("gui") Then
78                  With Form_Credentials                  With Form_Credentials
# Line 94  Sub Main() Line 94  Sub Main()
94          conName = cmdline.getArgument("monitor")          conName = cmdline.getArgument("monitor")
95          If conName <> "" Then          If conName <> "" Then
96                    
97              If cmdline.hasSwitch("up") Then              ' run script
98                  ScriptName_Up = cmdline.getArgument("up")              If cmdline.hasSwitch("script") Then
99                    ActionType = RUN_SCRIPT
100                    ScriptName = cmdline.getArgument("script")
101              End If              End If
102                    
103              If cmdline.hasSwitch("down") Then              ' add a route with target network via gateway
104                  ScriptName_Down = cmdline.getArgument("down")              If cmdline.hasSwitch("net") Then
105                    ActionType = ADD_ROUTE
106                    RouteNet = cmdline.getArgument("net")
107                    If cmdline.hasSwitch("mask") Then
108                        RouteMask = cmdline.getArgument("mask")
109                    Else
110                        RouteMask = RouteMaskDefault
111                    End If
112              End If              End If
113                    
114              'Set rasItem = RasEntries(conName)              'Set rasItem = RasEntries(conName)
115              'RasRetrieveConnectionHandler conName              'RasRetrieveConnectionHandler conName
116              ConnectionName = conName              ConnectionName = conName
117              ConnectionOnline = RasIsOnline(conName)              ConnectionOnline = RasIsOnline(conName)
118                
119                If cmdline.hasSwitch("gui") Then
120                    ShowTrayIcon Form_Main, getTrayIconTipText(ConnectionName, ConnectionOnline)
121                End If
122                
123                ' dial command
124                If cmdline.hasSwitch("dial") Then
125                    doDial conName
126                End If
127                
128                ' monitor ras connection
129              MonitorRASStatusAsync              MonitorRASStatusAsync
130                
131          End If          End If
132    
133        ' dial command
134        ElseIf cmdline.hasSwitch("dial") Then
135            conName = cmdline.getArgument("dial")
136            doDial conName
137        
138        ' hangup command
139        ElseIf cmdline.hasSwitch("hangup") Then
140            conName = cmdline.getArgument("hangup")
141            success = RasDisconnect(conName)
142            'MsgBox success
143    
144      End If      End If
145                    
146      'End If      'End If
# Line 134  Private Sub ReadRasEntries() Line 166  Private Sub ReadRasEntries()
166          rasItem.PhonebookPath = curEntry.PhonebookPath          rasItem.PhonebookPath = curEntry.PhonebookPath
167          rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook          rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook
168                    
169            'MsgBox rasItem.entryname
170            On Error Resume Next
171          RasEntries.add rasItem, rasItem.entryname          RasEntries.add rasItem, rasItem.entryname
172            If Err.Number = 457 Then
173                'MsgBox "Error: Duplicate RAS entry. Don't know what to dial. This error should not occour."
174            End If
175            On Error GoTo 0
176      Next i      Next i
177    
178  End Sub  End Sub
179    
180  ' callback from MonitorRASStatusAsync  ' callback from MonitorRASStatusAsync
181  Public Sub detectOnlineOfflineChange()  Public Sub detectOnlineOfflineChange()
182      Dim newState As Boolean      Dim isOnline As Boolean
183      Dim script_name As String, script_args As String      Dim script_name As String, script_args As String
184      Dim cmd As String      Dim cmd As String
185            
186      newState = RasIsOnline(ConnectionName)      isOnline = RasIsOnline(ConnectionName)
187            
188      If ConnectionOnline <> newState Then      If ConnectionOnline <> isOnline Then
189          '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  
190                    
191          End If          Select Case ActionType
192                
193                Case RUN_SCRIPT:
194                    script_name = ScriptName
195                    If script_name <> "" Then
196                        script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)
197                        cmd = App.Path & "\" & script_name & " " & script_args
198                    End If
199                    
200                Case ADD_ROUTE:
201                    ' connection goes online
202                    If isOnline = True Then
203                        script_name = "route"
204                        script_args = "add " & RouteNet & " mask " & RouteMask & " " & DetermineClientIP(ConnectionName)
205                        cmd = script_name & " " & script_args
206                    
207                    ' connection goes offline
208                    Else
209                        ' Nothing to do in this case
210                    
211                    End If
212                
213            End Select
214                    
215          If script_name <> "" Then          If cmd <> "" Then
             script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)  
             cmd = App.Path & "\" & script_name & " " & script_args  
216              'MsgBox cmd              'MsgBox cmd
217              On Error Resume Next              On Error Resume Next
218              Shell cmd, vbHide              Shell cmd, vbHide
219                'Shell cmd, vbNormalFocus
220                'If Err.Number <> 0 Then
221                '    MsgBox "Error while calling cmd: " & cmd & vbCrLf & "Error-Number: " & Err.Number
222                'End If
223              On Error GoTo 0              On Error GoTo 0
224          End If          End If
225                    
226          ConnectionOnline = newState          ConnectionOnline = isOnline
227            
228            UpdateTrayIcon getTrayIconTipText(ConnectionName, ConnectionOnline)
229            
230      End If      End If
231  End Sub  End Sub
232    
233    Private Function getTrayIconTipText(conName As String, isOnline As Boolean) As String
234        Dim TipText As String
235        TipText = "VpnDial monitoring """ & conName & """: "
236        If isOnline Then
237            TipText = TipText & "online"
238        Else
239            TipText = TipText & "offline"
240        End If
241        getTrayIconTipText = TipText
242    End Function
243    
244    
245    Private Function doDial(conName As String)
246    
247        Dim rasItem As RasEntryData
248        Dim success As Boolean
249    
250        On Error Resume Next
251        Set rasItem = RasEntries(conName)
252        If Err.Number = 0 Then
253            success = RasConnect(rasItem.entryname, rasItem.PhonebookPath)
254        Else
255            MsgBox "Unknown RAS-Connection """ & conName & """."
256        End If
257        On Error GoTo 0
258    
259    End Function
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed