/[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.2 by joko, Wed Sep 28 22:50:30 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
41      Dim conName As String      Dim conName As String
     Dim script_name As String, script_args As String  
42      Dim rasItem As RasEntryData      Dim rasItem As RasEntryData
43      Dim success As Boolean      Dim success As Boolean
44        
45        Dim script_name As String, script_args As String
46        Dim setup_user As String, setup_pass As String
47    
48      ReadRasEntries      ReadRasEntries
49      cmdline.parse      cmdline.parse
50            
51      If cmdline.hasSwitch("gui") Then      'If cmdline.hasSwitch("gui") Then
52          Form_Main.Show      '    Form_Main.Show
53      Else      'Else
54                    
55          If cmdline.hasSwitch("dial") Then      ' dial command
56        If cmdline.hasSwitch("dial") Then
57        
58            conName = cmdline.getArgument("dial")
59            On Error Resume Next
60            Set rasItem = RasEntries(conName)
61            If Err.Number = 0 Then
62                success = RasConnect(rasItem.entryname, rasItem.PhonebookPath)
63            Else
64                MsgBox "Unkown RAS-Connection """ & conName & """."
65            End If
66            On Error GoTo 0
67        
68        ' hangup command
69        ElseIf cmdline.hasSwitch("hangup") Then
70            conName = cmdline.getArgument("hangup")
71            success = RasDisconnect(conName)
72            'MsgBox success
73        
74        'End If
75        
76        ' run script
77        ElseIf cmdline.hasSwitch("script") And success = True Then
78            script_name = cmdline.getArgument("script")
79            If script_name <> "" Then
80                script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
81                Shell App.Path & "\" & script_name & " " & script_args, vbHide
82            End If
83        'End If
84        
85        ' setup
86        ElseIf cmdline.hasSwitch("setup") Then
87            conName = cmdline.getArgument("setup")
88            If conName <> "" Then
89                    
             ' dial command  
             conName = cmdline.getArgument("dial")  
90              On Error Resume Next              On Error Resume Next
91              Set rasItem = RasEntries(conName)              Set rasItem = RasEntries(conName)
92              If Err.Number = 0 Then              If Err.Number <> 0 Then
93                  success = RasConnect(rasItem.entryname, rasItem.PhonebookPath)                  MsgBox "Error while accessing RAS entry """ & conName & """." & vbCrLf & "Probably it does not exist?"
94              Else                  End
                 MsgBox "Unkown RAS-Connection """ & conName & """."  
95              End If              End If
96              On Error GoTo 0              On Error GoTo 0
97                    
98          ElseIf cmdline.hasSwitch("hangup") Then              If cmdline.hasSwitch("gui") Then
99              ' hangup command                  With Form_Credentials
100              conName = cmdline.getArgument("hangup")                      .ras_connectionName = rasItem.entryname
101              success = RasDisconnect(conName)                      .ras_phoneBook = rasItem.PhonebookPath
102              'MsgBox success                      .Show
103                    End With
104            
105                ElseIf cmdline.hasSwitch("user") And cmdline.hasSwitch("pass") Then
106                    setup_user = cmdline.getArgument("user")
107                    setup_pass = cmdline.getArgument("pass")
108                    SetupRasEntry rasItem.entryname, rasItem.PhonebookPath, setup_user, setup_pass
109                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          ' run script              ' add a route with target network via gateway
125          If cmdline.hasSwitch("script") And success = True Then              If cmdline.hasSwitch("net") Then
126              script_name = cmdline.getArgument("script")                  ActionType = ADD_ROUTE
127              If script_name <> "" Then                  RouteNet = cmdline.getArgument("net")
128                  script_args = Chr(34) & DetermineClientIP() & Chr(34) & " " & Chr(34) & DetermineServerIP & Chr(34)                  If cmdline.hasSwitch("mask") Then
129                  Shell App.Path & "\" & script_name & " " & script_args, vbHide                      RouteMask = cmdline.getArgument("mask")
130                    Else
131                        RouteMask = RouteMaskDefault
132                    End If
133              End If              End If
         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
150            
151  End Sub  End Sub
152    
# Line 85  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.2  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed