怎么用Delphi写清除IE的上网历史记录？

超级猛料清除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;

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, comobj;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}
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;end.

再來一個試試：
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Activex, Comobj, StdCtrls;
const
// GUID 定义：
  IID_IEnumStatUrl :    TGUID='{3C374A42-BAE4-11CF-BF7D-00AA006946EE}';
  IID_IUrlHistoryStg:   TGUID='{3C374A41-BAE4-11CF-BF7D-00AA006946EE}';
  IID_IUrlHistoryStg2:  TGUID='{AFA0DC11-C313-11d0-831A-00C04FD5AE38}';
  IID_IURLHistoryNotify:TGUID='{BC40BEC1-C493-11d0-831B-00C04FD5AE38}';  CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';type
// TSTATURL 数据结构：
  PSTATURL=^TSTATURL;
  STATURL = record
    cbSize: DWORD;             // 结构的大小
    pwcsUrl: Pointer;          // URL 是 PWideChar ，原贴定义为 DWord
    pwcsTitle: Pointer;        // History 标题,原贴定义为 DWord
    ftLastVisited: FILETIME;
    ftLastUpdated: FILETIME;
    ftExpires: FILETIME;
    dwFlags: DWORD;
  end;
  TSTATURL=STATURL;  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;  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:
                                                     STATURL): HResult; stdcall;
    function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut:
                                                     Pointer): HResult; stdcall;
    function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
  end;  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;  IUrlHistoryNotify = interface(IOleCommandTarget)
    ['{BC40BEC1-C493-11d0-831B-00C04FD5AE38}']
  end;type
  TForm1 = class(TForm)
    Button1: TButton; // Caption:='清除历史记录'
    procedure Button1Click(Sender: TObject);
  end;var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject); // 清除历史记录
var
UrlHistory: IUrlHistoryStg2;
Enum:IEnumSTATURL;
urlSTATURL:TSTATURL;
fetched:Longint;
P:PWideChar;
begin
// 初始化 STATURL 数据结构
ZeroMemory(@urlSTATURL,SizeOf(TSTATURL));// 创建 IUrlHistoryStg2 实例
if CoCreateInstance(CLSID_CUrlHistory,nil,
          CLSCTX_INPROC_SERVER,
          IID_IUrlHistoryStg2,
          UrlHistory)=1 then
  begin
   MessageBox(0,'IUrlHistoryStg2 没有创建','',MB_OK);
   exit;
  end;// 获得枚举接口 -> IEnumSTATURL
   if UrlHistory.EnumUrls(Enum)=1 then
      MessageBox(0,'IEnumSTATURL 接口没有找到','',MB_OK);// 找到一个，删除一个
   while Enum.Next(1,urlSTATURL,@fetched)<>1 do
    begin
     P:=urlSTATURL.pwcsUrl;
     if UrlHistory.DeleteUrl(P,0)=1 then
       begin
        MessageBox(0,'删除出错','',MB_OK);
        Break;
       end;
    end;
end;
end.
===============================================================================
这个枚举接口的使用有很典型的意义，在 MS 的 COM 对象中，有很多都定义了枚举内部元
素的接口，一般都有 Next 方法，具体的使用就是上面的样子。原贴中想用 IUrlHistoryStg2
的 ClearHistory 方法一劳永逸地清除掉历史记录，目前还没有被 MS 支持。

直接手動刪除也可以呀！！！
在dos下进入C:\Documents and Settings\用户名\Local Settings\History
目录,dir/a可看到desktop.ini和History.IE5文件。它们都是系统和隐藏文件,用attrib -s -s可
在win2000S下直接打開就可以刪除掉

调试易

怎么用Delphi写清除IE的上网历史记录？

解决方案 »