/[cvs]/joko/ToolBox/Windows/VpnDial/src/RasNotification.bas
ViewVC logotype

Contents of /joko/ToolBox/Windows/VpnDial/src/RasNotification.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Fri Oct 7 20:28:41 2005 UTC (18 years, 9 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
+ new feature:
e.g. VpnDial.exe --monitor {connection-name} --up ip-up.bat --down ip-down.bat

1 Attribute VB_Name = "RasNotification"
2 ' from: http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=34927&lngWId=1
3
4 Option Explicit
5
6 Public Const RASCN_Connection = &H1 'Our two flags
7 Public Const RASCN_Disconnection = &H2
8
9 Public Const WAIT_FAILED = &HFFFFFFFF
10 Public Const WAIT_OBJECT_0 = &H0&
11 Public Const WAIT_ABANDONED = &H80&
12 Public Const WAIT_TIMEOUT = &H102&
13
14 Public Type SECURITY_ATTRIBUTES
15 nLength As Long
16 lpSecurityDescriptor As Long
17 bInheritHandle As Long
18 End Type
19
20 Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
21 Public Declare Function RasConnectionNotification Lib "rasapi32.dll" Alias "RasConnectionNotificationA" (hRasConn As Long, ByVal hEvent As Long, ByVal dwFlags As Long) As Long
22 Public Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long
23 Public Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
24 Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
25
26
27
28 Public Sub MonitorRASStatusAsync()
29
30 Dim hEvents(1) As Long 'Array of event handles. Since there are ' two events we'd like to monitor, i have already dimention it.
31 Dim RasNotif As Long
32 Dim WaitRet As Long
33 Dim sd As SECURITY_ATTRIBUTES
34 Dim hRasConn As Long
35
36 Dim thrownEvent As EventInfo
37
38 hRasConn = 0
39
40 'We are going to create and register two event objects with CreateEvent API function
41
42 'There aren't any special treated events that need any kind of security attributes so we just initialize the structure
43
44
45
46 With sd
47 .nLength = Len(sd) 'we pass the length of sd
48 .lpSecurityDescriptor = 0
49 .bInheritHandle = 0
50 End With
51
52 'We create the event by passing in CreateEvent any security attributes,
53
54 'we want to manually reset the event after it gets signaled,
55
56 'we also want it's initial state not signaled assuming that we don't have yet any connection to the internet,
57
58 'last but not least we give the event a name (RASStatusNotificationObject1)
59 hEvents(0) = CreateEvent(sd, True, False, "RASStatusNotificationObject1")
60 'If the returned value was zero, something went wrong so exit the sub
61
62 If hEvents(0) = 0 Then MsgBox "Couldn't assign an event handle": Exit Sub
63
64 'If we succesfully created the first event object we pass it to RasConnectionNotification
65
66 'with the flag RASCN_Connection so that this event will monitor for internet connection
67
68 RasNotif = RasConnectionNotification(ByVal hRasConn, hEvents(0), RASCN_Connection)
69 If RasNotif <> 0 Then MsgBox "Ras Notification failure": GoTo ras_TerminateEvent
70
71
72 'We create the second event object exactly like the first one
73
74 'but we name it RASStatusNotificationObject2
75
76 hEvents(1) = CreateEvent(sd, True, False, "RASStatusNotificationObject2")
77 If hEvents(1) = 0 Then MsgBox "Couldn't assign an event handle": Exit Sub
78
79 'If we succesfully created the second event object too, we pass it to RasConnectionNotification
80
81 'with the flag RASCN_Disconnection. This event will monitor for disconnection
82
83 RasNotif = RasConnectionNotification(ByVal hRasConn, hEvents(1), RASCN_Disconnection)
84 If RasNotif <> 0 Then MsgBox "Ras Notification failure": GoTo ras_TerminateEvent
85
86 'We then issue the loop
87
88 'Notice that we have put hEvents array to it's first array item.
89
90 'and we used False cause we want to get notifications
91
92 'when any of the two events occur.
93 Do
94 WaitRet = WaitForMultipleObjects(2, hEvents(0), False, 20)
95 Select Case WaitRet
96 Case WAIT_TIMEOUT
97 DoEvents
98
99 Case WAIT_FAILED Or WAIT_ABANDONED Or WAIT_ABANDONED + 1
100 GoTo ras_TerminateEvent
101
102 Case WAIT_OBJECT_0
103 'MsgBox "Connected"
104 'MsgBox hEvents(0)
105 'thrownEvent = hEvents(0)
106 'MsgBox thrownEvent.Name
107 detectOnlineOfflineChange
108 ResetEvent hEvents(0) 'Reset the event to avoid a second message box
109 DoEvents 'Free any pending messages
110
111 Case WAIT_OBJECT_0 + 1
112 'MsgBox "Disconnected"
113 detectOnlineOfflineChange
114 ResetEvent hEvents(1) 'Reset the event to place it in no signal state (Manual reset, remember?)
115 DoEvents
116
117 End Select
118
119 Loop
120
121 ras_TerminateEvent:
122
123 'Close all event handles
124
125 'For more than two events you could apply a For.. Next
126
127 Call CloseHandle(hEvents(1))
128 Call CloseHandle(hEvents(0))
129
130 DoEvents 'Free any pending messages from the application message queue
131
132 End Sub

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed