admin 管理员组

文章数量: 1184232

网上很多都有删除IE下拉框记录的代码,但是真正删除IE历史记录的代码我还没发现。
所以就写了下面的代码,不过清除完之后要重新启动计算机。有什么不明白请留言。

unit clear;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TClearForm = class(TForm)
clear: TButton;
procedure clearClick(Sender: TObject);
private
{ Private declarations }
public
procedure Win98Delete(FileName:string);
Procedure CompleteDelete(SrcFileName:string);
procedure KillFile;
{ Public declarations }
end;

var
ClearForm: TClearForm;

implementation

{$R *.dfm}
procedure TClearForm.Win98Delete(FileName:string);  //WINDOWS98下删除正在使用的文件
var
Wininit:string;
Buffer:array[0..MAX_PATH] of char;
I,J :integer;
ini:TStringList;
begin
FillChar(Buffer,SizeOf(Buffer),0);
GetWindowsDirectory(Buffer,SizeOf(Buffer));
Wininit :=IncludeTrailingBackslash(Buffer)+'Wininit.ini';
Ini :=TstringList.Create;
try
if FileExists(Wininit) then Ini.LoadFromFile(Wininit);
for I := 0 to Ini.Count-1 do Ini[i] := UpperCase(Ini[I]);
J:=Ini.IndexOf('[Rename]');
if J = -1 Then
begin
Ini.Add('[Rename]');
J := 0
end;
FillChar(Buffer,SizeOf(Buffer),0);
GetShortPathName(Pchar(FileName),Buffer,SizeOf(Buffer));
Ini.Insert(J+1,'NUL='+Buffer);
Ini.SaveToFile(Wininit);
finally
Ini.Free;
end;
end;

Procedure TClearForm.CompleteDelete(SrcFileName:string);//删除正在使用的文件
var
osVerInfo:TOSVersionInfo;
begin
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if (GetVersionEx(osVerInfo)) then
begin
if osVerInfo.dwPlatformId =VER_PLATFORM_WIN32_NT then   //WINDOWS2000或WINDOWS NT
MoveFileEx(pansichar(SrcFileName ),nil,MOVEFILE_DELAY_UNTIL_REBOOT)
else if  osVerInfo.dwPlatformId =VER_PLATFORM_WIN32_WINDOWS  then
Win98Delete(SrcFileName) //WINDOWS 98

else
exit;
end;
end;

procedure TClearForm.KillFile;
var
Sr : TSearchRec;
ERR:integer;
CurrentDir,FilePath : string;
begin
Err := FindFirst('*.*',faAnyfile,Sr);
while (Err =0 ) do
begin
Application.ProcessMessages;
if (sr.Attr and faDirectory) =0 then
begin
FilePath := ExpandFileName(Sr.Name);
CompleteDelete(FilePath);
end;
if (sr.Attr and faDirectory <>0)  and (sr.Name[1]<>'.') then
begin

ChDir(sr.Name);
Getdir(0,CurrentDir);
KillFile;//递归
CompleteDelete(CurrentDir);
ChDir('..');
end;
Err := FindNext(sr);
end;
FindClose(sr);
end;

procedure TClearForm.clearClick(Sender: TObject);
begin
ChDIR('C:/Documents and Settings/Administrator/Local Settings/History/history.ie5');
//随着你计算机的帐户的不同而改变,别跟我学哦!

KillFile;
showmessage('清除成功');
end;

end.

本文标签: 历史 打造全新 编程