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 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()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()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()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()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()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()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 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 Enum

Private 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 Function

Private 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 If
End Sub

    ''运行程序，可以看到在TextBox框内不仅显示是否连接到Internet，
''还显示出来使用什么方式连接以及建立
''连接的名称