/[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.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
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 34  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() & Chr(34) & " " & Chr(34) & DetermineServerIP & Chr(34)              script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
60              Shell App.Path & "\" & script_name & " " & script_args, vbHide              Shell App.Path & "\" & script_name & " " & script_args, vbHide
61          End If          End If
62      'End If      'End If
# Line 69  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 85  Sub Main() Line 88  Sub Main()
88              End If              End If
89                    
90          End If          End If
91        
92        ' monitor
93        ElseIf cmdline.hasSwitch("monitor") Then
94            conName = cmdline.getArgument("monitor")
95            If conName <> "" Then
96            
97                ' run script
98                If cmdline.hasSwitch("script") Then
99                    ActionType = RUN_SCRIPT
100                    ScriptName = cmdline.getArgument("script")
101                End If
102            
103                ' add a route with target network via gateway
104                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
113            
114                'Set rasItem = RasEntries(conName)
115                'RasRetrieveConnectionHandler conName
116                ConnectionName = conName
117                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
130                
131            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 110  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
181    Public Sub detectOnlineOfflineChange()
182        Dim isOnline As Boolean
183        Dim script_name As String, script_args As String
184        Dim cmd As String
185        
186        isOnline = RasIsOnline(ConnectionName)
187        
188        If ConnectionOnline <> isOnline Then
189            'MsgBox isOnline
190            
191            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 cmd <> "" Then
216                'MsgBox cmd
217                On Error Resume Next
218                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
224            End If
225            
226            ConnectionOnline = isOnline
227            
228            UpdateTrayIcon getTrayIconTipText(ConnectionName, ConnectionOnline)
229            
230        End If
231    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.3  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed