HTML Parse

[CiTiZEN]

Selamlar arkadaşlar, öncelikle forumda araştırmalarım ve 2 gündür uğraşlarım sonucunda beceremediğim bir parse meselesi var.Elimde içeriği değişken bir asp sayfası var bu sayfanın içinden bazı bilgileri almam gerekmekte, ancak bir türlü beceremedim, @mrarman hocanın veya diğer arkadaşların örnek uygulamalarını da indirsem fayda vermedi.Sorun şu

WEBBROWSER dan aldığım verileri memoya şu şekilde aktarıyorum:

Kod: Tümünü seç

 memo1.text:=WebBrowser1.OleObject.document.body.innerhtml;

ve memo nun içinden alttaki satırların bazılarını almam gerekmekte.

altta asp sayfasından bir bölge veriyorum:

Kod: Tümünü seç

<center><table border="1"><tr style="background-color:#DDDDDD">
<td><b> No.</b></td><td> ALMAK İSTEMEDİĞİM BİLGİ </td></tr>

<td><b>Adı Soyadı</b></td><td> ALMAM GEREKEN VERİ</td></tr>
<td><b>Durumu</b></td><td> ALMAM GEREKEN VERİ </td></tr>

<tr><td><b>Durumu</b></td><td> ALMAK İSTEMEDİĞİM BİLGİ  </td></tr>

çok basit bir işlem gibi gözükmekte ama yukardaki kodların üzerinde ve altında bu formata benzer birkaç kb lik veriye sahibim içinden almak istediğim birkaç bölge var.Diğer veriler sayfa yapısıyla alakalı beni ilgilendirmeyen veriler.Parse , pos işlemlerinden denemediğim kalmadı nasıl halledebilirim?
Kolay Gelsin.

[emin_as]

Aldıgın bilgiyi S adlı bir stringe attıgını varsayıyorum.

Kod: Tümünü seç

s:=stringreplace(s,'</td><td>','!',[rfReplaceAll]);
s:=stringreplace(s,'</td></tr>','=',[rfReplaceAll]);

Önce </td><td> yi ! ünlem ile değiştiriyoruz.
Sonra </td></tr> yi = ile değiştiriyoruz.
Başka karakterler de kullanabilirsin.

Kod: Tümünü seç

i:=1;
repeat
z1:=PosEx('!',s,i);   // Posex, pos un biraz daha gelişmiş hali, 
z2:=PosEx('=',s,i);  // 3. parametre bize kaçıncı kez bulunanın sırasını getirecegini söylüyor.
if (z1 > 0 ) and (z2 > 0) then  StrIsle(i,copy(s,z1,z2-z1));
inc(i);
until  z1=0;

Daha sonra sırayla ! ve = arasını arayıp, buldugumuz değere göre bunu strisle adlı bir fonksiyona yönlendiriyoruz.

Kodda hata olabilir, ama üzerinde çalışırsan sanırım sonuç alabilirsin.

[CiTiZEN]

hocam şu şekilde yaptım hata verdi: hatalı satırın devamına hatayı yazdım (strisle:=(i,copy(s,z1,z2-z1));) kod blogunda

Kod: Tümünü seç

procedure TForm3.Button1Click(Sender: TObject);
Var
  S: String;
  z1,z2:integer;
  i:integer;
begin
WebBrowser1.Navigate('.....');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;
  begin
s:=WebBrowser1.OleObject.document.body.innerhtml;
s:=stringreplace(s,'<td>','!',[rfReplaceAll]);
s:=stringreplace(s,'</td></tr>','=',[rfReplaceAll]);

i:=1;
repeat
z1:=PosEx('!',s,i);   // Posex, pos un biraz daha gelişmiş hali,
z2:=PosEx('=',s,i);  // 3. parametre bize kaçıncı kez bulunanın sırasını getirecegini söylüyor.
if (z1 > 0 ) and (z2 > 0) then
strisle:=(i,copy(s,z1,z2-z1));         // Bu satır ne işe yarıyor çözemedim o satırı sildiğimde ise kısır döngüye giriyor sanırım program donuyor
inc(i);
until  z1=0;
end;
end;

