分享

清空IE缓存

 昵称33199310 2016-05-11
uses mshtml,comobj,Registry,ShellApi, WinInet,ShlObj;

procedure DelRegCache;
var
       reg:TRegistry;
begin
       reg:=Tregistry.create;
       reg.RootKey:=HKEY_CURRENT_USER;
      // reg.OpenKey('AAA\BBB\CCC', False);
       reg.DeleteKey('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+#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;

//上面是清空IE
 function GetHtmlTableCell(aTable: IHTMLTable; aRow, aCol: Integer): IHTMLElement;
var
  Row: IHTMLTableRow;

begin
  Result := nil;
  if aTable = nil then Exit;
  if aTable.rows = nil then Exit;
  Row := aTable.rows.item(aRow, aRow) as IHTMLTableRow;
  if Row = nil then Exit;
  Result := Row.cells.item(aCol, aCol) as IHTMLElement;
end;

function GetHtmlTable(aDoc: IHTMLDocument2; aIndex: Integer): IHTMLTable;
var
  list: IHTMLElementCollection;
begin
  Result := nil;
  if aDoc = nil then Exit;
  if aDoc.all = nil then Exit;
  list := aDoc.all.tags('table') as IHTMLElementCollection;
  if list = nil then Exit;
  Result := list.item(aIndex,aIndex) as IHTMLTable;
end;

function GetWebBrowserHtmlTableCellText(const AWebBrowser: TWebBrowser;
  const TableIndex, RowIndex, ColIndex: Integer;
  var ResValue: string): Boolean;
var
  Docintf: IHTMLDocument2;
  tblintf: IHTMLTable;
  node: IHTMLElement;
begin
  ResValue := '';
  docintf := AWebBrowser.Document as IHTMLDocument2;
  tblintf := GetHtmlTable(docintf, TableIndex);
  node := GetHtmlTableCell(tblintf, RowIndex, ColIndex);
  Result := node <> nil;
  if Result then
    ResValue := Trim(node.innerText);
end;

function GetHtmlTableRowHtml(aTable: IHTMLTable; aRow: Integer): IHTMLElement;
var
  Row: IHTMLTableRow;
begin
  Result := nil;
  if aTable = nil then Exit;
  if aTable.rows = nil then Exit;
  Row := aTable.rows.item(aRow, aRow) as IHTMLTableRow;
  if Row = nil then Exit;
  Result := Row as IHTMLElement;
end;

function GetWebBrowserHtmlTableCellHtml(const AWebBrowser: TWebBrowser;
  const TableIndex, RowIndex, ColIndex: Integer;
  var ResValue: string): Boolean;
var
  Docintf: IHTMLDocument2;
  tblintf: IHTMLTable;
  node: IHTMLElement;
begin
  ResValue := '';
  docintf := AWebBrowser.Document as IHTMLDocument2;
  tblintf := GetHtmlTable(docintf, TableIndex);
  node := GetHtmlTableCell(tblintf, RowIndex, ColIndex);
  Result := node <> nil;
  if Result then
    ResValue := Trim(node.innerHTML);
end;


function GeHtmlTableHtml(aTable: IHTMLTable; aRow: Integer): IHTMLElement;
var
  Row: IHTMLTableRow;
begin
  Result := nil;
  if aTable = nil then Exit;
  if aTable.rows = nil then Exit;
  Row := aTable.rows.item(aRow, aRow) as IHTMLTableRow;
  if Row = nil then Exit;
  Result := Row as IHTMLElement;
end;

function GetWebBrowserHtmlTableHtml(const AWebBrowser: TWebBrowser;
  const TableIndex, RowIndex: Integer;
  var ResValue: string): Boolean;
var
  Docintf: IHTMLDocument2;
  tblintf: IHTMLTable;
  node: IHTMLElement;
begin
  ResValue := '';
  docintf := AWebBrowser.Document as IHTMLDocument2;
  tblintf := GetHtmlTable(docintf, TableIndex);
  node := GeHtmlTableHtml(tblintf, RowIndex);
  Result := node <> nil;
  if Result then
    ResValue := node.innerHtml;
end;

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

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多