| 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 |