怎样在VB里面判断某个地址是否可以访问？

Question

VB中判断互联网是不是通的。如判断SOHU.com能不能访问或某个IP能不能访问？
谢谢

Answer 1

将下面代码放到模块中 ,调用 Fun_TestOnline 函数即可实现判断是否在线
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_MOVE = &H1
Private Const SM_X = 0
Private Const SM_Y = 1
Private Const TWIPS_PER_INCH = 1440
Private Const POINTS_PER_INCH = 72Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_SHOWWINDOW = &H40Private Enum enumStyle
    sPixel
    sTwip
    sInch
    sPoint
End EnumPrivate Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1Private Const VER_PLATFORM_WIN32_NT = 2        '操作系统类型( 2-NT )
Dim ret As Long
Dim Flags As LongPublic Type OSVERSIONINFO
    dwOSVersionInfoSize As Long   '结构的大小（148）<在正式调用函数之前，必须先将这个结构的dwOSVersionInfoSize字段设为结构的大小（148）>
    dwMajorVersion As Long        '主版本号
    dwMinorVersion As Long        '次版本号
    dwBuildNumber As Long         '生成号
    dwPlatformId As Long          '操作系统类型( 1-95/98 ;  2-NT )
    szCSDVersion As String * 128  '版本号(形如'第几版')
End TypePrivate Type LUID
    LowPart As Long
    HighPart As Long
End TypePrivate Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End TypePrivate Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type'获取当前进程的一个伪句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As LongPrivate Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As LongPrivate Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As LongPrivate Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As LongPrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long'  API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long'要在 VB 程序中中断【拨号网路连线】，可以使用 Remote Access Services Hangup 函数：'在模组的声明区中加入以下声明及模组：Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MaxDeviceType As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Const ERROR_SUCCESS = 0&Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End TypePublic Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypeConst RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceName = 128Public Type RASCONN95
  dwSize As Long '设置 dWsize 值为 412
  hRasConn As Long
  szEntryName(RAS95_MaxEntryName) As Byte
  szDeviceType(RAS_MaxDeviceType) As Byte
  szDeviceName(RAS95_MaxDeviceName) As Byte
End TypePublic Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As LongPublic gstrISPName As String
Public ReturnCode As LongPublic Sub HangUp()
Dim i As Long
Dim lprasconn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Longlprasconn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lprasconn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lprasconn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lprasconn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lprasconn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End SubPublic Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function'启动拨号网络
'利用RasEnumConnections函数，就可以得到所需拨号网络连接的句柄
'---------------------------------------------------------------
'------------------------------------------------------------------
'函数:用拨号网络的函数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