Internet技巧两则
www.applevb.com
一、判断某一个连接是否保存在Cache中
在使用Microsoft IE在网上冲浪时，IE会把你浏览过的网页保存在Cache中以便你可以脱机浏览。
下面这个程序可以判断一个URL是否在浏览器的Cache中。
首先建立一个新的VB工程文件，在Form1中加入一个CommandButton控件和一个TextBox控件，然后
在Form1的代码窗口中加入以下代码：
Option Explicit
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const eeErrorBase = 26720
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
lpszSourceUrlName As String
lpszLocalFileName As String
CacheEntryType As String
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModifiedTime As FILETIME
ExpireTIme As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSize As Long
lpszFileExtension As String
dwReserved As Long
End Type
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias _
"GetUrlCacheEntryInfoA" _
(ByVal sUrlName As String, _
lpCacheEntryInfo As Any, _
lpdwCacheEntryInfoBufferSize As Long _
) As Long
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As _
Long, Arguments As Long) As Long
Public Function WinAPIError(ByVal lLastDLLError As Long) As String
Dim sBuff As String
Dim lCount As Long
'获取错误消息
sBuff = String$(256, 0)
lCount = FormatMessage( _
FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
If lCount Then
WinAPIError = Left$(sBuff, lCount)
End If
End Function
Public Function GetCacheEntryInfo(ByVal hWnd As Long, ByVal lpszUrl As String) As Boolean
Dim dwEntrySize As Long
Dim lpCacheEntry As INTERNET_CACHE_ENTRY_INFO
Dim dwTemp As Long
Dim lErr As Long
If (GetUrlCacheEntryInfo(lpszUrl, ByVal 0&, dwEntrySize)) = 0 Then
lErr = Err.LastDllError
If (lErr <> ERROR_INSUFFICIENT_BUFFER) Then
'URL没有在Cache中
Err.Raise eeErrorBase + 1, App.EXEName & ".mCacheEntry", WinAPIError(lErr)
GetCacheEntryInfo = False
Exit Function
Else
'URL保存在Cache中
GetCacheEntryInfo = True
End If
End If
End Function
Private Sub Command1_Click()
On Error GoTo ErrorHandler
If (GetCacheEntryInfo(Me.hWnd, Text1.Text)) Then
MsgBox "URL 保存在Cache中.", vbInformation
Else
MsgBox "URL 没有保存在Cache中.", vbInformation
End If
Exit Sub
ErrorHandler:
MsgBox "URL 没有保存在Cache中 [" & Err.Description & "]", vbInformation
End Sub
Private Sub Form_Load()
Form1.CurrentX = 150: Form1.CurrentY = 60
Form1.Print "在Text1中输入URL，按Command1检测"
Text1.Text = ""
Command1.Default = True
End Sub
运行程序，在TextBox中输入URL地址（例如http://member.netease.com/~blackcat），然后点击Command1
按钮，如果URL在Cache中，程序会弹出消息框显示URL 保存在Cache中。
二、判断是否已经连接到Internet
在很多的电脑刊物开发技巧栏目上介绍的判断是否连接到Internet是采取读取注册表的方法来进行的。其实
保存在注册表中的只是本机是否通过RAS连接到远端计算机，该方法只在Windows 9X下和通过Modem上网时才有效
如果是通过局域网或者在NT下连接到Internet，上面的方法就不起作用了。下面的程序通过调用Windows API函数
来获得是否连接到Internet上以及是使用什么方式连接的。
首先建立一个新的VB工程，在Form1中假如一个TextBox控件，然后在Form1的代码窗口中加入以下代码：
Dim eR As EIGCInternetConnectionState
Dim sMsg As String
Dim sName As String
Dim bConnected As Boolean
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
Alias "InternetGetConnectedStateExA" _
(ByRef lpdwFlags As Long, _
ByVal lpszConnectionName As String, _
ByVal dwNameLen As Long, _
ByVal dwReserved As Long _
) As Long
Private Enum EIGCInternetConnectionState
INTERNET_CONNECTION_MODEM = &H1&
INTERNET_CONNECTION_LAN = &H2&
INTERNET_CONNECTION_PROXY = &H4&
INTERNET_RAS_INSTALLED = &H10&
INTERNET_CONNECTION_OFFLINE = &H20&
INTERNET_CONNECTION_CONFIGURED = &H40&
End Enum
Private Function InternetConnected(Optional ByRef eConnectionInfo _
As EIGCInternetConnectionState, Optional ByRef _
sConnectionName As String) As Boolean
Dim dwFlags As Long
Dim sNameBuf As String
Dim lR As Long
Dim iPos As Long
sNameBuf = String$(513, 0)
lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
eConnectionInfo = dwFlags
iPos = InStr(sNameBuf, vbNullChar)
If iPos > 0 Then
sConnectionName = Left$(sNameBuf, iPos - 1)
ElseIf Not sNameBuf = String$(513, 0) Then
sConnectionName = sNameBuf
End If
InternetConnected = (lR = 1)
End Function
Private Sub Form_Load()
'检测是否已经以及使用什么方法连接到Internet
bConnected = InternetConnected(eR, sName)
'根据获得的结果输出
If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
sMsg = sMsg & "使用modem连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
sMsg = sMsg & "使用内部网连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
sMsg = sMsg & "通过代理服务器连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
sMsg = sMsg & "现在连接处于离线状态." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
sMsg = sMsg & "连接已经被设定." & vbCrLf
Else
sMsg = sMsg & "没有设定好的连接." & vbCrLf
End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
sMsg = sMsg & "本机已经安装了远程访问服务功能." & vbCrLf
End If
'显示连接名称
If bConnected Then
Text1.Text = "已连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg
Else
Text1.Text = "没有连接到Internet,连接名称: " & sName & vbCrLf & vbCrLf & sMsg
End If
End Sub
运行程序，可以看到在TextBox框内不仅显示是否连接到Internet，还显示出来使用什么方式连接以及建立
连接的名称。 
|
本类阅读TOP10