Internet技巧兩則

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，還顯示出來使用什么方式連接以及建立
連接的名稱。