html parse farklı bir yontem.....işin içinden çıkamadım lütf

[dilekdurgun]

buraya kadar hersey normal kod calisiyor . fakat bu kodu cok frame li bir sayfa da kullanmaya kalktigimda [ interface not supported] hatasi ile karsilasiyorum. forum daki butun parse ve html+parse ile ilgili olan tum sayfalari gezdim . kafam iyice bulandi lütfen yardim edin.....

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,mshtml, StdCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure WBLocateHighlight(WB: TWebBrowser; Text: string) ;
const
   prefix = '<span style="color:white; background-color: red;">';
   suffix = '</span>';
var
   tr: IHTMLTxtRange;
begin
   if Assigned(WB.Document) then
   begin
     tr := ((wb.Document AS IHTMLDocument2).body AS IHTMLBodyElement).createTextRange;
     while tr.findText(Text, 1, 0) do
     begin
       tr.pasteHTML(prefix + tr.htmlText + suffix) ;
       tr.scrollIntoView(True) ;
     end;
   end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
webbrowser1.Navigate('http://www.google.com.tr/');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WBLocateHighlight(WebBrowser1,'google') ;
end;

end.
 

[t-hex]

Frame olarak açılan ilk sayfada hiç body tagi olmadığı için yaptığın IHtmlBodyElement cast'i geçersiz oluyor. Öncelikler IHtmlDocument2 arayüzünün frames özelliğini sorgulayıp frame olup olmadığına bakman lazım. Eğer var ise

IHtmlFramesCollection2 arayüzünü kullanıp item'dan window çekip ordan da dokümanları tek tek işlemen lazım.

Hata almamak için IHtmlBodyElement arayüzüne cast yapmadan önce QueryInterface ile implemente edilip edilmediğini kontrol et.

Kolay gelsin.

[dilekdurgun]

yukaridaki code ekleme yaparak bunu denedim

Kod: Tümünü seç

procedure IterateFrames(const AWB: IWebBrowser2);
  var
    Doc: IHTMLDocument2;
    Container: IOleContainer;
    Enumerator: ActiveX.IEnumUnknown;
    Unknown: IUnknown;
    Browser: IWebBrowser2;
    Fetched: Longint;
  begin
    if (Assigned(AWB.Document))
       and (Supports(AWB.Document, IHTMLDocument2, Doc))
    then begin
     if (Supports(Doc, IOleContainer, Container))
         and (Container.EnumObjects(OLECONTF_EMBEDDINGS, Enumerator) = S_OK)
      then begin
        while Enumerator.Next(1, Unknown, @Fetched) = S_OK do
          if (Supports(Unknown, IWebBrowser2, Browser))
          then begin
            showmessage(doc.body.outerhtml);
            IterateFrames(browser); 
          end;
      end; 
    end;
  end;

kullanimi

Kod: Tümünü seç

 IterateFrames(WebBrowser1.DefaultInterface);

son hali

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,mshtml, StdCtrls, OleCtrls, SHDocVw, ExtCtrls,ActiveX;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure IterateFrames(const AWB: IWebBrowser2);
  var
    Doc: IHTMLDocument2;
    Container: IOleContainer;
    Enumerator: ActiveX.IEnumUnknown;
    Unknown: IUnknown;
    Browser: IWebBrowser2;
    Fetched: Longint;
  begin
    if (Assigned(AWB.Document))
       and (Supports(AWB.Document, IHTMLDocument2, Doc))
    then begin
     if (Supports(Doc, IOleContainer, Container))
         and (Container.EnumObjects(OLECONTF_EMBEDDINGS, Enumerator) = S_OK)
      then begin
        while Enumerator.Next(1, Unknown, @Fetched) = S_OK do
          if (Supports(Unknown, IWebBrowser2, Browser))
          then begin
            showmessage(doc.body.outerhtml);
            IterateFrames(browser); 
          end;
      end; 
    end;
  end;

procedure WBLocateHighlight(WB: TWebBrowser; Text: string) ;
const
   prefix = '<span style="color:white; background-color: red;">';
   suffix = '</span>';
var
   tr: IHTMLTxtRange;
begin
   if Assigned(WB.Document) then
   begin
     tr := ((wb.Document AS IHTMLDocument2).body AS IHTMLBodyElement).createTextRange;
     while tr.findText(Text, 1, 0) do
     begin
       tr.pasteHTML(prefix + tr.htmlText + suffix) ;
       tr.scrollIntoView(True) ;
     end;
   end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
webbrowser1.Navigate('http://www.google.com.tr/');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 WBLocateHighlight(WebBrowser1,Edit1.Text) ;
 IterateFrames(WebBrowser1.DefaultInterface);
end;

end.

ama sonuç yine ayni ayni hatayi veriyor.... Aklim iyice karisti

[aLonE CoDeR]

Yapmak istediğin şeyi tam olarak bilmediğim için doğaçlama öneride bulunacağım.HTTP bileşeni ile sayfayı get eder ve parse işlemini bu veri üzerinde yaparsan frame sorunuyla karşılaşmazsın.Amacın sadece parse ise bu yöntem çok daha zahmetsiz.Ancak sayfadaki bileşenlere veri girmek ve bununla ilgili işlemler de içeriyorsa t-hex'in de dediği gibi frame sorgusu yapmalısın.Ancak buradaki sorguyu yine parse tekniğiyle yaparsan büyük olasılıkla hata oluşmadan çözüme gidilebilir.

Kolay gele.

[dilekdurgun]

kodlar yukarida aynen gorudgunuz gibi hic bir bilesene veri girisi olmicak sadece benim belirledigim tam kelimeyi ozellikle diyorum sadece o kelimeyi o anki sayfada frame olsun yada olmasin bulmasini istiyorum. bakmadigim adres delphi sitesi kalmadi . ancak bu kadarini yapabildim. aklima daha baska birsey gelmiyor.. sizin soylediginiz yontem nedir nasildir, hangi bilesenleri kullanmam gerek .

[aLonE CoDeR]

HTTP bileşenleri var örneğin indy setindekini kullanabilirsin.Get metoduyla ilgili safyanın kodlarını bir stringe alabilirsin bununla.Akabinden de gerekli parse işlemleri tabi...

Kolay gele..

[mrmarman]

Merhaba..

- T.C.Kimlik başlığında da yazdım ancak burası boş kalmasın diye yineliyorum.

- Frame olan sayfalarda Body aramamalısın ya da Try..Except bloğuna alarak hata kontrolü yapmalısın.

- Verdiğin koddaki gerekli düzeltmeleri / eklemeleri yaptım. Aşağıda veriyorum.

- Frame sayısı 0'dan fazla ise Frame vardır diyoruz ve Frame by Frame dolaşarak arama işlemi yaparak gerekli değişikliği her frame için ayrı ayrı yapıyoruz. Yoksa normal operasyon yapılıyor.

Kod: Tümünü seç

procedure WBLocateHighlight(WB: TWebBrowser; Text: string) ;
const
   prefix = '<span style="color:white; background-color: red;">';
   suffix = '</span>';
var
   tr     : Variant; // IHTMLTxtRange;
   i      : Integer;
begin
   if Assigned(WB.Document) then
   begin
     If WB.OleObject.Document.Frames.length > 0
     then begin // Frame var demektir. Her Frame için ayrı ayrı değerlendirmek lazım...
       For i := 0 to WB.OleObject.Document.Frames.length-1 do begin
         tr := WB.OleObject.Document.Frames.item(i).Document.Body.createTextRange;
         while tr.findText(Text, 1, 0) do
         begin
           tr.pasteHTML(prefix + tr.htmlText + suffix) ;
           tr.scrollIntoView(True) ;
         end;
       end;
     end else begin // Frame yoksa ana body işleme alınır...
       tr := ((wb.Document AS IHTMLDocument2).body AS IHTMLBodyElement).createTextRange;
       while tr.findText(Text, 1, 0) do
       begin
         tr.pasteHTML(prefix + tr.htmlText + suffix) ;
         tr.scrollIntoView(True) ;
       end;
     end;
   end;
end;

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  WBLocateHighlight(WebBrowser1, Edit1.Text) ;
end;

[dilekdurgun]

Sayın muharrem hocam. ilginiz icin cok tesekkur ederim, ama yine olmadi bir turlu frame olan sayfalarda arama yapmiyor... Bu seferde Erişim engellendi diyor .... Bu yontemin haricinde baska bir yontem yokmudur html parse icin . bir de frame olan sayfa phpe biz zaten php yi ie ile yorumlarken html olarak goruyoruz bu yuzden bir sorun olmicaktir. Webbrowser ile parse ederken ... dedigim gibi bu isin baska bir yontemi varmidir..... simdiden tesekkurler....

[mrmarman]

Hocam frame olduğuna emin misiniz ? Sayfanın linkini mesajlarınızdan birinde verirsiniz diye umdum ama hiçbirinde bunu yapmadınız. Suya yazı yazıyoruz burada...

- Frame dediğimiz şey şöyle bişey..

http://www.armantr.com/web/sil/Frame.HTML

- Bu linkte deneme yaptım ve 3 stringini arattırdım çalışıyor.. Sendeki link hangsi ?

[dilekdurgun]

evet frameler aynen oyle yada boylehttp://www.webdevelopersnotes.com/tutor ... ested.html burda calisiyor ama ogame bir kac tane forumda denedim olmuyor sorun sanirim sayfalarin php olmasi ........

[mrmarman]

Şimdi http://s2.gladiatus.net/game/index.php?mod=overview da da denedim yine çalışıyor.. Yapmak istediğinle seni yalnız bırakıyorum.. Benden bu kadar. Hayatta başarılar...

[ovural]

hocam istediginiz yapabildin mi ?

yapamadı isen bi ara code göndereyim yanımda yok su anda ..

bende bi bankanın interaktif sitesine otomatik giriş yapıp belli yerlerden liste cekiyordum kaynak koddan .. gayette güzel calısıyordu ..

[ovural]

Kod: Tümünü seç

function GetFrameDoc(doc: IHTMLDocument2; v: OleVariant): IHTMLDocument2;
var
  win: IHTMLWindow2;
  u: IUnknown;
  ec: IHTMLElementCollection;
begin
  u := doc.frames.item(v);
  if Assigned(u)
  and Succeeded(u.QueryInterface(IHTMLWindow2, win))
    then Result := win.Document
    else Result := nil;
end;

bu kod ile ismini bildigin framelere ulaşabilirsin ..

aşağıda örnek olabilecek kodu verdim

Kod: Tümünü seç

function DocToStrings(doc: IDispatch; s: TStrings): Boolean;
var
  ps: IPersistStreamInit;
  sa: IStream;
  ms: TStream;
begin
  if Succeeded(doc.QueryInterface(IPersistStreamInit, ps)) then
  begin
    ms := TMemoryStream.Create;
    sa := TStreamAdapter.Create(ms, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, true));
    ms.Position := 0;
    s.LoadFromStream(ms);
    ms.Free;
  end;
end;

bunun ilede kaynak koduna ulaşabilirsiniz

Kod: Tümünü seç

var 
idoc : IHTMLDocument2;

begin
If Webbrowser1.OleObject.Document.Frames.length > 0 then
begin
idoc := GetFrameDoc(WebBrowser1.Document as IHTMLDocument2, 'main');
   docToString(Webbrowser1.Document,Memo1.Lines);
end
else
   docToString(Webbrowser1.Document,Memo1.Lines);
end;

bu kodlar işini görebilir tabi birebir olmayabilir kendi projene biraz uydurursun ..

yinede yapamazsan mesaj atarsın bakarız ..

[dilekdurgun]

sorunmu aLonE CoDeR in önerisi ve onun yardımıyla aşağidaki gibi hallettim ..


procedure TForm1.Button1Click(Sender: TObject);
var
SourceCode: String;
begin
SourceCode := IdHTTP1.Get(edit1.Text);
Memo1.Text := SourceCode;
if Pos(edit2.Text, SourceCode) > 0 then
MediaPlayer1.Play;
if Pos(edit2.Text, SourceCode)<1 then
Label2.Caption :=(' YOK');
end ;

[mrmarman]

Tebrik ederim. Çözüldüğüne şahsen sevindim ... Çünkü hala sorunun ne olduğunu merak ediyordum.

- Sorunu doğru anlaığımı sanıyordum ancak verdiğin kod ile yanılmış yanlış anlamış olduğumu fark ettim.

- Kodlarında gördüğüm şuydu. Browse edilen sayfada bir kelime aranıyor ancak bu kelime varsa hemen HTML kod içerisinde renklendirilip browse edildiği sırada ekrana, bulunan kelimenin rengi değiştirilmiş şekilde daha browse anında yansıtılıyor ( Google Önizleme Taraması veya Forumda kelime arama sonucunun highlight edilmesi gibisinden )

- Ama sadece var ya da yok olduğunu nasıl anlarım şeklinde sorsaydın frame vs. gerek kalmaz basit string operasyonlarla bunun varlığını yaptığın şekilde olduğunu bildirebilirdik. Neyse çözüm olmuş ya önemli olan budur.