清楚cookies的问题

Question

请问高手如何写一段能定时清除系统cookies的代码啊？谢谢。delphi webbrowser中

Answer 1

删除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;