merhabalar youtube to youtube çalışmamın başarısızlıkla sonuçlanmasından sonra geriye kalanlara paylaşıyorum belki bir işinize yarar(tasarımdan yoksunduu,yazma izinlerini veriniz,Localde sorunsuz çalışıyor)
default.asp
<head>
<meta http-equiv="Content-Language" content="tr">
</head>
Adres Al:<table border="1" width="100%" id="table2">
<tr>
<td>
<form method="POST" action="default.asp">
<p>
<input type="text" name="youtube_linki" size="112" value="http://www.youtube.com/watch?v=RhZvNox_dGQ"><input type="submit" value="Gönder" name="B2"><input type="reset" value="Sıfırla" name="B3"></p>
</form>
</td>
</tr>
</table>
<p>ss
<%
on error resume next
youtubelinki=request.form("youtube_linki")
if youtubelinki="" then youtubelinki="http://www.youtube.com/watch?v=RhZvNox_dGQ"
Function URLDecode(byVal strString)
strString = Replace(strString, "%2F", "/")
strString = Replace(strString, "%7C", "|")
strString = Replace(strString, "%3F", "?")
strString = Replace(strString, "%21", "!")
strString = Replace(strString, "%40", "@")
strString = Replace(strString, "%5C", "\")
strString = Replace(strString, "%23", "#")
strString = Replace(strString, "%24", "$")
strString = Replace(strString, "%5E", "^")
strString = Replace(strString, "%26", "&")
strString = Replace(strString, "%25", "%")
strString = Replace(strString, "%2A", "*")
strString = Replace(strString, "%28", "(")
strString = Replace(strString, "%29", ")")
strString = Replace(strString, "%7D", "}")
strString = Replace(strString, "%3A", ":")
strString = Replace(strString, "%2C", ",")
strString = Replace(strString, "%7B", "{")
strString = Replace(strString, "%2B", "+")
strString = Replace(strString, "%2E", ".")
strString = Replace(strString, "%2D", "-")
strString = Replace(strString, "%7E", "~")
strString = Replace(strString, "%2D", "-")
strString = Replace(strString, "%5B", "[")
strString = Replace(strString, "%5F", "_")
strString = Replace(strString, "%5D", "]")
strString = Replace(strString, "%60", "`")
strString = Replace(strString, "%3D", "=")
strString = Replace(strString, "%27", "'")
strString = Replace(strString, "%3B", ";")
strString = Replace(strString, "+", " ")
strString = Replace(strString, "%22", Chr(34))
URLDecode = strString
End Function
FUNCTION bol(url)
dim sonuc(3)
parca=split(url,"\u0026")
linkinbasi=parca(0)
linkinsonu=parca(3)
tipi=split(parca(1),";")
yenitipi=split(tipi(0),"/")
sontipi=yenitipi(1)
kalite=split(parca(4),",")
yenikalite=split(kalite(0),"=")
sonkalite=yenikalite(1)
link=linkinbasi & "&" & linkinsonu
link=replace(link,"sig","signature")
sonuc(0)=link
sonuc(1)=sonkalite
sonuc(2)=sontipi
bol=sonuc
END FUNCTION
FUNCTION bulmali(kaynak,nerden,nereye)
on error resume next
dim sonuc(100)
i=0
bul_parcalar=split(kaynak,nerden)
for each bulunan_parca in bul_parcalar
bulunan=split(bulunan_parca,nereye)
sonuc(i)=bulunan(0)
i=i+1
next
bulmali=sonuc
END FUNCTION
'on error resume next
Set objX = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
objX.Open "GET",youtubelinki,False
objX.SetRequestHeader "Referer","http://www.google.com/search"
objX.SetRequestHeader "User-Agent","Opera/9.80 (Windows NT 6.1; U; tr) Presto/2.6.30 Version/10.63"
objX.SetRequestHeader "Content-Type","application/x-www-form-urlencoded;"
objX.Send
bilgi=objX.ResponseText
'Response.Write bilgi
anakelimerli_bul=bulmali(bilgi,"yt.playerConfig = {"," yt.setConfig({")
karma=URLDecode(anakelimerli_bul(1))
'//adresleri url= ifadeleri ile bölme
linkler=split(karma,"url=")
i=0
dim adres(20)
for each adresler in linkler
adres(i)=adresler
i=i+1
next
%>
<html>
<body>
</p>
<table class="ddddd" border="2" width="814" id="table1" height="35" style="border-collapse: collapse">
<%
for k=2 to i-2
deger=bol(adres(k))
if k/2 = k\2 then RENK="RED"
if k/2 <> k\2 then RENK="BLUE"
%>
<form method="POST" action="upload.asp">
<tr bgcolor=<%=RENK%>>
<td height="29" width="57" rowspan="2">ADRES</td>
<td height="29" width="569" rowspan="2" align="center">
<textarea rows="1" name="youtube" cols="55"><%=deger(0)%></textarea>
<input type="submit" value="Gönder" name="B1" style="border: 1px dotted #800080; background-color: #008080">
</td>
<td height="16" width="192">
TİP:
<input type="text" name="tip" size="12" value="<%=deger(2)%>"></td>
</tr>
<tr bgcolor=<%=RENK%>>
<td height="22" width="192">
KALİTE:<input type="text" name="T1" size="13" value="<%=deger(1)%>"></td>
</tr>
</form>
<%
next
%></body></html>
</table>
<p> </p>
<p>-----------------------------------------------------------Youtube sayfa
görüntüsü</p>
<p><%=bilgid%></p>upload.asp
<%
if request.form("youtube")="" then response.redirect "default.asp"
dim gelenlink,gelentip,yazilandosya
gelenlink=request.form("youtube")
gelentip=request.form("tip")
yazilandosya=upload(gelenlink,gelentip)
function upload(adres,tip)
Dim strDosya
Server.ScriptTimeOut = 36000000
strDosya_Adi = Now()
strDosya_Adi = Replace(strDosya_Adi, ":", "")
strDosya_Adi = Replace(strDosya_Adi, "/", "")
strDosya_Adi = Replace(strDosya_Adi, ".", "")
strDosya_Adi = Replace(strDosya_Adi, " ", "")
strGecerli_Uzanti=Request.Form("dosyatipi")
strDosya = strDosya_Adi&"." & tip
Set objX = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
objX.Open "GET",adres,False
objX.SetRequestHeader "Referer","http://www.google.com/search"
objX.SetRequestHeader "User-Agent","Opera/9.80 (Windows NT 6.1; U; tr) Presto/2.6.30 Version/10.63"
objX.SetRequestHeader "Content-Type","application/x-www-form-urlencoded;"
objX.Send
dosya = objX.ResponseBody
Set objX= Nothing
Set BinaryStream = Server.CreateObject("ADODB.Stream")
BinaryStream.Type = 1
BinaryStream.Open
BinaryStream.Write dosya
BinaryStream.SaveToFile Server.MapPath(""&strDosya&""), 2
Set BinaryStream = Nothing
upload=strDosya
Response.Write "Yüklenen dosya:"& upload
end function
%>