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

Public RasEntries As New Collection
Public ConnectionName As String
Public ConnectionOnline As Boolean
Public ScriptName_Up As String, ScriptName_Down As String

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
        
            If cmdline.hasSwitch("up") Then
                ScriptName_Up = cmdline.getArgument("up")
            End If
        
            If cmdline.hasSwitch("down") Then
                ScriptName_Down = cmdline.getArgument("down")
            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 newState As Boolean
    Dim script_name As String, script_args As String
    Dim cmd As String
    
    newState = RasIsOnline(ConnectionName)
    
    If ConnectionOnline <> newState Then
        'MsgBox newState
        
        ' 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
        
        End If
        
        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
            'MsgBox cmd
            On Error Resume Next
            Shell cmd, vbHide
            On Error GoTo 0
        End If
        
        ConnectionOnline = newState
    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			Public RasEntries As New Collection
19	joko	1.4	Public ConnectionName As String
20			Public ConnectionOnline As Boolean
21			Public ScriptName_Up As String, ScriptName_Down As String
22	joko	1.1
23			Sub Main()
24
25			Dim cmdline As New CommandLine
26			Dim conName As String
27	joko	1.2	Dim rasItem As RasEntryData
28			Dim success As Boolean
29	joko	1.3
30			Dim script_name As String, script_args As String
31			Dim setup_user As String, setup_pass As String
32	joko	1.1
33			ReadRasEntries
34			cmdline.parse
35
36	joko	1.3	'If cmdline.hasSwitch("gui") Then
37			' Form_Main.Show
38			'Else
39	joko	1.2
40	joko	1.3	' dial command
41			If cmdline.hasSwitch("dial") Then
42
43			conName = cmdline.getArgument("dial")
44			On Error Resume Next
45			Set rasItem = RasEntries(conName)
46			If Err.Number = 0 Then
47			success = RasConnect(rasItem.entryname, rasItem.PhonebookPath)
48			Else
49			MsgBox "Unkown RAS-Connection """ & conName & """."
50			End If
51			On Error GoTo 0
52
53			' hangup command
54			ElseIf cmdline.hasSwitch("hangup") Then
55			conName = cmdline.getArgument("hangup")
56			success = RasDisconnect(conName)
57			'MsgBox success
58
59			'End If
60
61			' run script
62			ElseIf cmdline.hasSwitch("script") And success = True Then
63			script_name = cmdline.getArgument("script")
64			If script_name <> "" Then
65	joko	1.5	script_args = Chr(34) & DetermineClientIP(conName) & Chr(34) & " " & Chr(34) & DetermineServerIP(conName) & Chr(34)
66	joko	1.3	Shell App.Path & "\" & script_name & " " & script_args, vbHide
67			End If
68			'End If
69
70			' setup
71			ElseIf cmdline.hasSwitch("setup") Then
72			conName = cmdline.getArgument("setup")
73			If conName <> "" Then
74	joko	1.2
75	joko	1.3	Set rasItem = RasEntries(conName)
76	joko	1.2
77	joko	1.3	If cmdline.hasSwitch("gui") Then
78			With Form_Credentials
79			.ras_connectionName = rasItem.entryname
80			.ras_phoneBook = rasItem.PhonebookPath
81			.Show
82			End With
83
84			ElseIf cmdline.hasSwitch("user") And cmdline.hasSwitch("pass") Then
85			setup_user = cmdline.getArgument("user")
86			setup_pass = cmdline.getArgument("pass")
87			SetupRasEntry rasItem.entryname, rasItem.PhonebookPath, setup_user, setup_pass
88	joko	1.2	End If
89	joko	1.3
90	joko	1.2	End If
91	joko	1.4
92			' monitor
93			ElseIf cmdline.hasSwitch("monitor") Then
94			conName = cmdline.getArgument("monitor")
95			If conName <> "" Then
96
97			If cmdline.hasSwitch("up") Then
98			ScriptName_Up = cmdline.getArgument("up")
99			End If
100
101			If cmdline.hasSwitch("down") Then
102			ScriptName_Down = cmdline.getArgument("down")
103			End If
104
105			'Set rasItem = RasEntries(conName)
106			'RasRetrieveConnectionHandler conName
107			ConnectionName = conName
108			ConnectionOnline = RasIsOnline(conName)
109			MonitorRASStatusAsync
110			End If
111
112	joko	1.3	End If
113	joko	1.2
114	joko	1.3	'End If
115	joko	1.1
116			End Sub
117
118			Private Sub ReadRasEntries()
119
120			Dim myEntries() As VBRasEntryName
121			Dim lngCount As Long
122			Dim rasItem As RasEntryData
123
124			lngCount = VBRasGetAllEntries(myEntries)
125
126			'MsgBox lngCount
127			Dim i As Integer
128			Dim curEntry As VBRasEntryName
129			For i = 0 To lngCount - 1
130			curEntry = myEntries(i)
131
132			Set rasItem = New RasEntryData
133			rasItem.entryname = curEntry.entryname
134			rasItem.PhonebookPath = curEntry.PhonebookPath
135			rasItem.Win2000_SystemPhonebook = curEntry.Win2000_SystemPhonebook
136
137			RasEntries.add rasItem, rasItem.entryname
138			Next i
139
140			End Sub
141	joko	1.4
142			' callback from MonitorRASStatusAsync
143			Public Sub detectOnlineOfflineChange()
144			Dim newState As Boolean
145			Dim script_name As String, script_args As String
146			Dim cmd As String
147
148			newState = RasIsOnline(ConnectionName)
149
150			If ConnectionOnline <> newState Then
151			'MsgBox newState
152
153			' connection goes online
154			If newState = True Then
155			If ScriptName_Up <> "" Then
156			script_name = ScriptName_Up
157			End If
158
159			' connection goes offline
160			Else
161			If ScriptName_Down <> "" Then
162			script_name = ScriptName_Down
163			End If
164
165			End If
166
167			If script_name <> "" Then
168	joko	1.5	script_args = Chr(34) & DetermineClientIP(ConnectionName) & Chr(34) & " " & Chr(34) & DetermineServerIP(ConnectionName) & Chr(34)
169	joko	1.4	cmd = App.Path & "\" & script_name & " " & script_args
170			'MsgBox cmd
171			On Error Resume Next
172			Shell cmd, vbHide
173			On Error GoTo 0
174			End If
175
176			ConnectionOnline = newState
177			End If
178			End Sub
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26