ieclean.frm

这是一款用VB6.0编写的清理IE历史缓存的工具

VERSION 5.00
Begin VB.Form IeClean 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "IE清理工具--By The TWin Heroes"
   ClientHeight    =   2145
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5010
   Icon            =   "IeClean.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "IeClean"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2145
   ScaleWidth      =   5010
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   1815
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   2895
      Begin VB.Label Label1 
         Height          =   1215
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   2655
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退         出(&Q)"
      Height          =   375
      Left            =   3120
      TabIndex        =   1
      Top             =   1440
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "清除临时文件(&H)"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   360
      Width           =   1815
   End
End
Attribute VB_Name = "IeClean"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
  '--------------------------Types,   consts   and   structures
  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_CACHE_ENTRY_INFO_SIZE       As Long = 4096
  Private Const LMEM_FIXED       As Long = &H0
  Private Const LMEM_ZEROINIT       As Long = &H40
  Public Enum eCacheType
  eNormal = &H1&
  eEdited = &H8&
  eTrackOffline = &H10&
  eTrackOnline = &H20&
  eSticky = &H40&
  eSparse = &H10000
  eCookie = &H100000
  eURLHistory = &H200000
  eURLFindDefaultFilter = 0&
  End Enum
  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                     'Type   of   entry   returned
  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
  '--------------------------Internet   Cache   API
  Private Declare Function FindFirstUrlCacheEntry Lib "Wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As Long) As Long
  Private Declare Function FindNextUrlCacheEntry Lib "Wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfoBufferSize As Long) As Long
  Private Declare Function FindCloseUrlCache Lib "Wininet.dll" (ByVal hEnumHandle As Long) As Long
  Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
  '--------------------------Memory   API
  Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
  Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
  Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
  Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
  'Purpose           :     Deletes   the   specified   internet   cache   file
  'Inputs             :     sCacheFile                             The   name   of   the   cache   file
  'Outputs           :     Returns   True   on   success.
  'Author             :     Andrew   Baker
  'Date                 :     03/08/2000   19:14
  'Notes               :
  'Revisions       :
  Function InternetDeleteCache(sCacheFile As String) As Boolean
  InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
  End Function
  'Purpose           :     Returns   an   array   of   files   stored   in   the   internet   cache
  'Inputs             :     eFilterType                           An   enum   which   filters   the   files   returned   by   their   type
  'Outputs           :     A   one   dimensional,   one   based,   string   array   containing   the   names   of   the   files
  'Author             :     Andrew   Baker
  'Date                 :     03/08/2000   19:14
  'Notes               :
  'Revisions       :
  Function InternetCacheList(Optional eFilterType As eCacheType = eNormal) As Variant
  Dim ICEI     As INTERNET_CACHE_ENTRY_INFO
  Dim lhFile     As Long, lBufferSize       As Long, lptrBuffer       As Long
  Dim sCacheFile     As String
  Dim asURLs()     As String, lNumEntries       As Long
  'Determine   required   buffer   size
  lBufferSize = 0
  lhFile = FindFirstUrlCacheEntry(0&, ByVal 0&, lBufferSize)
  If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
  'Allocate   memory   for   ICEI   structure
  lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
  If lptrBuffer Then
  'Set   a   Long   pointer   to   the   memory   location
  CopyMemory ByVal lptrBuffer, lBufferSize, 4
  'Call   first   find   API   passing   it   the   pointer   to   the   allocated   memory
  lhFile = FindFirstUrlCacheEntry(vbNullString, ByVal lptrBuffer, lBufferSize)                           '1   =   success
  If lhFile <> ERROR_CACHE_FIND_FAIL Then
  'Loop   through   the   cache
  Do
  'Copy   data   back   to   structure
  CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
  If ICEI.CacheEntryType And eFilterType Then
  sCacheFile = StrFromPtrA(ICEI.lpszSourceUrlName)
  lNumEntries = lNumEntries + 1
  If lNumEntries = 1 Then
  ReDim asURLs(1 To 1)
  Else
  ReDim Preserve asURLs(1 To lNumEntries)
  End If
  asURLs(lNumEntries) = sCacheFile
  End If
  'Free   memory   associated   with   the   last-retrieved   file
  Call LocalFree(lptrBuffer)
  'Call   FindNextUrlCacheEntry   with   buffer   size   set   to   0.
  'Call   will   fail   and   return   required   buffer   size.
  lBufferSize = 0
  Call FindNextUrlCacheEntry(lhFile, ByVal 0&, lBufferSize)
  'Allocate   and   assign   the   memory   to   the   pointer
  lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
  CopyMemory ByVal lptrBuffer, lBufferSize, 4&
  Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
  End If
  End If
  End If
  'Free   memory
  Call LocalFree(lptrBuffer)
  Call FindCloseUrlCache(lhFile)
  InternetCacheList = asURLs
  End Function
  'Purpose           :     Converts   a   pointer   an   ansi   string   into   a   string.
  'Inputs             :     lptrString                                     A   long   pointer   to   a   string   held   in   memory
  'Outputs           :     The   string   held   at   the   specified   memory   address
  'Author             :     Andrew   Baker
  'Date                 :     03/08/2000   19:14
  'Notes               :
  'Revisions       :
  Function StrFromPtrA(ByVal lptrString As Long) As String
  'Create   buffer
  StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
  'Copy   memory
  Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
  End Function
  'Demonstration   routine
  Sub Test()
  Dim avURLs     As Variant, vThisValue       As Variant
  On Error Resume Next
  'Return   an   array   of   all   internet   cache   files
  avURLs = InternetCacheList
  For Each vThisValue In avURLs
  'Print   files
  InternetDeleteCache CStr(vThisValue)
  'Debug.Print CStr(vThisValue)
  Next
  'Return   the   an   array   of   all   cookies
  avURLs = InternetCacheList(eCookie)
  If MsgBox("您确定要删除全部IE缓存吗?", vbQuestion + vbYesNo, "IE清理工具") = vbYes Then
  For Each vThisValue In avURLs
  'Delete   cookies
  InternetDeleteCache CStr(vThisValue)
  'Debug.Print "Deleted   " & vThisValue
  MsgBox "清理IE缓存成功!", vbInformation + vbOKOnly, "提示"
  Next
  Else
  For Each vThisValue In avURLs
  'Print   cookie   files
  Debug.Print vThisValue
  Next
  End If
  End Sub

Private Sub Command1_Click()
Call Test
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
       Case "72"
       Call Test
       Case "81"
       Unload Me
End Select
End Sub

Private Sub Form_Load()
If App.PrevInstance = True Then MsgBox "程序已经运行了...", vbInformation + vbOKOnly, "IE清理工具提示": End
Label1.Caption = "新绝代双骄江湖" & Chr(13) & Chr(13) & "网址:Http://www.tth3jh.com" & Chr(13) & Chr(13) & "说明:清除IE历史记录,解决不能无法登录江湖的问题！"
OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    ' 取得窗口函数的地址
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
    ' 用SubClass1_WndMessage代替窗口函数处理消息

    SysMenuHwnd = GetSystemMenu(Me.hwnd, False)

    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2000, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2001, "关于本程序(&A)")
    End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  If OldWindowProc <> GetWindowLong(Me.hwnd, GWL_WNDPROC) Then
        Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)
    End If
End Sub

'在每个窗体的初始化添加红色代码:
Private Sub Form_Initialize()
InitCommonControls
End Sub