İlk defa buraya yazı ekliyorum. Umarım hata yapmamışımdır. Ve işinize yarar. Daha önce forumda bu konu ilgili bir arkadaşın sorunu halletmeye çalışırken bu kodları hazırladık. Sizlerle paylaşalım dedim.
Get metodu ile html parse işlemi yapıyor. Arama işlemlerinin hızlı olması için daha önce @mege hocamızın burada vermiş olduğu faststrings bileşenindeki fastpos ve copy komutu arasındaki hız farkını da görmemiz için iki farklı yöntemide uyguluyacam. Çok basit şekilde hazırladım. İşine yarayan arkadaşlar geliştirirler.
Öncelikle form üzerine Idhttp, 2 buton, 3 memo ve 1 editbox yerleştirin. Editbox’ta iller’in ismi yazıyor. Bunu combobox ile yaparsanız daha iyi olur. Memo1’e html’yi açtırıyoruz. Memo2 ve memo3’e ise arama sonuçlarını aktarıyoruz.
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, StdCtrls, OleCtrls, SHDocVw, faststrings, FastStringFuncs;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Edit1: TEdit;
IdHTTP1: TIdHTTP;
Memo3: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
Var Browser: TIdHTTP;
i,bas,son:integer;
begin
memo1.Text:='';
memo2.Text:='';
Browser := TIdHTTP.Create(nil);
try
Memo1.Text :=utf8decode( Browser.Get('http://www.meteor.gov.tr/2006/tahmin/tahmin-iller.aspx?m='+edit1.Text));
finally
Browser.Free;
end;
bas:=0;
son:=0;
for i:= 1 to length(memo1.Text) do
begin
if copy(memo1.text,i,17) = '<td class="maxS">' then bas:=i;
if (bas<>0) and (copy(memo1.text,i,2) = '</')
then son:=i else son:=0;
if (bas<>0) and (son<>0) then
begin
memo2.Lines.Add(Copy(memo1.Text,bas+17,son-bas-17));
son:=0;bas:=0;
end;
end;
bas:=0;
son:=0;
for i:= 1 to length(memo1.Text) do
begin
if copy(memo1.text,i,34) = '<th class="th" style="width:18%;">' then bas:=i;
if (bas<>0) and (copy(memo1.text,i,3) = '<br')
then son:=i else son:=0;
if (bas<>0) and (son<>0) then
begin
memo3.Lines.Add(Copy(memo1.Text,bas+34,son-bas-34));
son:=0;bas:=0;
end;
end;
end;
fastpos ile işlem yapan butona bu kodları yazıyoruz.
Kod: Tümünü seç
procedure TForm1.Button2Click(Sender: TObject);
var
ara,ara1:string;
bas,son,i:integer;
Browser: TIdHTTP;
begin
memo1.Text:='';
memo2.Text:='';
Browser := TIdHTTP.Create(nil);
try
Memo1.Text :=utf8decode( Browser.Get('http://www.meteor.gov.tr/2006/tahmin/tahmin-iller.aspx?m='+edit1.Text));
finally
Browser.Free;
end;
bas:=0;
son:=0;
for i:= 0 to memo1.Lines.Count - 1 do
begin
ara:= '<td class="maxS">';
ara1:= '</td>';
bas:= FastPos(memo1.lines[i], ara, length(memo1.lines[i]), length(ara), 1);
if (bas<>0) then
son:=FastPos(memo1.lines[i], ara1, length(memo1.lines[i]), length(ara1), 1)
else son:=0;
if (bas<>0) and (son<>0) then
begin
memo2.Lines.Add(Copy(memo1.lines[i],length(ara)+bas,son-bas-length(ara)));
end;
begin
son:=0;bas:=0;
end;
end;
bas:=0;
son:=0;
for i:= 0 to memo1.Lines.Count - 1 do
begin
ara:= '<th class="th" style="width:18%;">';
ara1:= '<br';
bas:= FastPos(memo1.lines[i], ara, length(memo1.lines[i]), length(ara), 1);
if (bas<>0) then
son:=FastPos(memo1.lines[i], ara1, length(memo1.lines[i]), length(ara1), 1)
else son:=0;
if (bas<>0) and (son<>0) then
begin
memo3.Lines.Add(Copy(memo1.lines[i],length(ara)+bas,son-bas-length(ara)));
end;
begin
son:=0;bas:=0;
end;
end;
end;