全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:2225
推到 Plurk!
推到 Facebook!

某些網址讓 IHTMLDocument2.readyState 狀態永不 Complete 問題

缺席
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#1 引用回覆 回覆 發表時間:2006-11-24 11:35:51 IP:219.87.xxx.xxx 訂閱
某些網址讓 IHTMLDocument2.readyState 狀態永不 Complete 問題
http://www.google.com.tw/index.html 成功
http://www.seed.net.tw/index.htm 失敗
IHTMLDocument2.readyState 狀態永遠不 Complete, Why ?
<textarea class="delphi" rows="10" cols="60" name="code"> unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; IdHTTP: TIdHTTP; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses mshtml, ActiveX, COMObj, idURI; procedure GetImageLinks(AURL: string; AList: TStrings); var IDoc: IHTMLDocument2; strHTML: string; v: Variant; x: Integer; ovLinks: OleVariant; DocURL: string; URI: TidURI; ImgURL: string; idHTTP: TidHTTP; begin AList.Clear; URI := TidURI.Create(AURL); try DocURL := 'http://' URI.Host; if URI.Path <> '/' then DocURL := DocURL URI.Path; finally URI.Free; end; Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2; try IDoc.designMode := 'on'; while IDoc.readyState <> 'complete' do Application.ProcessMessages; v := VarArrayCreate([0, 0], VarVariant); idHTTP := TidHTTP.Create(nil); try strHTML := idHTTP.Get(AURL); finally idHTTP.Free; end; v[0] := strHTML; IDoc.Write(PSafeArray(System.TVarData(v).VArray)); IDoc.designMode := 'off'; while IDoc.readyState <> 'complete' do Application.ProcessMessages; ovLinks := IDoc.all.tags('IMG'); if ovLinks.Length > 0 then begin for x := 0 to ovLinks.Length - 1 do begin ImgURL := ovLinks.Item(x).src; // The stuff below will probably need a little tweaking // Deteriming and turning realtive URLs into absolute URLs // is not that difficult but this is all I could come up with // in such a short notice. if (ImgURL[1] = '/') then begin // more than likely a relative URL so // append the DocURL ImgURL := DocURL ImgUrl; end else begin if (Copy(ImgURL, 1, 11) = 'about:blank') then begin ImgURL := DocURL Copy(ImgUrl, 12, Length(ImgURL)); end; end; AList.Add(ImgURL); end; end; finally IDoc := nil; end; end; procedure TForm1.Button1Click(Sender: TObject); begin IdHTTP.HandleRedirects:=true; // GetImageLinks('http://www.seed.net.tw/', Memo1.Lines); // 失敗 // GetImageLinks('http://www.google.com.tw/index.html', Memo1.Lines); // 成功 GetImageLinks('http://www.seed.net.tw/index.htm', Memo1.Lines); // 失敗, Why ? Memo1.Lines.Add('Ok!'); end; end. </textarea>
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#2 引用回覆 回覆 發表時間:2007-04-19 12:08:08 IP:61.220.xxx.xxx 訂閱
 請問現在有人能解決了嗎 ? THX
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
yufeiying
一般會員


發表:0
回覆:6
積分:1
註冊:2004-06-24

發送簡訊給我
#3 引用回覆 回覆 發表時間:2007-05-05 18:35:36 IP:58.48.xxx.xxx 訂閱
是哪里挂死了?是 readyState还是 strHTML := idHTTP.Get(AURL); 这句?另外,你的代码里面有两处判断redyState的地方,请问是哪句出现问题的?有没有下过断点跟踪看看?
系統時間:2024-04-29 16:16:22
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!