bu durumu nasıl halledebilirim

[emin_as]

Aradıgın aradakı yazıları işlemek için kullanacagın fonksiyon.

Kod: Tümünü seç

function strisle(i: integer; s: string);
begin
  showMessage(IntToStr(i)+': '+s);
  if ( i mod 2) = 0 then showmessage('Bu durumu olmalı')
  else showmessage('Bu adı  olmalı');
  // Bu şekilde i tek sayı ise adı, çift sayı ise durumu olacak gelecek
  // istedigin gibi bu bilgileri düzenle
end;

Bu fonksiyona yazıları şu şekilde geçeceksin.

Kod: Tümünü seç

...
if (z1 > 0 ) and (z2 > 0) then strisle(i,copy(s,z1,z2-z1));    // strisle bir fonksiyon
...

[CiTiZEN]

"missing operatior or semicolon" olmadı hocam strisle(i1,copy(s1,z1,z2-z1)); bu satırda bu hatayı verip duruyor ne yaptımsa fayda vermedi

[emin_as]

Kullandıgın değişken i mi, i1 mi?
Yazdıgın bölümün tamamını yapıştırsana.

StrIsle(i,copy(s,z1,z2-z1)); Bu fonksiyon yeterli olmalı, eger with kullanıyorsan, baska bir copy tanımı olabilir. O nedenle söyle yazabilirsin

StrIsle(i,system.copy(s,z1,z2-z1));

[CiTiZEN]

i1 kullanıyorum ama başkalarınıda denedim çakışma olmasın diye ama sonuç aynı sizin dediğinizide denedim

kodu olduğu gibi yapıştırıyorum:

Kod: Tümünü seç

procedure TForm3.Button1Click(Sender: TObject);
Var
  s11: String;
  z1,z2:integer;
  strisle:string;
  i11:integer;
begin
WebBrowser1.Navigate('www.siteadi.com');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;
  begin
s11:=WebBrowser1.OleObject.document.body.innerhtml;
end;
s11:=stringreplace(s11,'<td>','!',[rfReplaceAll]);
s11:=stringreplace(s11,'</td></tr>','=',[rfReplaceAll]);

i11:=1;
repeat
z1:=PosEx('!',s11,i11);
z2:=PosEx('=',s11,i11); 
if (z1 > 0 ) and (z2 > 0) then
StrIsle(i11,copy(s11,z1,z2-z1)); //sonuç aynı
StrIsle(i11,system.copy(s11,z1,z2-z1)); // bunda da sonuç aynı her iki kodda da hata veriyor
inc(i11);
until  z1=0;
end;

dün geceden beridir uğraşıyorum berbat haldeyim önceki projelerden kendi yazdığım kodları açtım onları bile anlayamıyorum sizlerde de oluyor mu böyle şeyler zihnim bulanık bu aralar sanırsam nası düzelecek onu da bilmiyorum

[CiTiZEN]

hallettim hocam string tipi değişken olarak tanımladığımdan kaynaklanıyormuş şu anda denedim ama mesaj olarak ekranda birer artarak ilerleyen ve : nokta bulunan bir ibare daha sonrasında da boş dönen bir mesaj dialog var biraz daha kurcalayım bakalım

[CiTiZEN]

en son geldiğim nokta ama butona tıklayınca sadece memoya bilgileri alıyor showmessage proceduru çalışmıyor değer boş dönüyor ondan olduğunu biliyorum da neden olduğunu çözemedim

Kod: Tümünü seç

procedure TForm3.Button1Click(Sender: TObject);
function strisle(i: integer; s: string):string;
begin
  showMessage(IntToStr(i)+': '+s);
  if ( i mod 2) = 0 then showmessage(s)
  else showmessage(s);
end;


Var
 // s11: String;
  z1,z2:integer;
  i11:integer;
begin

WebBrowser1.Navigate('www.siteadi.com');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;
  begin
