梅毒二期龟头症状图片:删除cookies及上网历史记录

来源:百度文库 编辑:偶看新闻 时间:2024/05/03 09:57:14

unit uDelCache;

interface
uses Registry,ShellApi, WinInet,ShlObj,ComObj, Forms, Windows, SysUtils;


  procedure DelHistory;//删除历史记录(ie缓冲文件夹下所有文件)
  procedure DelRegCache; //清理注册表
  procedure DelHistory;//删除历史记录(ie缓冲文件夹下所有文件)
  function ClearIEHistory:integer;//补充删除网页历史

//  procedure TForm1.Button1Click(Sender: TObject);
//begin
//  try
//  DelRegCache;//清理注册表
//  DelCookie; //删除cookies(ie缓冲文件夹下面cookies文件)
//  DelHistory; //删除历史记录(ie缓冲文件夹下所有文件)
//  //C:\Documents and Settings\用户名\Local Settings\Temporary Internet Files
//  ClearIEHistory; //补充删除网页历史
//  except
//  abort;
//  end;
//end;

implementation
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
  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 DelCookie;
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;


end.