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>
<!--#include file="dbsetup.asp"-->
<%
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,"<p>")
prg2 = split(prg1(1),"</p>")
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 "<b>Hata:</b> " & rssOku.parseError.reason &"<br>" '// Hata Sebebi
Response.Write "<b>Satır:</b> " & rssOku.parseError.line &"<br>" '// Hatanın Bulunduğu Satır
Response.Write "<b>Açıklama:</b> " & 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>