unit uWebCracker;
interface
uses mshtml,SHdocvw,classes,SysUtils,StrUtils;
const
MAXPAGECOUNT=20;
type
TWebPageRecord=record
URL:string;
Title:string;
Text:string;
end;
type
TWebCracker=class(TObject)
private
FWebPageRecordArray:array[0..MAXPAGECOUNT-1] of TWebPageRecord;
FWebPageCount:integer;
public
constructor Create;
destructor Free;
procedure SnapShot;
function GetWebText(AIndex:integer):string;
function GetWebTitle(AIndex:integer):sttring;
function GetWebURL(AIndex:integer):string;
procedure Clear;
procedure Refresh;
function GetWebPageCount:integer;
end;
implementation
constructor TWebCracker.Create;
begin
inherited Create;
FWebPageCount:=0;
end;
destructor TWebCracker.Free;
begin
clear;
inherited Free;
end;
procedure TWebCracker.SnapShot;
const
ERRORNOTLOADCOMPLETE='可能打开的网页还没有完全加载，请当所有的网页下载完后再刷新！'
var
ShellWindow:IShellWindow;
WebBrowser:IWebBrower2;
I,ShellWindowCount:integer;
HTMLDocument:IHTMLDocument2;
URL:string;
WebPageRecord:TWebPageRecord;
begin
FWebPageCount :=0;
ShellWindow:=CoShellWindow.Create;
ShellWindowCount :=ShellWindow.Create;
if ShellWindowCount>MAXPAGECOUNT then
ShellWindowCount:=MAXPAGECOUNT;
for i:=0 to ShellWindowCount-1 do
begin
WebBrowser:=ShellWindow.Item(I) as IWebBrowser2;
URL:=WebBrowser.LocationURL;
if (WebBrowser<>nil) and (not IsLocationFile(URL)) then
begin
try
HTMLDocument :=WebBrowser.Document as IHTMLDocument2;
WebPageRecord.URL :=URL;
WebPageRecord.Title :=HTMLDocument.title;
WebPageRecord.Text :=HTMLDocument.body.outerText;
FWebPageRecordArray[I] :=WebPageRecord;
Inc(FWebPageCount);
except
on Exception do
raise Exception.Create(ERRORNOTLOADCOMPLETE);
end;
end;
ShellWindow :=nil;
end;
end;
function TWebCracker.GetWebText(AIndex:integer):string;
begin
Result :=FWebPageRecordArray[AIndex].Text;
end;
function TWebCracker.GetWebTitle(AIndex:integer):string;
begin
Result :=FWebPageRecordArray[AIndex].Title;
end;
function TWebCracker.GetWebURL(AIndex:integer):string;
begin
Result :=FWebPageRecordArray[AIndex].URL;
end;
procedureTWebCracker.Clear;
begin
FWebPageCount :=0;
end;
procedureTWebCracker.Refresh;
begin
self.Snapshot;
end;
functionTWebCracker.GetWebPageCount:integer;
begin
Result :=FWebPageCount;
end;
