★★★ 有什么办法能真正的清空IE的历史记录?另可开贴再加400分。 ★★★ (200分)

不会吧，那个楼主说行的，不过试过。

http://www.karenware.com/powertools/ptcookie.asp
这里有个，是vb编的

up

up

///在uses部分加上comobj

//////////////////////历史记录清除/////////////////////////////////////
type //自定义结构体，对应IE的 COM 接口
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 ppvOutointer): 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.ButtonClick(Sender: TObject); //历史记录清除
begin
try
ClearIEHistory;
showmessage('历史记录清空完毕!');
except
showmessage('历史记录无法清空，请重启后再试!');
end;
end;

to浮生:
win2000下试过代码，执行显示'历史记录清空完毕!',到history目录，历史记录都还在，没有清除。

明天给你贴上吧，我在书店专门找的。

to YFeral:
谢谢，希望马上看到，最好win2000和xp下能起作用。

var
Pidl: PItemIDList;
buffer: array [0..255] of char;
cookieDir,
sFileName: string;


FOS: TSHFileOPStruct;

Dir: string;

ipEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize, dwLastError: LongWord;
isZero: boolean;
begin
//*********************
//清空IE列表的内容，略
//*********************
//取目录, CSIDL_COOKIES 表示Cookie目录。
SHGetSpecialFolderLocation(Application.Handle, CSIDL_COOKIES, Pidl);
//转换成系统目录。
SHGetPathFromIDList(Pidl, buffer);
cookieDir := StrPas(buffer);

//**********************************************************
FillChar(FOS, SizeOf(FOS), 0);
{ FOS.wFunc := FO_DELETE;
FOS.pFrom := Pchar(sFileName);
FOS.fFlags := FOF_NOCONFIRMATION;
}with FOS do
begin

wFunc := FO_DELETE;
pFrom := Pchar(sFileName);
fFlags := FOF_NOCONFIRMATION;
end;

// i := SHFileOperation(FOS);
isZero := (SHFileOperation(FOS) = 0);
//**********************************************************
//清空Cookie
//关闭IE的Session，停止Cookie会话。
InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);
// cookieDir := GetCookiesFolder;
DeleteFile(cookieDir + '/*.txt');
//**********************************************************
// 清除历史记录。
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(ipEntryInfo, SizeOf(ipEntryInfo));
hCacheDir := FindFirstUrlCacheEntry(nil, ipEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
DeleteUrlCacheEntry(ipEntryInfo.lpszSourceUrlName);
FreeMem(ipEntryInfo);
repeat
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^),
dwEntrySize);
dwLastError := GetlastError;
if dwLastError = ERROR_INSUFFICIENT_BUFFER then
begin
GetMem(ipEntryInfo, dwEntrySize);
if FindNextUrlCacheEntry(hCacheDir, ipEntryInfo^, dwEntrySize) then
DeleteUrlCacheEntry(ipEntryInfo.lpszSourceUrlName);
FreeMem(ipEntryInfo);
end;
until (dwLastError = ERROR_NO_MORE_ITEMS);
ShowMessage('成功清除！');
end;

//抱歉啊，我看了看它这代码也不管用啊。等有机会我再看看吧。

注意单元文件为：
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi, ShlObj, WinInet, FileCtrl, Registry;

to YFeral:
谢谢，但在win2000下测试,还是没作用 ：（

估计要先终止某个系统进程

to AI_Player:
就是不知是哪个进程。

是进程explorer.exe ：（

上边哪个程序的完整代码，看了看还不行。
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi, ShlObj, WinInet, Registry;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

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

//取目录, CSIDL_COOKIES 表示Cookie目录。
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;

procedure DelCookie;
var
Dir: string;
begin
//清空Cookie
//关闭IE的Session，停止Cookie会话。
InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);
Dir := GetCookiesFolder;
ShellDeleteFile(Dir + '/*.txt');
end;

procedure DelHistory;
var
ipEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize, dwLastError: LongWord;
begin
//**********************************************************
// 清除历史记录。
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(ipEntryInfo, SizeOf(ipEntryInfo));
hCacheDir := FindFirstUrlCacheEntry(nil, ipEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
DeleteUrlCacheEntry(ipEntryInfo.lpszSourceUrlName);
FreeMem(ipEntryInfo);
repeat
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^),
dwEntrySize);
dwLastError := GetlastError;
if dwLastError = ERROR_INSUFFICIENT_BUFFER then
begin
GetMem(ipEntryInfo, dwEntrySize);
if FindNextUrlCacheEntry(hCacheDir, ipEntryInfo^, dwEntrySize) then
DeleteUrlCacheEntry(ipEntryInfo.lpszSourceUrlName);
FreeMem(ipEntryInfo);
end;
until (dwLastError = ERROR_NO_MORE_ITEMS);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
DelRegCache;
DelCookie;
DelHistory;
finally
Screen.Cursor := crDefault;
end;
ShowMessage('删除成功!');
end;

end.

感谢YFeral，可还是不行。大富翁那么多高手，1个月了，竟然没人能给出解决的代码 ：（

gz

没办法，以前的人们都是浅尝辙止。

能否给我可用的代码
wqt0318@sohu.com

to yesky_2008:
我用你的代码可以清除历史记录阿？为什么你老说不行？
我的是XP，98、2000也试过了，都可以阿
你说的index.dat还有，但是他的内容已经是空的了