刚学delphi时练笔写的,很乱,呵呵~~~ 不过可能对你有用:
procedure TForm1.actGetLinksExecute(Sender: TObject);
var
i,count:longint;
Doc:IHTMLDocument2;
clnLinks: IHTMLElementCollection;
emtAnchor: IHTMLAnchorElement;
strAnchor: string;
s:string[120];
tmFileCreateTime,tmFilemodifyTime,tmFileUpdateTime: widestring;
clnHtmlEment:IHTMLElement;
//IsSearch:boolean;
//lResponseCode1,lResponseCode2:longword;
now: cardinal; //当前时间（机器启动到当前所经过的毫秒数）；
//wbNew:TWebBrowser; //用它来获得每个超链接指向的网站的更新时间
DocNew:IHTMLDocument2;
label lbTimeOut;
begin
//******************************************************************************
//* 首先是用IHTMLDocument2的links属性，来获取IHTMLElementCollection接口， *
//* 再通过IHTMLElementCollection的item，利用循环就可以得到网页的所有链接了. *
//* 另外，我想通过获取网页源码，然后用字符串搜索的方法也可以实现。似乎代码 *
//* 就要长点 。 *
//******************************************************************************
actGetLinks.Enabled:=False;
actGoBack.Enabled:=false;
actGoforword.Enabled:=false;
actstop.Enabled:=false;
actrefresh.Enabled:=false;
actgetkind.Enabled:=false;
dbgrid2.Enabled:=false;
DBgrid2.ReadOnly:=true;
DBGrid2.EditorMode:=false;
now:=gettickcount();
while webbrowser1.ReadyState<>READYSTATE_COMPLETE do //等待服务器响应
begin
sleep(2000);
Application.ProcessMessages;
if gettickcount()-now>6000 then //等待6s,若还未完成则显示提示信息。
begin
sleep(200);
showmessage('超时，请稍后重试！');
actGetLinks.Enabled:=true;
exit;
end; //end 'if gettickcount()-now>30000'
end;//end 'while webbrowser1.ReadyState<>READYSTATE_COMPLETE do'
Doc:=(webbrowser1.Document as ihtmldocument2);
clnlinks:=doc.GET_links;
count:=clnlinks.length;
progressbar1.Min:=0;
progressbar1.Max:=count * 10;
//tmFileCreateTime:=doc.Get_fileCreatedDate; //获得网页创建时间
//tmFilemodifyTime:=doc.Get_fileModifiedDate; //获得网页被修改的时间
//tmFileUpdateTime:=doc.Get_fileUpdatedDate; //获得最后更新时间
try
begin
if count=0 then
begin
showmessage('这个网页没有超链接！');
FreeAndNil(doc);
FreeAndNil(clnlinks);
exit;
end
else
begin
pagecontrol1.ActivePage:= tabsheet2;
//wbNew:=TWebBrowser.Create(self); //创建一个WebBrowser对象。
panel3.Caption:='正在清空已前的记录。。。请稍等。。。';
ADOTable1.First; //开始清空表
while (ADOTable1.Eof=false) do
ADOTable1.Delete;
panel3.Caption:='正在获取超链接。。。这可能需要几分钟，请您梢等。' ;
for i:=0 to count-1 do
begin
emtAnchor:=(clnlinks.item(i,emptyparam) as IHTMLAnchorElement);
strAnchor:= string(trim(emtAnchor.get_href));
if trim(strAnchor)='' then continue;
if length( trim(strAnchor))>119 then
s:=copy(trim(strAnchor),1,119)
else
s:=trim(strAnchor);
if (not ADOTable1.Locate('LinkAdress',s,[loCaseInsensitive])) then //要添加的网址已经存在则不做添加操作
begin
ADOTable1.Append;
ADOtable1.FieldValues['LinkName']:=string(trim((emtAnchor as IHTMLElement).innertext));
ADOtable1.FieldValues['LinkAdress']:=strAnchor;
//------------------------------GetUpdateTime-------------------------------------
wbnew.Navigate(widestring(strAnchor));
now:=gettickcount();
if length(trim(strAnchor))>26 then
panel3.Caption:='正在获取站点"'+ copy(strAnchor,8,16) + '...' + copy(strAnchor,length(strAnchor)-13,14) +'"的最后更新时间，请稍等'
else
panel3.Caption:='正在获取站点"'+strAnchor+'"的最后更新时间，请稍等。';
while wbnew.ReadyState<>READYSTATE_COMPLETE do //等待服务器响应
begin
sleep(100);
Application.ProcessMessages;
if gettickcount()-now>=10000 then //等待超过10S则退出
begin
if length(trim(strAnchor))>26 then
panel3.Caption:='连接站点"' + copy(strAnchor,8,13) + '...' + copy(strAnchor,length(strAnchor)-12,13) +'"超时,无法获得网站最后更新时间。'
else
panel3.Caption:='连接网站'+trim(strAnchor)+'超时,无法获得网站最后更新时间。';
goto lbTimeout;
end;
end;//end 'while wbnew.ReadyState<>READYSTATE_COMPLETE'
// wbNew.QueryStatusWB()
DocNew:=wbNew.Document as IHTMLDocument2;
tmFileUpdateTime:=DocNew.Get_fileUpdatedDate;
//------------------------------------------------------------------------------------
ADOTable1.FieldValues['RefreshTime']:=tmFileUpdateTime;
lbTimeout: ADOTable1.Post;
end; //end 'if not ADOTable1.Locate('LinkAdress',strAnchor,[]) then'
progressbar1.Position:= progressbar1.Position+10;
end;//end 'for i:=0 to count-1 do'
end; //end 'else'
end //end 'try'
finally
// FreeAndNil(wbnew);
freeandnil(Doc);
freeandnil(clnLinks);
freeandnil(emtAnchor);
panel3.Caption:='';
progressbar1.Position:=0;
actGetLinks.Enabled:=true;
actGoBack.Enabled:=true;/////////////////
actGoforword.Enabled:=true;/////////
actstop.Enabled:=true;
actrefresh.Enabled:=true;
actgetkind.Enabled:=true;
end; //end 'finally'
end; //end 'procedure'
procedure TForm1.actStopExecute(Sender: TObject);
begin
webbrowser1.Stop;
end;