Memo1.Text:=WebBrowser1.OleObject.document.body.innerhtml;
 end;
i11:=1;
repeat
z1:=PosEx('<TD>',Memo1.Text,i11);
z2:=PosEx('</TD></TR>',Memo1.Text,i11);
if (z1 > 0 ) and (z2 > 0) then
strisle(i11,copy(Memo1.Text,z1,z2-z1));
inc(i11);
until  z1=0;
end;

[CiTiZEN]

en son geldiğim nokta ama butona tıklayınca sadece memoya bilgileri alıyor showmessage proceduru çalışmıyor değer boş dönüyor ondan olduğunu biliyorum da neden olduğunu çözemedim

Kod: Tümünü seç

function strisle(i: integer; s: string):string;
begin
  showMessage(IntToStr(i)+': '+s);
  if ( i mod 2) = 0 then showmessage(s)
  else showmessage(s);
end;

procedure TForm3.Button1Click(Sender: TObject);
Var
 // s11: String;
  z1,z2:integer;
  i11:integer;
begin

WebBrowser1.Navigate('www.siteadi.com');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;
  begin
Memo1.Text:=WebBrowser1.OleObject.document.body.innerhtml;
 end;
i11:=1;
repeat
z1:=PosEx('<TD>',Memo1.Text,i11);
z2:=PosEx('</TD></TR>',Memo1.Text,i11);
if (z1 > 0 ) and (z2 > 0) then
strisle(i11,copy(Memo1.Text,z1,z2-z1));
inc(i11);
until  z1=0;
end;

[emin_as]

Aşagıdaki kodu dene.

Kod: Tümünü seç

function strisle(i: integer; s: string):string;
begin
  showMessage(IntToStr(i)+': '+s);
  if ( i mod 2) = 0 then showmessage(s)
  else showmessage(s);
end;

procedure TForm3.Button1Click(Sender: TObject);
Var
// s11: String;
  z1,z2:integer;
  i11:integer;
begin
WebBrowser1.Navigate('www.siteadi.com');
 while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;

Memo1.Text:=WebBrowser1.OleObject.document.body.innerhtml;

i11:=1;
repeat
z1:=PosEx('</td><td>',Memo1.Text,i11);
z2:=PosEx('</td></tr>',Memo1.Text,i11);
if (z1 > 0 ) and (z2 > 0) then strisle(i11,copy(Memo1.Text,z1,z2-z1));
inc(i11);
until  z1=0;
end;

[CiTiZEN]

anlamsız anlamsız uyarılar veriyor yani web sayfanın içeriğinden istediğim yer hariç diğer bölgeleri alıyor ve kısır döngüye giriyor önce 1 sonra içerik, 2 sonra içerik diye sayıyor ama hep aynı içerik bilgilerini birer birer artarak gösteriyor 100 e kadar saydırdım hep aynı içerik

[emin_as]

Web adresini veya web adresiyle gelen bilgiyi versene, bir kontrol edeyim.

[CiTiZEN]

hocam özel mesaj olarak attım

Kolay Gelsin.

[CiTiZEN]

Sayın Emin_AS halletti teşekkürlerimle kodlarda burada:

Kod: Tümünü seç

Emin_AS'tan Alıntıdır


Form üzerinde şunlar var.

Button1 - Bilgileri alma olayı tetikleniyor
Edit1  - Bilgileri alınacak kişinin idno su,
ValuelistEditor1 bilgilerin gösterilecegi yer,
idHttp1 : Bilgilerin çekildiği component.

--------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, Grids, ValEdit;

