会员: 密码:  免费注册 | 忘记密码 | 会员登录 网页功能: 加入收藏 设为首页 网站搜索  
技术文档 > Delphi
清除IE历史记录
发表日期:2003-05-28 00:00:00作者: 出处:  

清除Internet Explorer临时文件 在TfrmMain你必须引用WinINet单元 Uses WinINet; 然后放上一个TButton按钮命名为btnEmptyCache,加入以下代码:

 Procedure TfrmMain.btnEmptyCacheClick( Sender : TObject );

  Var

  lpEntryInfo : PInternetCacheEntryInfo;

  hCacheDir : LongWord;

  dwEntrySize : LongWord;

  dwLastError : LongWord;

  Begin

  dwEntrySize := 0;

  FindFirstUrlCacheEntry(NIL,TInternetCacheEntryInfoNIL^ ),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 ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) Then Begin

 GetMem( lpEntryInfo, dwEntrySize );

 If ( FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^,

dwEntrySize ) ) Then

 DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );

 FreeMem(lpEntryInfo);

 End;

 Until ( dwLastError = ERROR_NO_MORE_ITEMS );

 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

 ClearIEHistory;

end;

**********************

uses wininet;

procedure TForm1.Button1Click(Sender: TObject);

var

 cache_info:PInternetCacheEntryInfo;

 cbSizeOf_Cache_info:dword;

 hw:hwnd;

 buf:tstrings;

begin

// buf:=tstringlist.Create;

 new(cache_info);

 hw:=FindFirstUrlCacheEntryEx(nil,0,NORMAL_CACHE_ENTRY or URLHISTORY_CACHE_ENTRY,0,cache_info,@cbSizeOf_Cache_info,nil,nil,nil);

 if hw<>0 then

 begin

  DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

//  buf.Add(cache_info.lpszSourceUrlName);

  while FindNextUrlCacheEntryEx(hw,cache_info,@cbSizeOf_Cache_info,nil,nil,nil) do

//   buf.Add(cache_info.lpszSourceUrlName);

   DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

 end;

 FindCloseUrlCache(hw);

 dispose(cache_info);

// showmessage(buf.Text);

// buf.Free;

end;

返回顶部】 【打印本页】 【关闭窗口

关于我们 / 给我留言 / 版权举报 / 意见建议 / 网站编程QQ群   
Copyright ©2003- 2024 Lihuasoft.net webmaster(at)lihuasoft.net 加载时间 0.00361