如何判断计算机是否通过“猫”连接到互联网？

Question

最好有源代码

Answer 1

'启动拨号网络
'利用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

Answer 2

先建立一个模块
Option Explicit'API defination
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long'Consts
Public Const SW_SHOW = 5Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Const WS_MAXIMIZEBOX = &H10000
Public Const WS_THICKFRAME = &H40000Public Const GWL_STYLE = (-16)
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (IpRasCon 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 LongPublic 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 TypePublic Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End TypePublic 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
    Exit Function
End If
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
    IsConnected = True
Else
    IsConnected = False
End IfEnd Function在不判断的窗体里面
Private Sub Timer1_Timer()
    If IsConnected = True Then
       TLink = True
    End If
    If IsConnected = False Then
       TLink = False
    End If
End Sub
Private Sub Command4_Click()
        If TLink = False Then
        MsgShow "您的计算机还没有连接到互联网" & vbCrLf & _
            "请先连接互联网"
        Exit Sub
        End If
End Sub

Answer 3

忘了声明部分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 Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long可能多了点，有做其它用的。

Answer 4

将上面代码粘到模块中,将上面代码粘到窗体中(画个commandbutton)即可Private Sub Command1_Click()
    If Fun_TestOnline = True Then
        MsgBox "上网"
    Else
        MsgBox "没上"
        
    End If
End Sub

Answer 5

若不行给个email发个例子给你

Answer 6

检测是否连接到Internet以及是通过何种方式（Modem,LAN,Proxy）连接到Internet的:
http://www.applevb.com/sourcecode/connect_to_net.zip