删除cookies及上网历史记录(DELPHI代码完整版本)

//前面要加几个pas单元 
uses Registry,ShellApi, WinInet,ShlObj,ComObj; 

procedure DelRegCache; 
var 
       reg:TRegistry; 
begin 
       reg:=Tregistry.create; 
       reg.RootKey:=HKEY_CURRENT_USER; 
       reg.DeleteKey(’Software\Microsoft\Internet Explorer\TypedURLs’); 
       reg.Free; 
end; 
function GetCookiesFolder:string; 
var 
        pidl:pItemIDList; 
        buffer:array [ 0..255 ] of char ; 
begin 
       SHGetSpecialFolderLocation( 
         application.Handle , CSIDL_COOKIES, pidl); 
       SHGetPathFromIDList(pidl, buffer); 
       result:=strpas(buffer); 
end; 
function ShellDeleteFile(sFileName: string): Boolean; 
var 
      FOS: TSHFileOpStruct; 
begin 
       FillChar(FOS, SizeOf(FOS), 0); {记录清零} 
       with FOS do 
       begin 
           wFunc := FO_DELETE;//删除 
           pFrom := PChar(sFileName); 
           fFlags := FOF_NOCONFIRMATION; 
       end; 
       Result := (SHFileOperation(FOS) = 0); 
end; 

//删除cookies 
procedure DelCookie; 
var 
       dir:string; 
begin 
      try 
       InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0); 
       dir:=GetCookiesFolder; 
       ShellDeleteFile(dir+’\*.txt’+#0);        //网上很多代码这里没有加最后的#0，在xp下经测试会报错 
      except 
       abort; 
      end; 
end; 

//删除历史记录 
procedure DelHistory; 
var 
      lpEntryInfo: PInternetCacheEntryInfo; 
      hCacheDir: LongWord ; 
      dwEntrySize, dwLastError: LongWord; 
begin 
      try 
       dwEntrySize := 0; 
       FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize); 
       GetMem(lpEntryInfo, dwEntrySize); 
       hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); 
       if hCacheDir 〈〉 0 then 
          DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); 
       FreeMem(lpEntryInfo); 
       repeat 
         dwEntrySize := 0; 
         FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), 
           dwEntrySize); 
         dwLastError := GetLastError(); 
         if dwLastError = ERROR_INSUFFICIENT_BUFFER then //如果成功 
         begin 
             GetMem(lpEntryInfo, dwEntrySize); {分配dwEntrySize字节的内存} 
             if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then 
                DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); 
             FreeMem(lpEntryInfo); 
         end; 
      until (dwLastError = ERROR_NO_MORE_ITEMS); 
except 
      abort; 
end; 
end; 

//补充函数

type   
       TSTATURL    =    record   
           cbSize:    DWORD;   
           pwcsUrl:    DWORD;   
           pwcsTitle:    DWORD;   
           ftLastVisited:    FILETIME;   
           ftLastUpdated:    FILETIME;   
           ftExpires:    FILETIME;   
           dwFlags:    DWORD;   
       end;   
    
   type   
       IEnumSTATURL    =    interface(IUnknown)   
           ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']   
           function    Next(celt:    Integer;    out    elt;    pceltFetched:    PLongint):    HRESULT;    stdcall;   
           function    Skip(celt:    Longint):    HRESULT;    stdcall;   
           function    Reset:    HResult;    stdcall;   
           function    Clone(out    ppenum:    IEnumSTATURL):    HResult;    stdcall;   
           function    SetFilter(poszFilter:    PWideChar;    dwFlags:    DWORD):    HResult;    stdcall;   
       end;   
    
   type   
       IUrlHistoryStg    =    interface(IUnknown)   
           ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']   
           function    AddUrl(pocsUrl:    PWideChar;    pocsTitle:    PWideChar;    dwFlags:    Integer):    HResult;    stdcall;   
           function    DeleteUrl(pocsUrl:    PWideChar;    dwFlags:    Integer):    HResult;    stdcall;   
           function    QueryUrl(pocsUrl:    PWideChar;    dwFlags:    Integer;    var    lpSTATURL:    TSTATURL):    HResult;    stdcall;   
           function    BindToObject(pocsUrl:    PWideChar;    var    riid:    TGUID;    out    ppvOut:    Pointer):    HResult;    stdcall;   
           function    EnumUrls(out    ppenum:    IEnumSTATURL):    HResult;    stdcall;   
       end;   
    
   type   
       IUrlHistoryStg2    =    interface(IUrlHistoryStg)   
           ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']   
           function    AddUrlAndNotify(pocsUrl:    PWideChar;    pocsTitle:    PWideChar;    dwFlags:    Integer;   
               fWriteHistory:    Integer;    var    poctNotify:    Pointer;   
               const    punkISFolder:    IUnknown):    HResult;    stdcall;   
           function    ClearHistory:    HResult;    stdcall;   
       end;   
    
function ClearIEHistory:integer;   
   const   
           CLSID_CUrlHistory:    TGUID    =    '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';   
   var   
       IEHistory:IUrlHistoryStg2;   
   begin   
       IEHistory:=CreateComObject(CLSID_CUrlHistory)    as    IUrlHistoryStg2;
       IEHistory.ClearHistory;   
   end;   


procedure TForm1.Button1Click(Sender: TObject); 
begin 
       try 
          DelRegCache;//清理注册表 
          DelCookie;         //删除cookies(ie缓冲文件夹下面cookies文件） 
          DelHistory;        //删除历史记录(ie缓冲文件夹下所有文件）
       //C:\Documents and Settings\用户名\Local Settings\Temporary Internet Files 
          ClearIEHistory; //补充删除网页历史
       except 
            abort; 
       end; 
end;