VpnDial/src/Module_Main.bas

Attribute VB_Name = "Module_Main"
Option Explicit

' see: How To Obtain the IP Address Assigned to a RAS Client
' http://support.microsoft.com/default.aspx?scid=kb;en-us;160622

' see: RasGetProjectionInfo
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcecomm5/html/wce50lrfRasGetProjectionInfo.asp

' http://home.iprimus.com.au/billmcc/PlatformVB/dun/rasenumentries.htm
' http://home.iprimus.com.au/billmcc/PlatformVB/dun/raserrorhandler.htm
' http://www.mentalis.org/apilist/RasEnumEntries.shtml

' http://www.activevb.de/tipps/tipkat/kat1.html
' http://www.activevb.de/rubriken/apikatalog/deklarationen/rasenumentries.html
' http://www.dotnet247.com/247reference/msgs/18/93960.aspx

' contains all ras entry objects
Public RasEntries As New Collection

' globals to store connection name and state
Public ConnectionName As String
Public ConnectionOnline As Boolean

' globals to store information about action to do on up|down
Enum ActionTypes
    RUN_SCRIPT
    ADD_ROUTE
End Enum
Public ActionType As ActionTypes

Public ScriptName As String
Public RouteNet As String, RouteMask As String

Const RouteMaskDefault As String = "255.255.255.0"


Sub Main()

    Dim cmdline As New CommandLine
    Dim conName As String
    Dim rasItem As RasEntryData
    Dim success As Boolean
    
    Dim script_name As String, script_args As String
    Dim setup_user As String, setup_pass As String

    ReadRasEntries
    cmdline.parse
    
    'If cmdline.hasSwitch("gui") Then
    '    Form_Main.Show
    'Else
        
    ' 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
    
    ' run script
    ElseIf cmdline.hasSwitch("script") And success = True Then
        script_name = cmdline.getArgument("script")
        If script_name <> "" Then
            script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
            Shell App.Path & "\" & script_name & " " & script_args, vbHide
        End If
    'End If
    
    ' setup
    ElseIf cmdline.hasSwitch("setup") Then
        conName = cmdline.getArgument("setup")
        If conName <> "" Then
        
            Set rasItem = RasEntries(conName)
        
            If cmdline.hasSwitch("gui") Then
                With Form_Credentials
                    .ras_connectionName = rasItem.entryname
                    .ras_phoneBook = rasItem.PhonebookPath
                    .Show
                End With
        
            ElseIf cmdline.hasSwitch("user") And cmdline.hasSwitch("pass") Then
                setup_user = cmdline.getArgument("user")
                setup_pass = cmdline.getArgument("pass")
                SetupRasEntry rasItem.entryname, rasItem.PhonebookPath, setup_user, setup_pass
            End If
        
        End If
    
    ' monitor
    ElseIf cmdline.hasSwitch("monitor") Then
        conName = cmdline.getArgument("monitor")
        If conName <> "" Then
        
            ' run script
            If cmdline.hasSwitch("script") Then
                ActionType = RUN_SCRIPT
                ScriptName = cmdline.getArgument("script")
            End If
        
            ' add a route with target network via gateway
            If cmdline.hasSwitch("net") Then
                ActionType = ADD_ROUTE
                RouteNet = cmdline.getArgument("net")
                If cmdline.hasSwitch("mask") Then
                    RouteMask = cmdline.getArgument("mask")
                Else
                    RouteMask = RouteMaskDefault
                End If
            End If
        
            'Set rasItem = RasEntries(conName)
            'RasRetrieveConnectionHandler conName
            ConnectionName = conName
            ConnectionOnline = RasIsOnline(conName)
            MonitorRASStatusAsync
        End If

    End If
        
    'End If
    
End Sub

Private Sub ReadRasEntries()

    Dim myEntries() As VBRasEntryName
    Dim lngCount As Long
    Dim rasItem As RasEntryData
    
    lngCount = VBRasGetAllEntries(myEntries)
    
    'MsgBox lngCount
    Dim i As Integer
    Dim curEntry As VBRasEntryName
    For i = 0 To lngCount - 1
        curEntry = myEntries(i)
        
        Set rasItem = New RasEntryData
        rasItem.entryname = curEntry.entryname
        rasItem.PhonebookPath = curEntry.PhonebookPath
        rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook
        
        RasEntries.add rasItem, rasItem.entryname
    Next i

End Sub

' callback from MonitorRASStatusAsync
Public Sub detectOnlineOfflineChange()
    Dim isOnline As Boolean
    Dim script_name As String, script_args As String
    Dim cmd As String
    
    isOnline = RasIsOnline(ConnectionName)
    
    If ConnectionOnline <> isOnline Then
        'MsgBox isOnline
        
        Select Case ActionType
            
            Case RUN_SCRIPT:
                script_name = ScriptName
                If script_name <> "" Then
                    script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)
                    cmd = App.Path & "\" & script_name & " " & script_args
                End If
                
            Case ADD_ROUTE:
                ' connection goes online
                If isOnline = True Then
                    script_name = "route"
                    script_args = "add " & RouteNet & " mask " & RouteMask & " " & DetermineClientIP(ConnectionName)
                    cmd = script_name & " " & script_args
                
                ' connection goes offline
                Else
                    ' Nothing to do in this case
                
                End If
            
        End Select
        
        If cmd <> "" Then
            'MsgBox cmd
            On Error Resume Next
            Shell cmd, vbHide
            'Shell cmd, vbNormalFocus
            'If Err.Number <> 0 Then
            '    MsgBox "Error while calling cmd: " & cmd & vbCrLf & "Error-Number: " & Err.Number
            'End If
            On Error GoTo 0
        End If
        
        ConnectionOnline = isOnline
    End If
