ASP Bot Haber Detaylarını Alamıyorum.

25-04-2014, 11:57:37

Merhabalar, aşağıda bir bot denemesi yaptım, listelenen haberlerden ilk haberin linkinin içine giriyor ve haber detayını alıyorum, fakat diğer haberlerin linkine giremiyorum, 8 tane haberin detayını çekmesi gerekiyor, fakat 8 kere aynı haberin içeriğini çekiyor, döngüde problem var sanırım, ama bir türlü çözemedim mantığı.

<%
Function GETHTTP(adres)
Set StrHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
StrHTTP.Open "GET" , adres, false
StrHTTP.sEnd
GETHTTP = StrHTTP.Responsetext
Set StrHTTP = Nothing
End Function

url = "http://galatasaraysd.org/etkinlikler"
kaynak = GETHTTP(url)

kaynakbasla = instr(kaynak, "<html xmlns=""http://www.w3.org/1999/xhtml"">")
kaynakbit = instrRev(kaynak, "</html>")
gaynah = mid(kaynak, kaynakbasla, kaynakbit-kaynakbasla)

haberadi1 = split(gaynah, "<div id=""Haberler_AnaSayfa_Baslik""><a href=""/haberoku/")
for i=1 to ubound(haberadi1)
haberadi =split(haberadi1(i),"/")

url2 = "http://galatasaraysd.org/haberoku/"& haberadi(0) &""
kaynak2 = GETHTTP(url2)

kaynakbasla2 = instr(kaynak2, "<html xmlns=""http://www.w3.org/1999/xhtml"">")
kaynakbit2 = instrRev(kaynak2, "</html>")
gaynah2 = mid(kaynak2, kaynakbasla2, kaynakbit2-kaynakbasla2)
baslik1 = split(gaynah2, "<title>")
baslik =split(baslik1(i),"</title>")
detay1 = split(gaynah2, "<div id=""haberdetayi"">")
detay =split(detay1(i),"</div>")

response.write baslik(0)
response.write "<br/>"
response.write detay(0)
response.write "<br/>"
response.write "<br/>"

next
%>

28-04-2014, 09:47:53

#2

~~vyslmkyy~~

Üyeliği durduruldu

çünkü sürekli aynı linke gidiyor ilk gördüğü kaynak kodundaki linki alıyor rss ile çözebilirsin bu sorunu ben daha önce radikal ve haber7 botları yapmıştım bakayım bulabilirsem onu göndereyim örnek olsun

28-04-2014, 12:09:50

#3

beyogluhosting

RSS ile nasıl çözeceğim, sitenin rss'i yoksa ?
Yalnız url2 = "http://galatasaraysd.org/haberoku/"& haberadi(0) &"" satırındaki haberadi(0) değeri döngüde farklı geliyor ama nedense aynı değerle çalışıyor döngü.

29-04-2014, 13:45:31

#4

beyogluhosting

Yardımcı olabilecek kimse yokmu ?

29-04-2014, 15:55:10

#5

1scripter

beyogluhosting adlı üyeden alıntı: mesajı görüntüle

Yardımcı olabilecek kimse yokmu ?

Kodlarda hata aramaktansa kendi kodlarımı yazmak daha kolay geliyor. Şu şekilde çekebilirsin:

<!--#include file="functions.asp"-->
<%
'Kaynaktan verileri çek
strVeriCekilecekAdres = "http://galatasaraysd.org/etkinlikler/?sayfa=1"
Set oXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.open "GET", strVeriCekilecekAdres, False
oXMLHttp.Send()
blnAlinanVeri = BinaryToString(oXMLHttp.responseBody)
Set oXMLHttp = Nothing

haber1=split(blnAlinanVeri,"<div id=""Haberler_AnaSayfa_Resim"">")
for y = 1 to ubound(haber1)
haber2=split(haber1(y),"</div>")
haber = Trim(haber2(0))
'Verileri Süz
haber = replace(haber,"<img src=""","<img src=""http://galatasaraysd.org")
haber = replace(haber,"title="""," />")
haber = replace(haber,"title="""," />")
haber = replace(haber,"""/>","")
haber = replace(haber,"</a>","</a><br />")
'Sonucu Yazdır
response.write haber
next
%>

functions.asp dosyasında BinaryToString fonksiyonu var.

29-04-2014, 16:14:21

#6

beyogluhosting

1scripter adlı üyeden alıntı: mesajı görüntüle

Kodlarda hata aramaktansa kendi kodlarımı yazmak daha kolay geliyor. Şu şekilde çekebilirsin:

<!--#include file="functions.asp"-->
<%
'Kaynaktan verileri çek
strVeriCekilecekAdres = "http://galatasaraysd.org/etkinlikler/?sayfa=1"
Set oXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.open "GET", strVeriCekilecekAdres, False
oXMLHttp.Send()
blnAlinanVeri = BinaryToString(oXMLHttp.responseBody)
Set oXMLHttp = Nothing

haber1=split(blnAlinanVeri,"<div id=""Haberler_AnaSayfa_Resim"">")
for y = 1 to ubound(haber1)
haber2=split(haber1(y),"</div>")
haber = Trim(haber2(0))
'Verileri Süz
haber = replace(haber,"<img src=""","<img src=""http://galatasaraysd.org")
haber = replace(haber,"title="""," />")
haber = replace(haber,"title="""," />")
haber = replace(haber,"""/>","")
haber = replace(haber,"</a>","</a><br />")
'Sonucu Yazdır
response.write haber
next
%>

functions.asp dosyasında BinaryToString fonksiyonu var.

Çok eşekkür ederim, yalnız hata veriyor çalışmıyor kodlar, BinaryToString fonksiyonu paylaşabilirseniz sevinirim.

--R10.NET; Flood Engellendi -->-> Yeni yazılan mesaj 16:14:21 -->-> Daha önceki mesaj 16:06:33 --

Ayrıca ben haberlerin detaylarına girip detaylarını almaya çalışıyorum, sizin paylaştığınız kod bunu yapıyormu ?

29-04-2014, 16:14:34

#7

1scripter

<%
' Binary 2 String
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
%>

hayır yukarıdaki kod haber resmi, haber başlığı ve haber linkini çekiyor.
ama haber linki elinde olduğu için aynı mantıkla haber detaylarını da çekebilirsin.

29-04-2014, 16:19:53

#8

beyogluhosting

1scripter adlı üyeden alıntı: mesajı görüntüle

<%
' Binary 2 String
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
%>

Maalesef çalışmıyor, test etmediniz sanırım.

Hocam çok teşekkür ederim, hata bendeymiş, sorunsuz şekilde çalıştı.

--R10.NET; Flood Engellendi -->-> Yeni yazılan mesaj 16:19:53 -->-> Daha önceki mesaj 16:16:59 --

Hocam ben zaten bu şekil çekebiliyorum, ben haberlerin detaylarına girip detaylarını almak istiyorum.

29-04-2014, 16:35:02

#9

1scripter

mantık hep aynı hocam, xmlhttp ile ilgili URL'den verileri çek, istediğin şekilde süz: Detayları aynı sayfada çekmek gibi bir zorunluluğunuz yoksa aşağıdaki gibi yapabilirsiniz.

functions.asp

<%
' Binary 2 String
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
%>

gs_liste.asp

<!--#include file="functions.asp"-->
<%
'Kaynaktan verileri çek
strVeriCekilecekAdres = "http://galatasaraysd.org/etkinlikler/?sayfa=1"
Set oXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.open "GET", strVeriCekilecekAdres, False
oXMLHttp.Send()
blnAlinanVeri = BinaryToString(oXMLHttp.responseBody)
Set oXMLHttp = Nothing
 
haber1=split(blnAlinanVeri,"<div id=""Haberler_AnaSayfa_Resim"">")
for y = 1 to ubound(haber1)
haber2=split(haber1(y),"</div>")
haber = Trim(haber2(0))
'Verileri Süz
haber = replace(haber,"<img src=""","<img src=""http://galatasaraysd.org")
haber = replace(haber,"title="""," />")
haber = replace(haber,"title="""," />")
haber = replace(haber,"""/>","")
haber = replace(haber,"</a>","</a><br />")
haber = replace(haber,"/haberoku/","gs_detay.asp?URL=/haberoku/")
'Sonucu Yazdır
response.write haber
next
%>

gs_detay.asp

<!--#include file="functions.asp"-->
<%

'Kaynaktan verileri çek
URL = Request.QueryString("URL")
strVeriCekilecekAdres = "http://galatasaraysd.org/"&URL
Set oXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.open "GET", strVeriCekilecekAdres, False
oXMLHttp.Send()
blnAlinanVeri = BinaryToString(oXMLHttp.responseBody)
Set oXMLHttp = Nothing
 
haber1=split(blnAlinanVeri,"<div id=""haberdetayi"">")
for y = 1 to ubound(haber1)
haber2=split(haber1(y),"</div>")
haber = Trim(haber2(0))
response.write haber
next
%>