Asp Tear Kullanımı

29-12-2007, 12:03:18

merhaba arkadaşlar;

öğrendiğime göre bu site botları asptear ile yapılabiliniyormuş internette baktım asprehberin ntvhaber kodlaması dışında ayrıntılı bilgi bulamadım.

kodlara nasıl kontrol edip sitedeki sayfaki verileri nasıl veritabanın kayıt edebileceğim hakkında bilgi bulabileceğim bir yer varmı.

veya bu konuda aramızda bilgi sahibi olan arkadaşlar.

29-12-2007, 19:18:29

#2

webrlis

maxiasp.com a ve forumlarına bakarsan bukonuda baya bilgi bulabilirsin.
fakat ben bot yazarken Microsoft.XMLHTTP kullanıyorum. sanada bunu tavsiye ederim

kısaca kullanımı

Alıntı

private Function GETHTTP(adres)
Set StrHTTP = Server.CreateObject("Microsoft.XMLHTTP" )
StrHTTP.Open "GET" , adres, false
StrHTTP.sEnd
GETHTTP = StrHTTP.Responsetext
Set StrHTTP = Nothing
End Function

veri= GETHTTP("https://www.r10.net")

veri değişkenine r10.net in kaynak kodlarını atadık.

InStr ve mid fonksiyonlarını kullanarakta istediğin aralığı alabilirsin

30-12-2007, 19:43:02

#3

death_angel35

anladım fakat mesala site adresinin sadece title ve keywordunu çekmek ve sitemde yayınlamak istiyorum. bunu nasıl belirticem

30-12-2007, 20:11:35

#4

death_angel35

tamam arkadaşım çözdüm çok teşekkür ederim
genede yararlanmak isteyenler olabilir örnek olarak bu sayfayı çektim buyrun

<%
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

On error resume next
site = "https://www.r10.net/asp/112001-asp-tear-kullanimi.html"

Set HTTP = Server.CreateObject("Microsoft.XMLHTTP" )
  HTTP.Open "Get" , site, False
  HTTP.SEnd
Sayfa_Al = BinaryToString(HTTP.ResponseBody)
Set HTTP = Nothing


if err then

 response.write "HATA: "&err.description

 else
  Basla = InStr(1,Sayfa_Al, "<title>" , 1) + Len("<title>" )
  Bitir = InStr(Basla, Sayfa_Al, "</title>" , 1) - Basla
  Title = Mid(Sayfa_Al, Basla, Bitir)
  response.write Title &"<br /><br />"
  
  Basla = InStr(1,Sayfa_Al, "<meta name=""keywords"" content=""" , 1) + Len("<meta name=""keywords"" content=""" )
  Bitir = InStr(Basla, Sayfa_Al, ">" , 1) - Basla 
  Keyws = Mid(Sayfa_Al, Basla, Bitir)
  response.write Keyws &"<br /><br />"  
  
  Basla = InStr(1,Sayfa_Al, "<meta name=""description"" content=""" , 1) + Len("<meta name=""description"" content=""" )
  Bitir = InStr(Basla, Sayfa_Al, ">" , 1) - Basla 
  Descs = Mid(Sayfa_Al, Basla, Bitir)
  response.write Descs &"<br /><br />"    
  
  Basla = InStr(1,Sayfa_Al, "<div id=""post_message_1245650"">" , 1) + Len("<div id=""post_message_1245650"">" )
  Bitir = InStr(Basla, Sayfa_Al, "</div>" , 1) - Basla 
  Yaz = Mid(Sayfa_Al, Basla, Bitir)
  response.write Yaz &"<br /><br />"    
 end if
 
%>

18-05-2008, 18:55:47

#5

svamder

peki bu çektigimiz sayfayı nasıl kendi veri tabanımıza yukleye biliriz?

10-04-2009, 00:06:20

#6

yaramaz71

Kimlik doğrulama veya yönetimden onay bekliyor.

çekilen sayfayı db nasıl kayderderiz ve aynı anda bir çok sayfayı çekip kaydetmeyi nasıl yapa biliriz

06-06-2009, 19:21:08

#7

akincitr

