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

[audrey0512]

最好有源代码

[liul17]

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

[dandy1437]

先建立一个模块
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 = 5

Public 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 Long

Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_THICKFRAME = &H40000

Public 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 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

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
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

在不判断的窗体里面
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

[liul17]

忘了声明部分

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 = 72

Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_SHOWWINDOW = &H40

Private Enum enumStyle
sPixel
sTwip
sInch
sPoint
End Enum

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1

Private Const VER_PLATFORM_WIN32_NT = 2 '操作系统类型( 2-NT )
Dim ret As Long
Dim Flags As Long

Public 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 Type

Private Type LUID
LowPart As Long
HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

'获取当前进程的一个伪句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long

Private 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 Long

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private 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 Long

Public 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 Type

Public Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceName = 128

Public 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 Type

Public 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 Long

Public gstrISPName As String
Public ReturnCode As Long

Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long

可能多了点，有做其它用的。

[liul17]

将上面代码粘到模块中,将上面代码粘到窗体中(画个commandbutton)即可

Private Sub Command1_Click()
If Fun_TestOnline = True Then
MsgBox "上网"
Else
MsgBox "没上"

End If
End Sub

[liul17]

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

[TechnoFantasy]

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