/[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.7 by joko, Sat Oct 8 01:01:45 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")  
             On Error Resume Next  
90              Set rasItem = RasEntries(conName)              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  
91                    
92          ElseIf cmdline.hasSwitch("hangup") Then              If cmdline.hasSwitch("gui") Then
93              ' hangup command                  With Form_Credentials
94              conName = cmdline.getArgument("hangup")                      .ras_connectionName = rasItem.entryname
95              success = RasDisconnect(conName)                      .ras_phoneBook = rasItem.PhonebookPath
96              'MsgBox success                      .Show
97                    End With
98            
99                ElseIf cmdline.hasSwitch("user") And cmdline.hasSwitch("pass") Then
100                    setup_user = cmdline.getArgument("user")
101                    setup_pass = cmdline.getArgument("pass")
102                    SetupRasEntry rasItem.entryname, rasItem.PhonebookPath, setup_user, setup_pass
103                End If
104                    
105          End If          End If
106        
107        ' monitor
108        ElseIf cmdline.hasSwitch("monitor") Then
109            conName = cmdline.getArgument("monitor")
110            If conName <> "" Then
111            
112                ' run script
113                If cmdline.hasSwitch("script") Then
114                    ActionType = RUN_SCRIPT
115                    ScriptName = cmdline.getArgument("script")
116                End If
117                    
118          ' run script              ' add a route with target network via gateway
119          If cmdline.hasSwitch("script") And success = True Then              If cmdline.hasSwitch("net") Then
120              script_name = cmdline.getArgument("script")                  ActionType = ADD_ROUTE
121              If script_name <> "" Then                  RouteNet = cmdline.getArgument("net")
122                  script_args = Chr(34) & DetermineClientIP() & Chr(34) & " " & Chr(34) & DetermineServerIP & Chr(34)                  If cmdline.hasSwitch("mask") Then
123                  Shell App.Path & "\" & script_name & " " & script_args, vbHide                      RouteMask = cmdline.getArgument("mask")
124                    Else
125                        RouteMask = RouteMaskDefault
126                    End If
127              End If              End If
         End If  
128                    
129                'Set rasItem = RasEntries(conName)
130                'RasRetrieveConnectionHandler conName
131                ConnectionName = conName
132                ConnectionOnline = RasIsOnline(conName)
133                MonitorRASStatusAsync
134            End If
135    
136      End If      End If
137            
138        'End If
139            
140  End Sub  End Sub
141    
# Line 89  Private Sub ReadRasEntries() Line 162  Private Sub ReadRasEntries()
162      Next i      Next i
163    
164  End Sub  End Sub
165    
166    ' callback from MonitorRASStatusAsync
167    Public Sub detectOnlineOfflineChange()
168        Dim isOnline As Boolean
169        Dim script_name As String, script_args As String
170        Dim cmd As String
171        
172        isOnline = RasIsOnline(ConnectionName)
173        
174        If ConnectionOnline <> isOnline Then
175            'MsgBox isOnline
176            
177            Select Case ActionType
178                
179                Case RUN_SCRIPT:
180                    script_name = ScriptName
181                    If script_name <> "" Then
182                        script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)
183                        cmd = App.Path & "\" & script_name & " " & script_args
184                    End If
185                    
186                Case ADD_ROUTE:
187                    ' connection goes online
188                    If isOnline = True Then
189                        script_name = "route"
190                        script_args = "add " & RouteNet & " mask " & RouteMask & " " & DetermineClientIP(ConnectionName)
191                        cmd = script_name & " " & script_args
192                    
193                    ' connection goes offline
194                    Else
195                        ' Nothing to do in this case
196                    
197                    End If
198                
199            End Select
200            
201            If cmd <> "" Then
202                'MsgBox cmd
203                On Error Resume Next
204                Shell cmd, vbHide
205                'Shell cmd, vbNormalFocus
206                'If Err.Number <> 0 Then
207                '    MsgBox "Error while calling cmd: " & cmd & vbCrLf & "Error-Number: " & Err.Number
208                'End If
209                On Error GoTo 0
210            End If
211            
212            ConnectionOnline = isOnline
213        End If
214    End Sub
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed