主页 > 编程资料 > Delphi >
发布时间:2015-09-22 作者:网络 阅读:87次

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;

关键字词: