ＨＴＭＬソースを取得するには？ (ID：29093)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

var
  URL,TITLE : array of String;
  Count,MaxCount : Integer;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
 const pDisp: IDispatch; var URL2: OleVariant);
var
 StringList : TStringList;
 I,I2,J1,J2,J3,J5,Index : Integer;
 S,S1 : String;
 F0,F1 : Boolean;
begin
 StringList := TStringList.Create;
 StringList.Text:=WebBrowser1.OleObject.Document.documentElement.OuterHTML;
 Count := 0;
 for I:=0 to StringList.Count -1 do
 begin
 Index := 1;
 S := StringList[I];
 F0 := False;
 while F0 = False do
 begin
 F0 := True;
 J1 := PosEx('<H2 class=r>',S,Index);
 if J1 <> 0 then
 begin
 J2 := PosEX('href="',S,J1+12);
 if J2 <> 0 then
 begin
 J3 := PosEx('">',S,J2+6);
 if J3 <> 0 then
 begin
 SetLength(URL,Count+1);
 S1 := Copy(S,J2+6,J3-J2-6);//URL 取得
 //同一のURLが登録されているか確認
 F1 := False;
 for I2 := 0 to Count-1 do
 begin
 if URL[I2] = S1 then F1 := True;
 end;
 //同一のURLが登録されていない場合
 if F1 = False then
 begin
 URL[Count] := S1;
 J5 := PosEx('</A>',S,J3+2);
 if J5 <> 0 then
 begin
 //TITLE登録
 SetLength(TITLE,MaxCount+1);
 TITLE[Count] := Copy(S,J3+2,J5-J3-2); //TITLE取得
 //TITLEから と を 削除
 J1 := Pos('',TITLE[Count]);
 while J1 <> 0 do
 begin
 if J1<> 0 then
 begin
 TITLE[Count] := Copy(TITLE[Count],0,J1-1) + Copy(TITLE[Count],J1+3,Length(TITLE[Count])-J1-2);
 J1 := Pos('',TITLE[Count]);
 if J1 <> 0 then
 begin
 TITLE[Count] := Copy(TITLE[Count],0,J1-1) + Copy(TITLE[Count],J1+4,Length(TITLE[Count])-J1-3);
 end;
 end;
 J1 := Pos('',TITLE[Count]);
 end;
 Index := J5;
 F0 := False;
 end;
 Inc(Count);
 if MaxCount < Count then MaxCount := Count;
 end;
 end;
 end;
 end;
 end;
 end;
 StringList.Free;
end;

←解決時は質問者本人がここをチェックしてください。

戻る