分享
 
 
 

Internet技巧两则

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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,还显示出来使用什么方式连接以及建立

连接的名称。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有