buyrun size aynı anda bir çok sayfayı çekmek resmide çekmek ve veritabanına eklemek için örnek kod. akillitvden videoları bütün bilgileriyle ve küçük resimleriyle çekiyor.
<%@LANGUAGE="VBSCRIPT"%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-9">
</head>
<body>

<%
Function Duzenle(security )
Duzenle = security
if Duzenle<>"" then
Duzenle = Replace(Duzenle, "'", "" )
Duzenle = Replace(Duzenle, "'", "" )
Duzenle = Replace(Duzenle, "Ã¼", "ü" )
Duzenle = Replace(Duzenle, "Ãœ", "Ü" )
Duzenle = Replace(Duzenle, "Å ", "Ş" )
Duzenle = Replace(Duzenle, "Ä±", "ı" )
Duzenle = Replace(Duzenle, "Ä°", "İ" )
Duzenle = Replace(Duzenle, "ÅŸ", "ş" )
Duzenle = Replace(Duzenle, "Ã§", "ç" )
Duzenle = Replace(Duzenle, "Ã¶", "ö" )
Duzenle = Replace(Duzenle, "ÄŸ", "ğ" )
end if
End Function
Function LinkDuz(security )
LinkDuz = security
if LinkDuz<>"" then
LinkDuz = Replace(LinkDuz, """, "''" )
end if
End Function
gun=day(date)
ay=month(date)
yil=year(date)
if ay<10 then
ay1="0"+CStr(ay)
else
ay1=CStr(ay)
end if
gun1=CStr(gun)
yil1=CStr(yil)
tarih=yil1+"-"+ay1+"-"+gun1
%>
<%
Sub ResimEkle(bilgi)
Dim XmlHttp
Dim BinaryStream
Dim Resim
resimlink=bilgi
set eklenen=conn.execute("select * from video order by id desc")
sonid=eklenen("id")
Set XmlHttp = server.CreateObject("MSXML2.ServerXMLHTTP")
XmlHttp.Open "GET", resimlink, False
XmlHttp.send
Resim = XmlHttp.ResponseBody
Set XmlHttp = Nothing
Set BinaryStream = server.CreateObject("ADODB.Stream")
BinaryStream.Type = 1 'Binarydata için 1
BinaryStream.Open
BinaryStream.Write Resim
BinaryStream.SaveToFile server.MapPath("../../resimler/videolar/"&sonid&".jpg"), 2 '< üstüne yazmak için 2
Set BinaryStream = Nothing
piclink="resimler/videolar/"&sonid&".jpg"
Set resimguncelle=conn.execute("update video set resim='"&piclink&"' where id='"&sonid&"' ")
End Sub
%>
<%
Sub VideoCek(gelen)
dlink=Cstr(gelen)
Set Tear_ac = CreateObject("SOFTWING.ASPtear" )
dim bilgicek
Dim yazi
Dim enson
Dim ayirt
Dim goster
Dim gostert
Dim katsis
Dim katsi
Dim id1
Dim id2
Dim id3
Dim id4
Dim prg1
Dim prg2
Dim prg3
bilgicek = Tear_ac.Retrieve(dlink , 2, "" , "" , "" )
bilgisi=Duzenle(bilgicek)
prg1 = split(descript,"")
prg2 = split(prg1(1),"")
prg3 = prg2(0)
yazi = split(bilgisi,"Açıklama")
On Error Resume Next
If Err.Number = 0 then
enson = split(yazi(1),"Anahtar Kelimeler ")
ayirt = split(enson(0),"<a")
goster = split(ayirt(1),">")
katsis = split(goster(1),"</a>")
gostert = split(katsis(0),"</a")
katsi= trim(gostert(0))
katsi= Cstr(katsi)
enson1 = split(yazi(1),"Sitene koy ")
ayirt1 = split(enson1(0),"<a")
goster1 = split(ayirt1(1),">")
katsis1 = split(goster1(1),"</a>")
gostert1 = split(katsis1(0),"</a")
katsi1= trim(gostert1(0))
katsi1= Cstr(katsi1)
link1=split(yazi(1),"Sitene koy")
link2=split(link1(1),""http")
link3=split(link2(1),""/><")
vlink="http"&link3(0)
vlink=LinkDuz(vlink)
if katsi="Sanat" then
catno=1
elseif katsi="Galatasaray" then
catno=2
elseif katsi="Komedi" then
catno=3
elseif katsi="Beşiktaş" then
catno=4
elseif katsi="Korku-Gerilim" then
catno=5
elseif katsi="Otomobil" then
catno=6
elseif katsi="Trabzonspor" then
catno=7
elseif katsi="Kazalar" then
catno=8
elseif katsi="Eğlence" then
catno=9
elseif katsi="Seyahat" then
catno=10
elseif katsi="Ünlüler" then
catno=11
elseif katsi="Müzik" then
catno=12
elseif katsi="Video Oyunları" then
catno=13
elseif katsi="Haberler" then
catno=14
elseif katsi="TV Programları" then
catno=15
elseif katsi="Reklamlar" then
catno=16
elseif katsi="Insanlar Alemi" then
catno=17
elseif katsi="Film Fragmanları" then
catno=18
elseif katsi="Nostalji" then
catno=19
elseif katsi="Hayvanlar Alemi" then
catno=20
elseif katsi="Animasyon" then
catno=21
elseif katsi="Kısa Film" then
catno=22
elseif katsi="Bilim ve Teknoloji" then
catno=23
elseif katsi="Ekstrem Sporlar" then
catno=24
elseif katsi="Nasıl Yapılır" then
catno=25
elseif katsi="Spor" then
catno=26
elseif katsi="Amatör" then
catno=27
elseif katsi="Süper Yetenek" then
catno=28
elseif katsi="Fenerbahçe" then
catno=29
else
catno=30
end if
resimyeri = "http://thumbpool.akilli.tv/0"&left(idk,3)&"/"&idk&".jpg"
videoyeri = "http://v2-sh6.akilli.tv/0"&left(idk,3)&"/"&idk&".flv"
set videoekle=conn.execute("insert into video (video,resim,title,descript,videoid,kategori,tarih ) values ('"&vlink&"','"&resimyeri&"','"&title&"','"&prg3&" ','"&idk&"','"&catno&"','"&tarih&"') ")
ResimEkle(resimyeri)
end if
End Sub
%>
<%
'// Değişkenler tanımlanıyor
Dim rssOku
Dim ObjeListesi
Dim Obje
Dim I
Dim link(200)
Dim baslik(200)
Dim parag(200)
Dim id(200)
Set rssOku = Server.CreateObject("MSXML2.FreeThreadedDOMDocumen t")
rssOku.async = False
adres="http://www.akilli.tv/rss.rss"
rssOku.setProperty "ServerHTTPRequest", True
rssOku.Load(adres)
'// Eğer kendi sitenizden alıyorsanız aşağıdaki yolu kullanabilirsiniz
'// rssOku.Load(Server.MapPath("rss.asp"))
'// Hata oluşursa Ekrana Hata Açıklaması Yazdırılıyor
If rssOku.parseError.errorCode <> 0 Then
Response.Write "Hata: " & rssOku.parseError.reason &" " '// Hata Sebebi
Response.Write "Satır: " & rssOku.parseError.line &" " '// Hatanın Bulunduğu Satır
Response.Write "Açıklama: " & rssOku.parseError.srcText '// Hata Açıklaması
End If
Set ObjeListesi = rssOku.getElementsByTagName("item")
Set rssOku = Nothing
i=0
For Each Obje In ObjeListesi
link(i) = Obje.childNodes(2).Text
baslik(i) = Obje.childNodes(0).Text
parag(i) = Obje.childNodes(1).Text
i=i+1
Next
Set ObjeListesi = Nothing
z=i-1
For k=0 to z
alinacakadres=Cstr(link(k))
idkontrol=split(alinacakadres,"/")
idk=idkontrol(4)
title=Duzenle(baslik(k))
descript=Duzenle(parag(k))
set videokont=conn.execute("select count(*) as toplam from video where videoid='"&idk&"'")
sayisi=Cint(videokont("toplam"))
if sayisi=0 then
VideoCek(alinacakadres)
end if
Next
%>
</body>
</html>