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 |