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