type
TForm1 = class(TForm)
  ValueListEditor1: TValueListEditor;
  IdHTTP1: TIdHTTP;
  Edit1: TEdit;
  Button1: TButton;
  Label1: TLabel;
  procedure Button1Click(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
  procedure HtmlParse(s: string);
end;

var
Form1: TForm1;

implementation

uses StrUtils;

{$R *.dfm}

procedure TForm1.HtmlParse(s: string);
var
  i        : integer;
  z1,z2,z3 : integer;
  s1,s2    : string;
begin
z1:=pos('pnlDetaylar',s);
if z1 > 0  then
begin
  delete(s,1,z1+2); // pnldetaylara kadar olan bölüm siliniyor.
  z1:=pos('</table>',s);
  if z1 > 0 then  s:=copy(s,1,z1);

  // Başlık bilgileri  <td><b> ile başlıyor
  s:=StringReplace(s,'<td><b>','{',[rfReplaceAll]);
  // Abone bilgileri ise </b></td><td> ile başlıyor
  s:=StringReplace(s,'</b></td><td>','!',[rfReplaceAll]);
  // Bilgiler bu şekilde bitiyor
  s:=StringReplace(s,'</td>','}',[rfReplaceAll]);
  (* Elimize aşagıdaki gibi bir bilgi var.
    Artık tek yapmamız gereken { !  arasında başlıgı ve ! } arasındaki bilgiyi almak
      Detaylar" cellpadding="0" cellspacing="0" border="0" width="100%"><tr><td>
      <center><table border="1"><tr style="background-color:#DDDDDD">
      {Abone No.!00000000}</tr><tr>{Sözleşme No.!100}</tr>
      <tr style="background-color:#DDDDDD">{Abone Referans No.!100000}</tr>
      <tr>{Adı Soyadı / Ünvanı!aaa aaa}</tr>
      <tr style="background-color:#DDDDDD">{Sözleşme Tarihi!01/01/1960}</tr><tr>{Abonelik Türü!Standart}</tr>
      <tr style="background-color:#DDDDDD">{Abone Tipi!TİCARETHANELER}</tr><tr>{Fatura Ünvanı!}</tr>
      <tr style="background-color:#DDDDDD">{Fatura Adresi! }</tr><tr>{Vergi Dairesi / No.! / }</tr>
      <tr style="background-color:#DDDDDD">{Telefon!  / }</tr><tr>{Faks!}</tr>
      <tr style="background-color:#DDDDDD">{E - Posta!}</tr><tr>{Yazışma Adresi!ESKİ SANAYİ MH. 3.CD. 14.SK. 14/ }</tr>
      <tr style="background-color:#DDDDDD">{Sayaç Durumu!Bağlı}</tr><tr>{Abonelik Durumu!Açık /  }</tr>
      <tr style="background-color:#DDDDDD">{Aktif Sayaç!MAKEL 105223}</tr><tr>{Trafo Gücü!0 kVA}</tr>
      <tr style="background-color:#DDDDDD">{Sözleşme Gücü!0 kW}</tr><tr>{Işık Gücü!0 W}</tr>
      <tr style="background-color:#DDDDDD">{Motor Gücü!1250 W}</tr><
      *)

  z1 := ValueListEditor1.RowCount-1;
  if z1 > 1 then
    for i:= z1 downto 1  do
        ValueListEditor1.DeleteRow(i);

  ValueListEditor1.TitleCaptions.Add('Başlık');
  ValueListEditor1.TitleCaptions.Add('Bilgi');
  repeat
    z1:=pos('{',s);
    z2:=pos('!',s);
    z3:=pos('}',s);
    if (z1 >0) and (z2>0) and (z3>0) then
    begin
      s1:=copy(s,z1+1,z2-z1-1); // 1 ekleyip, 1 çıkarıyoruz. Çünkü { karakteri
      s2:=copy(s,z2+1,z3-z2-1); // gösterilsin istemiyoruz.
      ValueListEditor1.InsertRow(s1,s2,True);
      delete(s,1,z3);
    end;
  until z1 = 0;
end else
  ShowMessage(' Bilgi tanınmıyor.');
end;

procedure TForm1.Button1Click(Sender: TObject);
const
sorgu_url = 'www.siteadi.com';
var
sl : Tstringlist;
begin
try
  sl:=Tstringlist.Create;
  try
    Htmlparse(IdHTTP1.Post(sorgu_url+Edit1.Text,sl));
  finally
    sl.Free;
  end;
except
  on E:Exception do showmessage('Hata : '+E.message);
end;
end;