WebBrower的应用和功能扩展中的一些技术细节

Author:水如烟

 

注意我的理解和处理结果不一定正确

 

n         如何判断URL字符串是否有效  

 

A.
命名空间:Microsoft.IE
程序集:IEHost(在 iehost.dll 中)
Manager.IsValidURL(url)
B.
< DllImport( " SHLWAPI " , CharSet: = CharSet.Auto) >  _
Private   Shared   Function  UrlIs( ByVal  pszUrl  As   String ByVal  Url_Is  As  URL_IS)  As   Boolean
End Function

Public   Shared   Function  IsValidURL( ByVal  pURL  As   String As   Boolean
    
Return  UrlIs(pURL, URL_IS.URLIS_URL)
End Function

Friend   Enum  URL_IS
    URLIS_APPLIABLE 
=   4
    URLIS_DIRECTORY 
=   5
    URLIS_FILEURL 
=   3
    URLIS_HASQUERY 
=   6
    URLIS_NOHISTORY 
=   2
    URLIS_OPAQUE 
=   1
    URLIS_URL 
=   0
End Enum

 

 

n         如何预处理URL字符串

 

Public   Shared   Sub  CheckUri( ByRef  uri  As   String )
    
If  uri  Is   Nothing   Then  uri  =  WebBrowserEx.DefaultUri

    uri 
=  uri.Trim
    
If  uri  =  WebBrowserEx.DefaultUri  Then   Return

    
If  IsValidUrl(uri)  Then   Return

    
Dim  prefix  As   String

    
If  uri.StartsWith( " // " OrElse  Regex.IsMatch(uri,  " ^[A-Za-z]: " Then
        prefix 
=   " file:// "
    
Else
        prefix 
=   " http:// "
    
End   If

    
If  IsValidUrl(prefix  &  uri)  Then
        uri 
=  prefix  &  uri
        
Return
    
End   If

    uri 
=  WebBrowserEx.DefaultUri
End Sub

注:WebBrowserEx.DefaultUri为Const 
String   =   " about:blank "
注意:上面函数参数uri用ByRef定义,非ByVal

 

n         如何把URL已编码的字符串转换为解码的字符串

 

命名空间:System.Web
程序集:System.Web(在 system.web.dll 中)
HttpUtility.UrlDecode 方法

 

n         如何把URL字符串编码

 

命名空间:System.Web
程序集:System.Web(在 system.web.dll 中)
HttpUtility.UrlEncode 方法 

 

n         如何取得url快捷方式的内容

 

Private   Declare   Function  GetPrivateProfileStringA  Lib   " kernel32.dll "  ( _
     
ByVal  lpApplicationName  As   String , _
     
ByVal  lpKeyName  As   String , _
     
ByVal  lpDefault  As   String , _
     
ByVal  lpReturnedString  As  System.Text.StringBuilder, _
     
ByVal  nSize  As   Integer , _
     
ByVal  lpFileName  As   String  _
As   Integer

Public   Shared   Function  GetInternalShortcutUrl( ByVal  filename  As   String As   String
    
Dim  mResult  As   New  System.Text.StringBuilder( "   " 260 )
    GetPrivateProfileStringA(
" InternetShortcut " " URL " "" , mResult, mResult.Capacity, filename)
    
Return  mResult.ToString
End Function

Public   Shared   Function  GetInternalShortcutIconFile( ByVal  filename  As   String As   String
    
Dim  mResult  As   New  System.Text.StringBuilder( "   " 260 )
    GetPrivateProfileStringA(
" InternetShortcut " " IconFile " "" , mResult, mResult.Capacity, filename)
    
Return  mResult.ToString
End Function

 

n         如何建立url快捷方式

 

Private   Declare   Function  WritePrivateProfileString  Lib   " kernel32 "   Alias   " WritePrivateProfileStringA "  ( _
    
ByVal  lpSectionName  As   String , _
    
ByVal  lpKeyName  As   String , _
    
ByVal  lpString  As   String , _
    
ByVal  lpFileName  As   String  _
As   Boolean

Public   Shared   Function  AddInternetShortcut( ByVal  url  As   String ByVal  filename  As   String As   Boolean
    filename 
=  filename.Trim
    
If  filename.ToLower.LastIndexOf( " .url " =   - 1   Then  filename  &=   " .url "
    
Return  WritePrivateProfileString( " InternetShortcut " " URL " , url, filename)
End Function

Public   Shared   Function  AddInternetShortcut( ByVal  url  As   String ByVal  path  As   String ByVal  name  As   String As   Boolean
    
Dim  mFilename  As   String   =  My.Computer.FileSystem.CombinePath(path, name)
    
Return  AddInternetShortcut(url, mFilename)
End Function

Public   Shared   Function  AddInternetShortcut( ByVal  url  As   String ByVal  specialfolder  As  System.Environment.SpecialFolder,  ByVal  name  As   String As   Boolean
    
Dim  mPath  As   String   =  System.Environment.GetFolderPath(specialfolder)
    
Return  AddInternetShortcut(url, mPath, name)
End Function

 

n         如何读取IE缓存内容

   

注:参考了Scott McMaster的代码,见
WebCacheTool: Manipulate the IE Browser Cache From the 
Command- Line

Imports  System
Imports  System.Runtime.InteropServices
Namespace  LzmTW.uSystem.uWindows.Win32API
    
Friend   NotInheritable   Class  UnsafeNativeMethods
        
Public   Const  ERROR_SUCCESS  As   Integer   =   0
        
Public   Const  ERROR_FILE_NOT_FOUND  As   Integer   =   2
        
Public   Const  ERROR_ACCESS_DENIED  As   Integer   =   5
        
Public   Const  ERROR_INSUFFICIENT_BUFFER  As   Integer   =   122
        
Public   Const  ERROR_NO_MORE_ITEMS  As   Integer   =   259

        
< StructLayout(LayoutKind.Sequential) >  _
        
Public   Structure  FILETIME
            
Public  dwLowDateTime  As   Integer
            
Public  dwHighDateTime  As   Integer
        
End Structure

        
< StructLayout(LayoutKind.Sequential) >  _
        
Public   Structure  SYSTEMTIME
            
Public   Year   As  Int16
            
Public   Month   As  Int16
            
Public  DayOfWeek  As  Int16
            
Public   Day   As  Int16
            
Public   Hour   As  Int16
            
Public   Minute   As  Int16
            
Public   Second   As  Int16
            
Public  Milliseconds  As  Int16
        
End Structure

        
< DllImport( " Kernel32.dll " , SetLastError: = True ) >  _
        
Public   Shared   Function  FileTimeToSystemTime( ByRef  FileTime  As  FILETIME,  ByRef  SystemTime  As  SYSTEMTIME)  As   Integer
        
End Function

        
< DllImport( " kernel32.dll " , SetLastError: = True ) >  _
        
Public   Shared   Function  SystemTimeToTzSpecificLocalTime( _
            
ByVal  lpTimeZoneInformation  As  IntPtr, _
            
ByRef  lpUniversalTime  As  SYSTEMTIME, _
            
ByRef  lpLocalTime  As  SYSTEMTIME _
        ) 
As   Integer
        
End Function

        
Public   Shared   Function  FromFileTime( ByVal  ft  As  UnsafeNativeMethods.FILETIME)  As  DateTime
            
If  ft.dwHighDateTime  =  Int32.MaxValue  OrElse  (ft.dwLowDateTime  =   0   AndAlso  ft.dwHighDateTime  =   0 Then
                
Return  DateTime.MinValue
            
End   If
            
Dim  syst  As  UnsafeNativeMethods.SYSTEMTIME  =   New  UnsafeNativeMethods.SYSTEMTIME
            
Dim  systLocal  As  UnsafeNativeMethods.SYSTEMTIME  =   New  UnsafeNativeMethods.SYSTEMTIME
            
If   0   =  UnsafeNativeMethods.FileTimeToSystemTime(ft, syst)  Then
                
Throw   New  ApplicationException( " Error calling FileTimeToSystemTime:  "   &  Marshal.GetLastWin32Error)
            
End   If
            
If   0   =  UnsafeNativeMethods.SystemTimeToTzSpecificLocalTime(IntPtr.Zero, syst, systLocal)  Then
                
Throw   New  ApplicationException( " Error calling SystemTimeToTzSpecificLocalTime:  "   &  Marshal.GetLastWin32Error)
            
End   If
            
Return   New  DateTime(systLocal.Year, systLocal.Month, systLocal.Day, systLocal.Hour, systLocal.Minute, systLocal.Second)
        
End Function

        
Public   Shared   Function  ToStringFromFileTime( ByVal  ft  As  UnsafeNativeMethods.FILETIME)  As   String
            
Dim  dt  As  DateTime  =  FromFileTime(ft)
            
If  dt  =  DateTime.MinValue  Then
                
Return   ""
            
End   If
            
Return  dt.ToString
        
End Function

        
Private   Sub   New ()
        
End Sub
    
End Class
End Namespace

 

 

Imports  System
Imports  System.Collections
Imports  System.Runtime.InteropServices
Imports  System.Text.RegularExpressions
Imports  System.Diagnostics

Namespace  LzmTW.uSystem.uWindows.Win32API

    
Friend   NotInheritable   Class  WinInetAPI
        
< StructLayout(LayoutKind.Sequential) >  _
        
Public   Structure  INTERNET_CACHE_ENTRY_INFO
            
Public  dwStructSize  As   Integer
            
Public  lpszSourceUrlName  As   String
            
Public  lpszLocalFileName  As   String
            
Public  CacheEntryType  As   Integer
            
Public  dwUseCount  As   Integer
            
Public  dwHitRate  As   Integer
            
Public  dwSizeLow  As   Integer
            
Public  dwSizeHigh  As   Integer
            
Public  LastModifiedTime  As  UnsafeNativeMethods.FILETIME
            
Public  ExpireTime  As  UnsafeNativeMethods.FILETIME
            
Public  LastAccessTime  As  UnsafeNativeMethods.FILETIME
            
Public  LastSyncTime  As  UnsafeNativeMethods.FILETIME
            
Public  lpHeaderInfo  As  IntPtr
            
Public  dwHeaderInfoSize  As   Integer
            
Public  lpszFileExtension  As   String
            
Public  dwExemptDelta  As   Integer
        
End Structure

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  FindCloseUrlCache( ByVal  hEnumHandle  As  IntPtr)  As   Integer
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  FindFirstUrlCacheEntry( _
            
ByVal  lpszUrlSearchPattern  As   String , _
            
ByVal  lpFirstCacheEntryInfo  As  IntPtr, _
            
ByRef  lpdwFirstCacheEntryInfoBufferSize  As   Integer  _
        ) 
As  IntPtr
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  FindNextUrlCacheEntry( _
            
ByVal  hEnumHandle  As  IntPtr, _
            
ByVal  lpNextCacheEntryInfo  As  IntPtr, _
            
ByRef  lpdwNextCacheEntryInfoBufferSize  As   Integer  _
        ) 
As   Integer
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  GetUrlCacheEntryInfo( _
            
ByVal  lpszUrlName  As   String , _
            
ByVal  lpCacheEntryInfo  As  IntPtr, _
            
ByRef  lpdwCacheEntryInfoBufferSize  As   Integer  _
        ) 
As   Boolean
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  DeleteUrlCacheEntry( ByVal  lpszUrlName  As   String As   Integer
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  RetrieveUrlCacheEntryStream( _
            
ByVal  lpszUrlName  As   String , _
            
ByVal  lpCacheEntryInfo  As  IntPtr, _
            
ByRef  lpdwCacheEntryInfoBufferSize  As   Integer , _
            
ByVal  fRandomRead  As   Boolean , _
            
ByVal  dwReserved  As   Integer  _
        ) 
As  IntPtr
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  ReadUrlCacheEntryStream( _
            
ByVal  hUrlCacheStream  As  IntPtr, _
            
ByVal  dwLocation  As   Integer , _
            
ByVal  lpBuffer  As  IntPtr, _
            
ByRef  lpdwLen  As   Integer , _
            
ByVal  dwReserved  As   Integer  _
        ) 
As  IntPtr
        
End Function

        
< DllImport( " wininet.dll " , SetLastError: = True ) >  _
        
Private   Shared   Function  UnlockUrlCacheEntryStream( ByVal  hUrlCacheStream  As  IntPtr,  ByVal  dwReserved  As   Integer As   Integer
        
End Function

        
Public   Shared   Sub  DeleteFromUrlCache( ByVal  url  As   String )
            
Dim  apiResult  As   Integer   =  DeleteUrlCacheEntry(url)
            
If   Not  (apiResult  =   0 Then
                
Return
            
End   If
            
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
            
If  lastError  =  UnsafeNativeMethods.ERROR_ACCESS_DENIED  Then
                ThrowAccessDenied(url)
            
Else
                ThrowFileNotFound(url)
            
End   If
        
End Sub

        
Private   Shared   Sub  ThrowAccessDenied( ByVal  url  As   String )
            
Throw   New  ApplicationException( " Access denied:  "   +  url)
        
End Sub

        
Private   Shared   Sub  ThrowInsufficientBuffer( ByVal  url  As   String )
            
Throw   New  ApplicationException( " Insufficient buffer:  "   +  url)
        
End Sub

        
Private   Shared   Sub  ThrowFileNotFound( ByVal  url  As   String )
            
Throw   New  ApplicationException( " File not found:  "   +  url)
        
End Sub

        
Private   Shared   Sub  CheckLastError( ByVal  url  As   String ByVal  ignoreInsufficientBuffer  As   Boolean )
            
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
            
If  lastError  =  UnsafeNativeMethods.ERROR_INSUFFICIENT_BUFFER  Then
                
If   Not  ignoreInsufficientBuffer  Then
                    ThrowInsufficientBuffer(url)
                
End   If
            
Else
                
If  lastError  =  UnsafeNativeMethods.ERROR_FILE_NOT_FOUND  Then
                    ThrowFileNotFound(url)
                
Else
                    
If  lastError  =  UnsafeNativeMethods.ERROR_ACCESS_DENIED  Then
                        ThrowAccessDenied(url)
                    
Else
                        
If   Not  (lastError  =  UnsafeNativeMethods.ERROR_SUCCESS)  Then
                            
Throw   New  ApplicationException( " Unexpected error, code= "   +  lastError.ToString)
                        
End   If
                    
End   If
                
End   If
            
End   If
        
End Sub

        
Public   Shared   Function  GetUrlCacheEntryInfo( ByVal  url  As   String As  INTERNET_CACHE_ENTRY_INFO
            
Dim  buffer  As  IntPtr  =  IntPtr.Zero
            
Dim  structSize  As   Integer
            
Dim  apiResult  As   Boolean   =  GetUrlCacheEntryInfo(url, buffer, structSize)
            CheckLastError(url, 
True )
            
Try
                buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                apiResult 
=  GetUrlCacheEntryInfo(url, buffer, structSize)
                
If  apiResult  =   True   Then
                    
Return   CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                
End   If
                CheckLastError(url, 
False )
            
Finally
                
If  buffer.ToInt32  >   0   Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                
End   If
            
End   Try
            Debug.Assert(
False " We should either early-return or throw before we get here " )
            
Return   New  INTERNET_CACHE_ENTRY_INFO
        
End Function

        
Public   Shared   Function  RetrieveUrlCacheEntryContents( ByVal  url  As   String As   String
            
Dim  buffer  As  IntPtr  =  IntPtr.Zero
            
Dim  info  As  INTERNET_CACHE_ENTRY_INFO  =   New  INTERNET_CACHE_ENTRY_INFO
            
Dim  structSize  As   Integer
            
Dim  hStream  As  IntPtr  =  IntPtr.Zero
            RetrieveUrlCacheEntryStream(url, buffer, structSize, 
False 0 )
            CheckLastError(url, 
True )
            
Try
                buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                hStream 
=  RetrieveUrlCacheEntryStream(url, buffer, structSize,  False 0 )
                CheckLastError(url, 
True )
                info 
=   CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                
Dim  streamSize  As   Integer   =  info.dwSizeLow
                
Dim  outBuffer  As  IntPtr  =  Marshal.AllocHGlobal( CType (streamSize,  Integer ))
                
Try
                    
Dim  result  As  IntPtr  =  ReadUrlCacheEntryStream(hStream,  0 , outBuffer, streamSize,  0 )
                    CheckLastError(url, 
False )
                    
Return  Marshal.PtrToStringAnsi(outBuffer)
                
Finally
                    
If  outBuffer.ToInt32  >   0   Then
                        
Try
                            Marshal.FreeHGlobal(outBuffer)
                        
Catch
                        
End   Try
                    
End   If
                
End   Try
            
Finally
                
If  buffer.ToInt32  >   0   Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                
End   If
                
If   Not  (hStream  =  IntPtr.Zero)  Then
                    
Dim  dwReserved  As   Integer   =   0
                    UnlockUrlCacheEntryStream(hStream, dwReserved)
                
End   If
            
End   Try
        
End Function

        
' 添加了OnlyOne参数,找到一个即返回
         Public   Shared   Function  FindUrlCacheEntries( ByVal  urlPattern  As   String Optional   ByVal  OnlyOne  As   Boolean   =   True As  ArrayList
            
Dim  results  As  ArrayList  =   New  ArrayList
            
Dim  buffer  As  IntPtr  =  IntPtr.Zero
            
Dim  structSize  As   Integer
            
Dim  hEnum  As  IntPtr  =  FindFirstUrlCacheEntry( Nothing , buffer, structSize)
            
Try
                
If  hEnum  =  IntPtr.Zero  Then
                    
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
                    
If  lastError  =  UnsafeNativeMethods.ERROR_INSUFFICIENT_BUFFER  Then
                        buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                        hEnum 
=  FindFirstUrlCacheEntry(urlPattern, buffer, structSize)
                    
Else
                        
If  lastError  =  UnsafeNativeMethods.ERROR_NO_MORE_ITEMS  Then
                            
Return  results
                        
End   If
                    
End   If
                
End   If
                
Dim  result  As  INTERNET_CACHE_ENTRY_INFO  =  _
                    
CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                
Try
                    
If  Regex.IsMatch(result.lpszSourceUrlName, urlPattern, RegexOptions.IgnoreCase)  Then
                        results.Add(result)
                        
If  OnlyOne  Then   Return  results
                    
End   If
                
Catch  ae  As  ArgumentException
                    
Throw   New  ApplicationException( " Invalid regular expression, details= "   +  ae.Message)
                
End   Try
                
If   Not  (buffer  =  IntPtr.Zero)  Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                    buffer 
=  IntPtr.Zero
                    structSize 
=   0
                
End   If
                
While   True
                    
Dim  nextResult  As   Integer   =  FindNextUrlCacheEntry(hEnum, buffer, structSize)
                    
If   Not  (nextResult  =   1 Then
                        
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
                        
If  lastError  =  UnsafeNativeMethods.ERROR_INSUFFICIENT_BUFFER  Then
                            buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                            nextResult 
=  FindNextUrlCacheEntry(hEnum, buffer, structSize)
                        
Else
                            
If  lastError  =  UnsafeNativeMethods.ERROR_NO_MORE_ITEMS  Then
                                
Exit   While
                            
End   If
                        
End   If
                    
End   If
                    result 
=   CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                    
If   Not   String .IsNullOrEmpty(result.lpszSourceUrlName)  Then
                        
If  Regex.IsMatch(result.lpszSourceUrlName, urlPattern, RegexOptions.IgnoreCase)  Then
                            results.Add(result)
                            
If  OnlyOne  Then   Return  results
                        
End   If
                    
End   If
                    
If   Not  (buffer  =  IntPtr.Zero)  Then
                        
Try
                            Marshal.FreeHGlobal(buffer)
                        
Catch
                        
End   Try
                        buffer 
=  IntPtr.Zero
                        structSize 
=   0
                    
End   If
                
End   While
            
Finally
                
If   Not  (hEnum  =  IntPtr.Zero)  Then
                    FindCloseUrlCache(hEnum)
                
End   If
                
If   Not  (buffer  =  IntPtr.Zero)  Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                
End   If
            
End   Try
            
Return  results
        
End Function

        
' 添加了查询耗时限制
         Public   Shared   Function  FindUrlCacheEntriesQuickly( _
            
ByVal  urlPattern  As   String Optional   ByVal  OnlyOne  As   Boolean   =   True As  ArrayList

            
Dim  results  As  ArrayList  =   New  ArrayList
            
Dim  buffer  As  IntPtr  =  IntPtr.Zero
            
Dim  structSize  As   Integer
            
Dim  hEnum  As  IntPtr  =  FindFirstUrlCacheEntry( Nothing , buffer, structSize)
            
Try
                
If  hEnum  =  IntPtr.Zero  Then
                    
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
                    
If  lastError  =  UnsafeNativeMethods.ERROR_INSUFFICIENT_BUFFER  Then
                        buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                        hEnum 
=  FindFirstUrlCacheEntry(urlPattern, buffer, structSize)
                    
Else
                        
If  lastError  =  UnsafeNativeMethods.ERROR_NO_MORE_ITEMS  Then
                            
Return  results
                        
End   If
                    
End   If
                
End   If
                
Dim  result  As  INTERNET_CACHE_ENTRY_INFO  =  _
                    
CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                
Try
                    
If  Regex.IsMatch(result.lpszSourceUrlName, urlPattern, RegexOptions.IgnoreCase)  Then
                        results.Add(result)
                        
If  OnlyOne  Then   Return  results
                    
End   If
                
Catch  ae  As  ArgumentException
                    
Throw   New  ApplicationException( " Invalid regular expression, details= "   +  ae.Message)
                
End   Try
                
If   Not  (buffer  =  IntPtr.Zero)  Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                    buffer 
=  IntPtr.Zero
                    structSize 
=   0
                
End   If

                
Dim  t  As  DateTime  =  Now

                
While   True

                    
If  Now.CompareTo(t.AddMilliseconds( 10 ))  >   0   Then   ' 在此限制
                         Exit   While
                    
End   If

                    
Dim  nextResult  As   Integer   =  FindNextUrlCacheEntry(hEnum, buffer, structSize)
                    
If   Not  (nextResult  =   1 Then
                        
Dim  lastError  As   Integer   =  Marshal.GetLastWin32Error
                        
If  lastError  =  UnsafeNativeMethods.ERROR_INSUFFICIENT_BUFFER  Then
                            buffer 
=  Marshal.AllocHGlobal( CType (structSize,  Integer ))
                            nextResult 
=  FindNextUrlCacheEntry(hEnum, buffer, structSize)
                        
Else
                            
If  lastError  =  UnsafeNativeMethods.ERROR_NO_MORE_ITEMS  Then
                                
Exit   While
                            
End   If
                        
End   If
                    
End   If
                    result 
=   CType (Marshal.PtrToStructure(buffer,  GetType (INTERNET_CACHE_ENTRY_INFO)), INTERNET_CACHE_ENTRY_INFO)
                    
If   Not   String .IsNullOrEmpty(result.lpszSourceUrlName)  Then
                        
If  Regex.IsMatch(result.lpszSourceUrlName, urlPattern, RegexOptions.IgnoreCase)  Then
                            results.Add(result)
                            
If  OnlyOne  Then   Return  results
                        
End   If
                    
End   If
                    
If   Not  (buffer  =  IntPtr.Zero)  Then
                        
Try
                            Marshal.FreeHGlobal(buffer)
                        
Catch
                        
End   Try
                        buffer 
=  IntPtr.Zero
                        structSize 
=   0
                    
End   If
                
End   While
            
Finally
                
If   Not  (hEnum  =  IntPtr.Zero)  Then
                    FindCloseUrlCache(hEnum)
                
End   If
                
If   Not  (buffer  =  IntPtr.Zero)  Then
                    
Try
                        Marshal.FreeHGlobal(buffer)
                    
Catch
                    
End   Try
                
End   If
            
End   Try
            
Return  results
        
End Function

        
Private   Sub   New ()
        
End Sub

    
End Class

End Namespace

 

 

n         如何取得网站图标(如有的话)即favicon.ico

一个有效的URL,其主机URL为
Public   Function  GetHostUrl( ByVal  url  As   String As   String
    
Dim  mHostUrl  As   String
    
Dim  tmp  As   New  Uri(url)
    mHostUrl 
=   String .Concat(tmp.Scheme, Uri.SchemeDelimiter, tmp.Host)
    
Return  mHostUrl
End Function

图标URL为
Public   Function  GetFaviconUrl( ByVal  url  As   String As   String
    
Return   String .Concat(GetHostUrl(url),  " /favicon.ico " )
End Function

这样,可以利用WebClient下载
如,
Public   Sub  SaveFaviconToDesktop( ByVal  icoUrl  As   String )
    
Dim  mFileName  As   String
    mFileName 
=  icoUrl.Substring(icoUrl.LastIndexOf(Uri.SchemeDelimiter)  +  Uri.SchemeDelimiter.Length).Replace( " / " " . " )

    
Using  mClient  As   New  System.Net.WebClient
        mClient.DownloadFile(icoUrl, System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop) 
&   " "   &  mFileName)
    
End   Using

End Sub

示例:
Public   Sub  Test()
    SaveFaviconToDesktop(GetFaviconUrl(
" http://community.csdn.net/Expert/topic/5370/5370531.xml?temp=.8896601 " ))
End Sub

在WebBrowser中,分析当前页是否含网页图标,可以这样,
Public   Function  WebFaviconExist( ByVal  doc  As  HtmlDocument,  ByRef  icoUrl  As   String As   Boolean
    icoUrl 
=   ""
    
If  doc  Is   Nothing   Then   Return   False

    
Dim  mHeadElements  As  HtmlElementCollection  =  doc.GetElementsByTagName( " head " )
    
If  mHeadElements.Count  =   0   Then   Return   False

    
Dim  mHeadElement  As  HtmlElement  =  mHeadElements( 0 )

    
Dim  tmpUrl  As   String   =   ""

    
With  mHeadElement.Children.GetEnumerator
        
While  .MoveNext
            
With   CType (.Current, HtmlElement)
                
If   String .IsNullOrEmpty(.TagName)  Then   Continue   While

                
If  .TagName.ToLower.IndexOf( " link " =   - 1   Then   Continue   While

                tmpUrl 
=  .GetAttribute( " href " )
                
If   String .IsNullOrEmpty(tmpUrl)  Then   Continue   While

                
If  tmpUrl.ToLower.IndexOf( " favicon.ico " =   - 1   Then   Continue   While

                icoUrl 
=  GetFaviconUrl(doc.Url.AbsoluteUri)
                
Return   True
            
End   With
        
End   While
    
End   With

    
Return   False
End Function

示例:
Private   Sub  TestToolStripMenuItem_Click( ByVal  sender  As  System.Object,  ByVal  e  As  System.EventArgs) _
Handles  TestToolStripMenuItem.Click
    
Dim  icoUrl  As   String
    
If  WebFaviconExist( Me .WebBrowser1.Document, icoUrl)  Then
        SaveFaviconToDesktop(icoUrl)
    
End   If
End Sub

以上是在联网状态下直接从网站中取的。下面从IE缓存中取。

 

 

n         待续

 
相关文章
相关标签/搜索