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

删除cookies及上网历史记录(DELPHI代码完整版本)2010-12-26 10:26//前面要加几个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;

 

 

 

 

//--------------------------------------------------------------------------------//
Function getPage(URL:string):string;
var
  xmlHttp: OLEVariant;
begin
  try
    DeleteUrlCacheEntry(PChar(Url));
    xmlHttp:=CreateOleObject('Msxml2.XMLHTTP');
    xmlHttp.open('GET',URL,false);
    xmlHttp.send();
    result:=xmlHttp.responseText;
    If xmlHttp.ReadyState <> 4 Then
    begin
    exit;
    end;
  except
  end;
end;
//--------------------------------------------------------------------------------//
//uses  WinInet,ComObj;

procedure DeleteIECache(httpStr: string); // 清理IE缓存,IE.cookies
var
lpEntryInfo: PInternetCacheEntryInfo;  
hCacheDir: LongWord;  
dwEntrySize: LongWord;  
cachefile: string;  
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);  
GetMem(lpEntryInfo, dwEntrySize);  
if dwEntrySize > 0 then
    lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
    repeat
      if (lpEntryInfo^.CacheEntryType) and (NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY then
        cachefile := pchar(lpEntryInfo^.lpszSourceUrlName);
      if pos(httpStr, cachefile) > 0 then    //清除特定网站的cookies.例如baidu.com
        DeleteUrlCacheEntry(pchar(cachefile)); //执行删除操作  
      FreeMem(lpEntryInfo, dwEntrySize);
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);  
      GetMem(lpEntryInfo, dwEntrySize);  
      if dwEntrySize > 0 then
        lpEntryInfo^.dwStructSize := dwEntrySize;  
    until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);  
end;  
FreeMem(lpEntryInfo, dwEntrySize);  
FindCloseUrlCache(hCacheDir);  
end;