CNetConnect.cls
==================
' ********************************************
' Copyright 1998, Karl E. Peterson
' All Rights Reserved.
' http://www.mvps.org/vb
' ********************************************
' May be freely used in your applications.
' Redistribution of source prohibited.
' ********************************************
Option Explicit
'
' Required WinInet.dll declarations
'
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
'
' // Flags for InternetAutodial
'
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1 ' Forces an online Internet connection.
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2 ' Forces an unattended Internet dial-up.
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4 ' Essentially undocumented???
' Indicates to use config info from registry
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
' WinInet flags
Private Const INTERNET_FLAG_RELOAD = &H80000000 'read from wire even if locally cached
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 '// use keep-alive semantics
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 '// don't write this item to the cache
'
' Enumerated dial modes
'
Public Enum AutodialFlags
InternetAutodialForceOnline = INTERNET_AUTODIAL_FORCE_ONLINE
InternetAutodialUnattended = INTERNET_AUTODIAL_FORCE_UNATTENDED
InternetAutodialFailIfSecurityCheck = INTERNET_AUTODIAL_FAILIFSECURITYCHECK
End Enum
'
' // Flags for InternetGetConnectedState
'
Private Const INTERNET_CONNECTION_MODEM = 1
Private Const INTERNET_CONNECTION_LAN = 2
Private Const INTERNET_CONNECTION_PROXY = 4
Private Const INTERNET_CONNECTION_MODEM_BUSY = 8
'
' Enumerated connection states
'
Public Enum InetConnectionStates
InternetConnectionModem = INTERNET_CONNECTION_MODEM
InternetConnectionLan = INTERNET_CONNECTION_LAN
InternetConnectionProxy = INTERNET_CONNECTION_PROXY
InternetConnectionModemBusy = INTERNET_CONNECTION_MODEM_BUSY
End Enum
'
' Set aside storage for private member variables.
'
Private m_Connected As Boolean
Private m_ConnectMode As InetConnectionStates
Private m_ConnectModeDesc As String
Private m_KnownSites As Collection' ********************************************
' Initialize
' ********************************************
Private Sub Class_Initialize()
Set m_KnownSites = New Collection
' Populate the collection with what *you* feel are reliable sites!
m_KnownSites.Add "http://www.yahoo.com", "http://www.yahoo.com"
m_KnownSites.Add "http://www.cnn.com", "http://www.cnn.com"
End SubPrivate Sub Class_Terminate()
Set m_KnownSites = Nothing
End Sub' ********************************************
' Public Properties
' ********************************************
Public Property Get KnownTestSites() As Collection
Set KnownTestSites = m_KnownSites
End PropertyPublic Property Let KnownTestSites(ByVal NewVal As Collection)
Set m_KnownSites = NewVal
End Property' ********************************************
' Public Properties // Read-Only
' ********************************************
Public Property Get Connected() As Boolean
Call Me.Refresh
Connected = m_Connected
End PropertyPublic Property Get ConnectMode() As InetConnectionStates
Call Me.Refresh
ConnectMode = m_ConnectMode
End PropertyPublic Property Get ConnectModeDesc() As String
Call Me.Refresh
ConnectModeDesc = m_ConnectModeDesc
End Property' ********************************************
' Public Methods
' ********************************************
Public Function Dial(Optional Flags As AutodialFlags = InternetAutodialUnattended) As Boolean
Dial = False
If Not Connected Then
If CBool(InternetAutodial(Flags, 0&)) Then
Dial = True
Else
Debug.Print WinInetErrorTextEx(Err.LastDllError)
End If
End If
End FunctionPublic Function HangUp() As Boolean
If Connected Then
HangUp = CBool(InternetAutodialHangup(0&))
Else
HangUp = False ' maybe should be True???
End If
End FunctionPublic Sub Refresh()
Dim Flags As Long
m_Connected = InternetGetConnectedState(Flags, 0&)
m_ConnectMode = Flags
If Flags And INTERNET_CONNECTION_MODEM Then
m_ConnectModeDesc = "Modem"
If Flags And INTERNET_CONNECTION_MODEM_BUSY Then
m_ConnectModeDesc = "Modem (Busy)"
m_Connected = TryTheWire()
End If
ElseIf Flags And INTERNET_CONNECTION_LAN Then
m_ConnectModeDesc = "LAN"
m_Connected = TryTheWire()
ElseIf Flags And INTERNET_CONNECTION_PROXY Then
m_ConnectModeDesc = "Proxy Server"
m_Connected = TryTheWire()
End If
End Sub' ********************************************
' Private Methods
' ********************************************
Private Function TryTheWire() As Boolean
Dim hInet As Long
Dim hUrl As Long
Dim Flags As Long
Dim url As Variant
'
' Try opening each URL in the collection, until one succeeds.
'
hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
If hInet Then
Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
For Each url In m_KnownSites
hUrl = InternetOpenUrl(hInet, CStr(url), vbNullString, 0, Flags, 0)
If hUrl Then
Call InternetCloseHandle(hUrl)
TryTheWire = True
Exit For
End If
Next url
End If
Call InternetCloseHandle(hInet)
End Function
==================
' ********************************************
' Copyright 1998, Karl E. Peterson
' All Rights Reserved.
' http://www.mvps.org/vb
' ********************************************
' May be freely used in your applications.
' Redistribution of source prohibited.
' ********************************************
Option Explicit
'
' Required WinInet.dll declarations
'
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
'
' // Flags for InternetAutodial
'
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1 ' Forces an online Internet connection.
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2 ' Forces an unattended Internet dial-up.
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4 ' Essentially undocumented???
' Indicates to use config info from registry
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
' WinInet flags
Private Const INTERNET_FLAG_RELOAD = &H80000000 'read from wire even if locally cached
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 '// use keep-alive semantics
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 '// don't write this item to the cache
'
' Enumerated dial modes
'
Public Enum AutodialFlags
InternetAutodialForceOnline = INTERNET_AUTODIAL_FORCE_ONLINE
InternetAutodialUnattended = INTERNET_AUTODIAL_FORCE_UNATTENDED
InternetAutodialFailIfSecurityCheck = INTERNET_AUTODIAL_FAILIFSECURITYCHECK
End Enum
'
' // Flags for InternetGetConnectedState
'
Private Const INTERNET_CONNECTION_MODEM = 1
Private Const INTERNET_CONNECTION_LAN = 2
Private Const INTERNET_CONNECTION_PROXY = 4
Private Const INTERNET_CONNECTION_MODEM_BUSY = 8
'
' Enumerated connection states
'
Public Enum InetConnectionStates
InternetConnectionModem = INTERNET_CONNECTION_MODEM
InternetConnectionLan = INTERNET_CONNECTION_LAN
InternetConnectionProxy = INTERNET_CONNECTION_PROXY
InternetConnectionModemBusy = INTERNET_CONNECTION_MODEM_BUSY
End Enum
'
' Set aside storage for private member variables.
'
Private m_Connected As Boolean
Private m_ConnectMode As InetConnectionStates
Private m_ConnectModeDesc As String
Private m_KnownSites As Collection' ********************************************
' Initialize
' ********************************************
Private Sub Class_Initialize()
Set m_KnownSites = New Collection
' Populate the collection with what *you* feel are reliable sites!
m_KnownSites.Add "http://www.yahoo.com", "http://www.yahoo.com"
m_KnownSites.Add "http://www.cnn.com", "http://www.cnn.com"
End SubPrivate Sub Class_Terminate()
Set m_KnownSites = Nothing
End Sub' ********************************************
' Public Properties
' ********************************************
Public Property Get KnownTestSites() As Collection
Set KnownTestSites = m_KnownSites
End PropertyPublic Property Let KnownTestSites(ByVal NewVal As Collection)
Set m_KnownSites = NewVal
End Property' ********************************************
' Public Properties // Read-Only
' ********************************************
Public Property Get Connected() As Boolean
Call Me.Refresh
Connected = m_Connected
End PropertyPublic Property Get ConnectMode() As InetConnectionStates
Call Me.Refresh
ConnectMode = m_ConnectMode
End PropertyPublic Property Get ConnectModeDesc() As String
Call Me.Refresh
ConnectModeDesc = m_ConnectModeDesc
End Property' ********************************************
' Public Methods
' ********************************************
Public Function Dial(Optional Flags As AutodialFlags = InternetAutodialUnattended) As Boolean
Dial = False
If Not Connected Then
If CBool(InternetAutodial(Flags, 0&)) Then
Dial = True
Else
Debug.Print WinInetErrorTextEx(Err.LastDllError)
End If
End If
End FunctionPublic Function HangUp() As Boolean
If Connected Then
HangUp = CBool(InternetAutodialHangup(0&))
Else
HangUp = False ' maybe should be True???
End If
End FunctionPublic Sub Refresh()
Dim Flags As Long
m_Connected = InternetGetConnectedState(Flags, 0&)
m_ConnectMode = Flags
If Flags And INTERNET_CONNECTION_MODEM Then
m_ConnectModeDesc = "Modem"
If Flags And INTERNET_CONNECTION_MODEM_BUSY Then
m_ConnectModeDesc = "Modem (Busy)"
m_Connected = TryTheWire()
End If
ElseIf Flags And INTERNET_CONNECTION_LAN Then
m_ConnectModeDesc = "LAN"
m_Connected = TryTheWire()
ElseIf Flags And INTERNET_CONNECTION_PROXY Then
m_ConnectModeDesc = "Proxy Server"
m_Connected = TryTheWire()
End If
End Sub' ********************************************
' Private Methods
' ********************************************
Private Function TryTheWire() As Boolean
Dim hInet As Long
Dim hUrl As Long
Dim Flags As Long
Dim url As Variant
'
' Try opening each URL in the collection, until one succeeds.
'
hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
If hInet Then
Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
For Each url In m_KnownSites
hUrl = InternetOpenUrl(hInet, CStr(url), vbNullString, 0, Flags, 0)
If hUrl Then
Call InternetCloseHandle(hUrl)
TryTheWire = True
Exit For
End If
Next url
End If
Call InternetCloseHandle(hInet)
End Function
解决方案 »
- 类不支持自动化或不支持期望的接口,如何解决?
- 關於vsreport與recordset的綁定問題
- 利用setupbuilder制作安装程序(把一些jsp程序拷贝到用户指定的文件夹下),安装完毕后自动运行一个VB程序来修改一个已经拷贝到硬盘上的j
- 请教.ico格式的东东?
- 菜鸟问题:select语句中时间查询{时间= '" & CStr(Text2.Text) & "'"}。是吗??急
- 关于SQL语句在VB里使用的问题
- 如何将文本框中的内容加到ACCESS数据库中?
- VB6:查询表中的所有字段
- 使用datareport制作报表,报表的最后一行总是没有表格,请问怎么解决?
- 高分!!如何用vb控制excel表格的具体操作
- 作FTP上传文件的时候,怎么判断已经上传了多少字节?
- 两个日期如何进行计算??
=====================================
Option ExplicitPrivate Sub Form_Load()
Dim loTest As CNetConnect
Set loTest = New CNetConnect
MsgBox loTest.Connected
Set loTest = Nothing
End Sub