Chinaunix首页 | 论坛 | 博客
  • 博客访问: 187243
  • 博文数量: 106
  • 博客积分: 3810
  • 博客等级: 中校
  • 技术积分: 1007
  • 用 户 组: 普通用户
  • 注册时间: 2009-03-18 13:35
文章分类

全部博文(106)

文章存档

2014年(17)

2011年(5)

2010年(75)

2009年(9)

我的朋友

分类: Windows平台

2014-03-20 10:26:20

网上找了半天资料,要么直接清理全部缓存的要么就是清理指定URL的缓存。。

这些都鸟用啊。。。气气的 看来只能用爆搜法了,本想用注册表法来获取COOKIE文件夹路径,既然有现成的api和函数,那就不用麻烦注册表了,直接把文件名含有baidu的cookie删了就好 ,下面是代码


Option Explicit
                                                                 
Private Const ERROR_CACHE_FIND_FAIL         As Long 0
Private Const ERROR_CACHE_FIND_SUCCESS      As Long 1
Private Const ERROR_FILE_NOT_FOUND          As Long 2
Private Const ERROR_ACCESS_DENIED           As Long 5
Private Const ERROR_INSUFFICIENT_BUFFER     As Long 122
Private Const MAX_PATH                      As Long 260
Private Const MAX_CACHE_ENTRY_INFO_SIZE     As Long 4096
Private Const LMEM_FIXED                    As Long &H0
Private Const LMEM_ZEROINIT                 As Long &H40
Private Const LPTR                          As Long = (LMEM_FIXED OrLMEM_ZEROINIT)
Private Const NORMAL_CACHE_ENTRY            As Long &H1
Private Const EDITED_CACHE_ENTRY            As Long &H8
Private Const TRACK_OFFLINE_CACHE_ENTRY     As Long &H10
Private Const TRACK_ONLINE_CACHE_ENTRY      As Long &H20
Private Const STICKY_CACHE_ENTRY            As Long &H40
Private Const SPARSE_CACHE_ENTRY            As Long &H10000
Private Const COOKIE_CACHE_ENTRY            As Long &H100000
Private Const URLHISTORY_CACHE_ENTRY        As Long &H200000
Private Const URLCACHE_FIND_DEFAULT_FILTER  As Long = NORMAL_CACHE_ENTRY OrCOOKIE_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY Or TRACK_OFFLINE_CACHE_ENTRY OrTRACK_ONLINE_CACHE_ENTRY Or STICKY_CACHE_ENTRY
Private Type FILETIME
    dwLowDateTime                           
As Long
    
dwHighDateTime                          As Long
End 
Type
Private Type INTERNET_CACHE_ENTRY_INFO
    dwStructSize                            
As Long
    
lpszSourceUrlName                       As Long
    
lpszLocalFileName                       As Long
    
CacheEntryType                          As Long
    
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 Long
    
dwExemptDelta                           As Long
End 
Type
Private Declare Function FindFirstUrlCacheEntry Lib "wininet" Alias"FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As LongAs Long
Private Declare Function 
FindNextUrlCacheEntry Lib "wininet" Alias"FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo AsAny, lpdwNextCacheEntryInfoBufferSize As LongAs Long
Private Declare Function 
FindCloseUrlCache Lib "wininet" (ByVal hEnumHandle As LongAs Long
Private Declare Function 
DeleteUrlCacheEntry Lib "wininet" Alias"DeleteUrlCacheEntryA" (ByVal lpszUrlName As StringAs Long
Private Declare Sub 
CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest AsAny, pSource As Any, ByVal dwLength As Long)
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As StringByValPtr As LongAs Long
Private Declare Function 
lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Private Declare Function 
LocalAlloc Lib "kernel32" (ByVal uFlags As LongByValuBytes As LongAs Long
Private Declare Function 
LocalFree Lib "kernel32" (ByVal hMem As LongAs Long
Private Const 
NO_ERROR = 0
Private Const INTERNET_OPTION_END_BROWSER_SESSION = 42
Private Const CSIDL_COOKIES = &H21&
Private Type SHITEMID
    cb                                      
As Long
    
abID                                    As Byte
End 
Type
Private Type ITEMIDLIST
    mkid                                    
As SHITEMID
End Type
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByValhwnd As LongByVal szApp As StringByVal szOtherStuff As StringByVal hIconAs LongAs Long
Private Declare Function 
SHGetSpecialFolderLocation Lib "shell32.dll" (ByValhwndOwner As LongByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function 
SHGetPathFromIDList Lib "shell32.dll" Alias"SHGetPathFromIDListA" (ByVal pidl As LongByVal pszPath As StringAs Long
Private Declare Function 
InternetSetOption Lib "wininet.dll" Alias"InternetSetOptionA" (ByVal hInternet As LongByVal dwOption As LongByReflpBuffer As Any, ByVal dwBufferLength As LongAs Long
Public 
yuming$

Private Function GetSpecialfolder(CSIDL As LongAs String
    Dim 
r     As Long
    Dim 
IDL     As ITEMIDLIST
    
Dim Path     As String
    
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    
If r = NO_ERROR Then
        
Path = Space$(512)
        r = SHGetPathFromIDList(
ByVal IDL.mkid.cb, ByVal Path$)
        GetSpecialfolder = left$(Path, InStr(Path, Chr$(
0)) - 1)
        
Exit Function
    End If
    
GetSpecialfolder = ""
End Function
                                                                    
Public Function 
DeleteCookie()
    
Dim CookiesPath$, File$
    CookiesPath = GetSpecialfolder(CSIDL_COOKIES)                              
'获取COOKIES文件夹路径
    
Call InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, ByVal 0&, 0'为了防止在ie打开时,内存中还有部分COOKIES存在,加了这句
    
File = Dir(CookiesPath & "\*.txt")
    
Do
        If 
File = "" Then Exit Do
        On Error Resume Next
        If 
InStr(File, "baidu.com") <> Then Kill CookiesPath & "\" & File & ""
        
File = Dir
    
Loop
End Function
                                                                    
Public Function 
DeleteCacheURLList()
    
Dim icei As INTERNET_CACHE_ENTRY_INFO
    
Dim hFile As Long
    Dim 
cachefile As String
    Dim 
posUrl As Long
    Dim 
posEnd As Long
    Dim 
dwBuffer As Long
    Dim 
pntrICE As Long
    
hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
    
If (hFile = ERROR_CACHE_FIND_FAIL) And _
       (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) 
Then
        
pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
        
If pntrICE <> Then
            
CopyMemory ByVal pntrICE, dwBuffer, 4
            
hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
            
If hFile <> ERROR_CACHE_FIND_FAIL Then
                Do
                    
CopyMemory icei, ByVal pntrICE, Len(icei)
                    
If (icei.CacheEntryType And _
                       NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY 
Then
                        
cachefile = GetStrFromPtrA(icei.lpszSourceUrlName)
                        
If InStr(cachefile, "Cookie") = And InStr(cachefile,"baidu.com") <> Then
                            Call 
DeleteUrlCacheEntry(cachefile) 
'清除指定缓存
                            
Call DeleteCookie '清除指定cookie
                        
End If
                    End If
                    Call 
LocalFree(pntrICE)
                    dwBuffer = 
0
                    
Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                    pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
                    CopyMemory 
ByVal pntrICE, dwBuffer, 4
                
Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
            
End If
        End If
    End If
    Call 
LocalFree(pntrICE)
    
Call FindCloseUrlCache(hFile)
End Function
                                                                    
Private Function 
GetStrFromPtrA(ByVal lpszA As LongAs String
    
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
阅读(1645) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~