End Sub
1	joko	1.1	Attribute VB_Name = "Module_Main"
2			Option Explicit
3
4			' see: How To Obtain the IP Address Assigned to a RAS Client
5			' http://support.microsoft.com/default.aspx?scid=kb;en-us;160622
6
7			' see: RasGetProjectionInfo
8			' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcecomm5/html/wce50lrfRasGetProjectionInfo.asp
9
10			' http://home.iprimus.com.au/billmcc/PlatformVB/dun/rasenumentries.htm
11			' http://home.iprimus.com.au/billmcc/PlatformVB/dun/raserrorhandler.htm
12			' http://www.mentalis.org/apilist/RasEnumEntries.shtml
13
14			' http://www.activevb.de/tipps/tipkat/kat1.html
15			' http://www.activevb.de/rubriken/apikatalog/deklarationen/rasenumentries.html
16			' http://www.dotnet247.com/247reference/msgs/18/93960.aspx
17
18	joko	1.6	' contains all ras entry objects
19	joko	1.1	Public RasEntries As New Collection
20	joko	1.6
21			' globals to store connection name and state
22	joko	1.4	Public ConnectionName As String
23			Public ConnectionOnline As Boolean
24	joko	1.6
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	joko	1.1
38			Sub Main()
39
40			Dim cmdline As New CommandLine
41			Dim conName As String
42	joko	1.2	Dim rasItem As RasEntryData
43			Dim success As Boolean
44	joko	1.3
45			Dim script_name As String, script_args As String
46			Dim setup_user As String, setup_pass As String
47	joko	1.1
48			ReadRasEntries
49			cmdline.parse
50
51	joko	1.3	'If cmdline.hasSwitch("gui") Then
52			' Form_Main.Show
53			'Else
54	joko	1.2
55	joko	1.3	' 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	joko	1.5	script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
81	joko	1.3	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	joko	1.2
90	joko	1.3	Set rasItem = RasEntries(conName)
91	joko	1.2
92	joko	1.3	If cmdline.hasSwitch("gui") Then
93			With Form_Credentials
94			.ras_connectionName = rasItem.entryname
95			.ras_phoneBook = rasItem.PhonebookPath
96			.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	joko	1.2	End If
104	joko	1.3
105	joko	1.2	End If
106	joko	1.4
107			' monitor
108			ElseIf cmdline.hasSwitch("monitor") Then
109			conName = cmdline.getArgument("monitor")
110			If conName <> "" Then
111
112	joko	1.6	' run script
113			If cmdline.hasSwitch("script") Then
114			ActionType = RUN_SCRIPT
115			ScriptName = cmdline.getArgument("script")
116	joko	1.4	End If
117
118	joko	1.6	' add a route with target network via gateway
119			If cmdline.hasSwitch("net") Then
120			ActionType = ADD_ROUTE
121			RouteNet = cmdline.getArgument("net")
122			If cmdline.hasSwitch("mask") Then
123			RouteMask = cmdline.getArgument("mask")
124			Else
125			RouteMask = RouteMaskDefault
126			End If
127	joko	1.4	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	joko	1.3	End If
137	joko	1.2
138	joko	1.3	'End If
139	joko	1.1
140			End Sub
141
142			Private Sub ReadRasEntries()
143
144			Dim myEntries() As VBRasEntryName
145			Dim lngCount As Long
146			Dim rasItem As RasEntryData
147
148			lngCount = VBRasGetAllEntries(myEntries)
149
150			'MsgBox lngCount
151			Dim i As Integer
152			Dim curEntry As VBRasEntryName
153			For i = 0 To lngCount - 1
154			curEntry = myEntries(i)
155
156			Set rasItem = New RasEntryData
157			rasItem.entryname = curEntry.entryname
158			rasItem.PhonebookPath = curEntry.PhonebookPath
159			rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook
160
161			RasEntries.add rasItem, rasItem.entryname
162			Next i
163
164			End Sub
165	joko	1.4
166			' callback from MonitorRASStatusAsync
167			Public Sub detectOnlineOfflineChange()
168	joko	1.6	Dim isOnline As Boolean
169	joko	1.4	Dim script_name As String, script_args As String
170			Dim cmd As String
171
172	joko	1.6	isOnline = RasIsOnline(ConnectionName)
173	joko	1.4
174	joko	1.6	If ConnectionOnline <> isOnline Then
175			'MsgBox isOnline
176	joko	1.4
177	joko	1.6	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	joko	1.4
201	joko	1.6	If cmd <> "" Then
202	joko	1.4	'MsgBox cmd
203			On Error Resume Next
204			Shell cmd, vbHide
205	joko	1.7	'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	joko	1.4	On Error GoTo 0
210			End If
211
212	joko	1.6	ConnectionOnline = isOnline
213	joko	1.4	End If
214			End Sub
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26