Folgende
Routine überwacht das DFÜ-Netzwerk
und erkennt eine Online-Verbindung:
ERFORDERLICHE
OBJEKTE
1 Label (Label1)
1 Timer (Timer1)
1 CommandButton (Command1)
FORM-CODE
Private Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = 1
Command1.Caption = "&Verbindung trennen"
End Sub
Private Sub Timer1_Timer()
If HaveOnlineConnection = True Then
t = "Online"
v = True
Else
t = "Offline"
v = False
End If
Label1.Caption = t
Command1.Enabled = v
End Sub
Private Sub Command1_Click()
A = MsgBox("Wirklich trennen ?", vbQuestion + vbYesNo)
If A = 7 Then Exit Sub
Verbindung_trennen
End Sub
MODUL-CODE
Private Type RASCONN
dwSize As Long
hRasConn As Long
szEntryName(256) As Byte
szDeviceType(16) As Byte
szDeviceName(128) As Byte
End Type
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" _
Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, _
lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long
Public Function HaveOnlineConnection() As Boolean
Dim lprasconn(0 To 1) As Long
Dim rc As Long
Dim lpcb As Long
Dim lpcConnections As Long
lprasconn(0) = 32
lpcb = 0
rc = RasEnumConnections(lprasconn(0), lpcb, lpcConnections)
HaveOnlineConnection = lpcConnections > 0
End Function
Public Sub Verbindung_trennen()
Dim lprasconn(255) As RASCONN
lprasconn(0).dwSize = 412
lpcb& = 256 * lprasconn(0).dwSize
RasEnumConnections lprasconn(0), lpcb&, lpcConnections&
If lpcConnections& > 0 Then
RasHangUp lprasconn(0).hRasConn
End If
End Sub
Update: 17.01.2000:
DFÜ-Erkennung jetzt auch unter Windows NT
Update: 09.02.2000:
Trennen einer Verbindung
|