checkmodule.bas

adsl拨号工具 有很多功能 不错啊 大家试试

Attribute VB_Name = "CheckModule"
Option Explicit

'/＊有关的API声明和定义＊/
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
  
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

  
'/＊常数和变量的设定＊/
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
  


'/＊函数IsConnected返回连通的状态，如果为True则表示已连通＊/
Public Function IsConnected() As Boolean
  Dim TRasCon(255) As RASCONN95
  Dim lg As Long
  Dim lpcon As Long
  Dim RetVal As Long
  Dim Tstatus As RASCONNSTATUS95
  TRasCon(0).dwSize = 412
  lg = 256 * TRasCon(0).dwSize
  RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
  If RetVal <> 0 Then
     MsgBox "错误"
    Exit Function
  End If
  Tstatus.dwSize = 160
  RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
  If Tstatus.RasConnState = &H2000 Then
    IsConnected = True
  Else
    IsConnected = False
  End If
End Function


'------------------------------------------------------------------
'函数:用拨号网络的函数RasEnumConnections 检测是否正在连上Internet
'------------------------------------------------------------------
Public Function Fun_TestOnline() As Boolean
  Dim lngRetCode As Long, lpcb As Long, lpcConnections As Long
  Dim intArraySize As Integer, intLooper As Integer
  ReDim lprasconn95(intArraySize) As RASCONN95

  Fun_TestOnline = False
  lprasconn95(0).dwSize = 412
  lpcb = 256 * lprasconn95(0).dwSize
  lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)

  If lngRetCode = 0 Then '检测是否正在连上Internet
    If lpcConnections > 0 Then
      Fun_TestOnline = True  '已经连上网
    Else
      Fun_TestOnline = False '没有连上网
    End If
  End If
End Function