| RasGetConnectStatus, RasEnumConnections |
|
|
| Private Sub Form_Load() |
|
| End Sub |
|
| Private Sub Timer1_Timer() |
| DFÜStatus |
| End Sub |
|
| Private Sub cmd_Close_Click() |
| End |
| End Sub |
|
|
| Modul: |
|
| 'RASAPI32.DLL stellt fest, ob eine Online-Verbindung besteht |
| Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias _ |
| "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long |
| |
| Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" _ |
| Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long |
|
| Const RAS_MaxEntryName = 256 |
| Const RAS_MaxDeviceType = 16 |
| Const RAS_MaxDeviceName = 32 |
|
| Private Type RASType |
| dwSize As Long |
| hRasCon As Long |
| szEntryName(RAS_MaxEntryName) As Byte |
| szDeviceType(RAS_MaxDeviceType) As Byte |
| szDeviceName(RAS_MaxDeviceName) As Byte |
| End Type |
|
| Private Type RASStatusType |
| dwSize As Long |
| RasConnState As Long |
| dwError As Long |
| szDeviceType(RAS_MaxDeviceType) As Byte |
| szDeviceName(RAS_MaxDeviceName) As Byte |
| End Type |
|
| Function DFÜStatus() As Boolean |
| Dim RAS(255) As RASType, RASStatus As RASStatusType |
| Dim lg, lpconnection, Result |
|
| RAS(0).dwSize = 412 |
| lg = 256 * RAS(0).dwSize |
| Result = RasEnumConnections(RAS(0), lg, lpconnection) |
| |
| If lpconnection = 0 Then |
| DFÜStatus = False |
| Form1.lbl_Info.Caption = "DFÜ Offline" |
| Else |
| RASStatus.dwSize = 160 |
| Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus) |
| If RASStatus.RasConnState = &H2000& Then |
| DFÜStatus = True |
| Form1.lbl_Info.Caption = "DFÜ Online" |
| Else |
| DFÜStatus = False |
| Form1.lbl_Info.Caption = "Einwahl oder Trennen der Verbindung" |
| End If |
| End If |
| End Function |
|