Internet技巧两则

' 'Internet技巧两则 ' 'pzhan.eb.cn ' '一、判断某一个连接是否保存在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() Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias _        "GetUrlCacheEntryInfoA" _        (ByVal sUrlName As String, _        lpCacheEntryInfo As Any, _        lpdwCacheEntryInfoBufferSize As Long _        ) As LongPrivate Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800Private Const FORMAT_MESSAGE_FROM_STRING = &H400Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFFPrivate Declare Function FormatMessage()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 LongPublic Function WinAPIError()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 IfEnd FunctionPublic Function GetCacheEntryInfo()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 IfEnd FunctionPrivate Sub Command1_Click()Sub Command1_Click()    On Error GoTo ErrorHandler    If (GetCacheEntryInfo(Me.hWnd, Text1.Text)) Then        MsgBox "URL 保存在Cache中.", vbInformation    Else        MsgBox "URL 没有保存在Cache中.", vbInformation    End IfExit SubErrorHandler:    MsgBox "URL 没有保存在Cache中 [" & Err.Description & "]", vbInformationEnd SubPrivate Sub Form_Load()Sub Form_Load()    Form1.CurrentX = 150: Form1.CurrentY = 60    Form1.Print "在Text1中输入URL，按Command1检测"    Text1.Text = ""    Command1.Default = TrueEnd 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 EIGCInternetConnectionStateDim sMsg As StringDim sName As StringDim bConnected As BooleanPrivate Declare Function InternetGetConnectedStateEx()Function InternetGetConnectedStateEx Lib "wininet.dll" _        Alias "InternetGetConnectedStateExA" _        (ByRef lpdwFlags As Long, _        ByVal lpszConnectionName As String, _        ByVal dwNameLen As Long, _        ByVal dwReserved As Long _        ) As LongPrivate Enum EIGCInternetConnectionStateEnum 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 EnumPrivate Function InternetConnected()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 FunctionPrivate Sub Form_Load()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 IfEnd Sub    ''运行程序，可以看到在TextBox框内不仅显示是否连接到Internet，''还显示出来使用什么方式连接以及建立''连接的名称