View hidden content is available for registered users!
Kod:
XMLHTTP ile hedef alana bağlanmak için;
StrUrl=" http://www.turkaport.com"
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", StrUrl, False
xml.Send
Bu kod ile turkaport.com sitesine bağlandık. Şimdi ise sayfanın kodlarını çekelim.
xml.ResponseText
Bu şekilde belirttiğimizde turkaport.com sayfasının tüm html kodlarını çekip sayfanıza dökecektir.
<%
StrUrl=" http://www.turkaport.com"
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", StrUrl, False
xml.Send
Sonuc=xml.ResponseText
response.write Sonuc
%>
Şimdi ise işin can alıcı noktasına gelelim.
Çekilen kodlardan Sadece istediğiniz verileri çekmeyi nasıl yapacağız.
Bunun için instr(),mid(),Replace() fonksiyonlarını kullanacağız.
(Sonuc) değişkenine kodları atamıştık üstteki örneğimizde. Onu baz alarak devam ediyorum.
Çekeceğimiz sayfanın kodlarına bakıyoruz. turkaport.com sitesindeki aşağıda bulunan kodları çekelim;
(Daha fazla bilgi almak için [email protected] mail adresimize mesaj gönderebilir veya
[email protected] adresinden msn ile görüşebilirsiniz.)
instr(Sonuc,"Daha fazla") kodu ile çektiğimiz kodlar içinde (Daha fazla) yazan yerin satır numarasını alıyoruz...
instr(Sonuc,"görüşebilirsiniz.") kodu ile çektiğimiz kodlar içinde (görüşebilirsiniz.) yazan yerin satır numarasını alıyoruz...
bunları aşağıdaki şekilde değişkene tanımlıyoruz.
baslangic=instr(Sonuc,"Daha fazla")
son=instr(Sonuc,"görüşebilirsiniz.")
Yani burada anlatmak istediğim çekeceğimiz satırların başlangıç ve bitiş satırlarını almak.
Böylece çektiğimiz kodlar arasında örnek 500-800 satırı arasındaki kodları çekiyoruz...
Kodları kesmek için mid() fonksiyonunu kullanıyoruz.
kestik=mid(Sonuc,baslangic,son-baslangic)
böylece belirlenen satır numaralarından yazıyı kestik.
tek yapmamız gereken <%response.write kestik%> kodu sitemize çıktısını almak olacaktır.
Son Örnek hali
<%
StrUrl=" http://www.turkaport.com"
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", StrUrl, False
xml.Send
Sonuc=xml.ResponseText
baslangic=instr(Sonuc,"Daha fazla")
son=instr(Sonuc,"görüşebilirsiniz.")
kestik=mid(Sonuc,baslangic,son-baslangic)
response.write kestik
%>
Ama XMLHTTP nin bir sorunu var veriyi çekerken tr karakterleri göremiyor.
Bu yüzden son=instr(Sonuc,"görüşebilirsiniz.") kodu iş görmiyecektir. Çekilen veriyi (g?r??ebilirsiniz.) gibi algılar.
Bu yüzden çektiğimiz verileri nasıl tr karakter yapacağımızıda anlatayım.
XMLHTTP yönteminde ya text formatlı çekebilirsiniz ResponseText komutu ile o zamanda tr desteği olmaz.
Yada Binary modunda çekeceksiniz. xml.ResponseBOdy komutu ile.
ResponseBOdy komutu ile veriyi çekelim.
xml.ResponseBOdy
Ama bu kodda sadece binary modunda gösterecktir çektiğimiz veriyi.
Bu yüzden binary modunu text formatına çevirmek için hazır fonksiyonumuzu verelim.
Private Function BinaryToString(Binary)
Dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
If cl3>300 Then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
If cl2>200 Then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function
response.write BinaryToString(xml.ResponseBOdy)
Şimdi kodumuzu son kez bakalım...
<%
StrUrl=" http://www.turkaport.com"
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", StrUrl, False
xml.Send
Private Function BinaryToString(Binary)
Dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
If cl3>300 Then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
If cl2>200 Then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function
Sonuc=BinaryToString(xml.ResponseBOdy)
baslangic=instr(Sonuc,"Daha fazla")
son=instr(Sonuc,"görüşebilirsiniz.")
say=len("görüşebilirsiniz.")
kestik=mid(Sonuc,baslangic,son-baslangic+say)
response.write kestik
