Visual Basic Server

DFÜ-Status prüfen

RasGetConnectStatus, RasEnumConnections
Private Sub Form_Load()
  Timer1.Interval = 20
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

 Ranking-Hits zurück Sitemap
Designed by www.wbrnet.info