delphi删除cookie和ie缓存


procedure DelRegCache;
var
 reg:TRegistry;
begin
 reg:=Tregistry.create;
 reg.RootKey:=HKEY_CURRENT_USER;
 reg.DeleteKey('SoftwareMicrosoftInternet ExplorerTypedURLs');
 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 DelCookie1;
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;  //清理注册表
 DelCookie1;  //删除cookies(ie缓冲文件夹下面的cookies文件)
 DelHistory;  //删除历史记录(ie缓冲文件夹下所有文件)
 ClearIEHistory;//补充删除网页历史
 except
 abort;
 end;
end;

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678