VBScript for download youtube playlist

This script download the video and the thumbnail, but is optional. Have some bugs and don't have a progress bar or signs for download data. I had a playlist of 128 videos I download 40 in a row, 47 in a row and 41 in a row; this is the only measured efficiency  i have. Ok I'm open for improvements and here it is:

Option ExplicitOn Error Resume Next'variables declarationsDim Playlist(500)Dim qDim videoTitle , oStreamDim Http , xml , pxmlDim sname , str_a , str_b ,e1 ,e2 ,e3 ,e4 ,e5 ,j ,k ,iDim comienzo , fin , word_a , wordDim ImageFile , DestFolder , ktext , ltext ,numVIDEOS ,pnameDim myERROR: myERROR = false 
 Const ForReading = 1Const adTypeBinary = 1Const adSaveCreateOverWrite = 2Const adSaveCreateNotExist = 1 Const adModeReadWrite = 3'variables declarations'functions declarationsFunction getPLAYLIST(playlistURL)	'This function get the url video page and the total of videos	Set pxml = CreateObject("Msxml2.XMLHTTP.3.0")	pxml.Open "GET", playlistURL, False, "pablojavier.medina@gmail.com", "youtube password"	pxml.Send	j=1	k = 1	q = 0	numVIDEOS = ExtractText(pxml.responseText , "<span id=""vm-num-videos-shown"">" , "</span>" , 0 , 1)	For i = 0 To numVIDEOS - 1		Playlist(i) ="http://www.youtube.com" + ExtractText(pxml.responseText , "<div class=""vm-video-title"">" , """ >" , 16 , k)		k = InStr(j, pxml.responseText , "<div class=""vm-video-title"">") + Len("<div class=""vm-video-title"">") 		j = k	Next	downloadPLAYLIST()End FunctionFunction ExtractText(kappa1, kappa2, kappa3, tao1, tao2)    'this function get video URL	ktext = InStr(tao2, kappa1, kappa2) + Len(kappa2) + tao1	ltext = InStr(ktext, kappa1, kappa3)	ExtractText = Mid(kappa1, ktext, ltext - ktext)End FunctionFunction EncodeURL(strURL)	'This encode the video url	e1 = Replace(strURL,"%2F","/")	e2 = Replace(e1,"%3F","?")	e3 = Replace(e2,"%3D","=")	e4 = Replace(e3,"%26","&")	e5 = Replace(e4,"%25","%")	EncodeURL = e5End FunctionFunction GetTitle(sText)	comienzo = InStr(sText ,".title=")	fin = InStr(comienzo ,sText ,"&amp;")	word_a = Mid(sText, comienzo + 7, fin - comienzo -7)	word = Replace(word_a ,"+" ," ")	GetTitle = Replace(word ,"%2F" ," ")End FunctionFunction currentURL(pageURL)	'This function helps for make the transition between one download to another	if IsEmpty(pageURL) then Wscript.Quit 	Set Http = CreateObject("Microsoft.XmlHttp")    Http.open "GET", pageUrl, False    Http.send    If Http.status <> 200 Then        WScript.Echo "Failed getting video page at: " & Url & vbCrLf & _                     "Error: " & Http.statusText		WScript.Quit			     End If	str_a = "http://" + ExtractText(Http.responseText, "&amp;fmt_stream_map=", "%7C%7C" , 18 , 1)	str_b = EncodeURL(str_a)	videoTitle = GetTitle(Http.responseText)	sname = "http://img.youtube.com/vi/" + Mid(pageURL ,32) + "/0.jpg" 	'In the next line u can set the download folder for example "C:\VIDEOS\YOUTUBE\vids\" 	downloadELEMENT str_b , videoTitle , "C:\VIDEOS\YOUTUBE\vids\" , ".avi" , True	downloadELEMENT sname , videoTitle , "C:\VIDEOS\YOUTUBE\thumbs\" , ".jpg" , FalseEnd FunctionFunction downloadPLAYLIST()	'this function control the whole download	If q = 0 Then		If myERROR = false Then q = q + 1		myERROR = True		currentURL(Playlist(q-1))	End If	If  q < numVIDEOS Then		If myERROR = false Then q = q + 1		myERROR = True		currentURL(Playlist(q-1))	End If	If q => numVIDEOS then WScript.QuitEnd FunctionFunction downloadELEMENT(anyURL, fileN, folderN, xtnsn, lock)	'this function download a generic file 	Set xml = CreateObject("Microsoft.XMLHTTP")	set oStream = createobject("Adodb.Stream")		xml.Open "GET", anyURL , False	xml.Send	If xml.status <> 200 And lock= True Then       	downloadPLAYLIST()	     End If	If Err.Number <> 0 Then		downloadPLAYLIST()		Err.Clear	End If	oStream.type = adTypeBinary	oStream.open 	oStream.write xml.responseBody	oStream.savetofile folderN & fileN & xtnsn, adSaveCreateNotExist	oStream.savetofile folderN & fileN & xtnsn, adSaveCreateOverWrite	oStream.close	set oStream = nothing	Set xml = Nothing	If lock= True Then		myERROR = false		downloadPLAYLIST()	End IfEnd Function'functions declarationsSub Main	pname = InputBox ("Write URL Playlist (ie: http://www.youtube.com/my_playlists?p=7B1016E1EA01BFF0)")	if IsEmpty(pname) then Wscript.Quit 	getPLAYLIST(pname)End SubMain 
 

In this update I made a better parsing so this time the title is the youtube title
and now it can get the real video type (i was using a generic .avi but is hard to extract th audio). Also I put some error handlers, but youtube has different security levels so maybe some video will not be downloaded(dont forget u need to use your own user and password on getPLAYLIST function . A progress bar can be made in html using the memory usage of WScript:

 Option Explicit Err.Clear' On Error Resume Next
Dim Playlist(500) Dim q Dim videoTitle , oStream Dim Http , xml , pxml Dim sname , str_a , str_b ,e1 ,e2 ,e3 ,e4 ,e5 ,e6 ,j ,k ,i Dim comienzo , fin , word_a , word ,x ,ltxt ,ktxt ,mtxt Dim ImageFile , DestFolder , ktext , ltext ,numVIDEOS ,pname ,mtext , htext ,kt ,lt ,t1 ,t2 Dim myERROR: myERROR = false Dim jump: jump = false dim objShell
Const ForReading = 1 Const adTypeBinary = 1 Const adSaveCreateOverWrite = 2 Const adSaveCreateNotExist = 1 
Function getPLAYLIST(playlistURL) Set pxml = CreateObject("Msxml2.XMLHTTP.3.0") pxml.Open "GET", playlistURL, False, "pablojavier.medina@gmail.com", "youtube password" pxml.Send j=1 k = 1 q = 0 numVIDEOS = ExtractText(pxml.responseText , "<span id=""vm-num-videos-shown"">" , "</span>" , 0 , 1) For i = 0 To numVIDEOS - 1 Playlist(i) ="http://www.youtube.com" + ExtractText(pxml.responseText , "<div class=""vm-video-title"">" , """ >" , 16 , k) k = InStr(j, pxml.responseText , "<div class=""vm-video-title"">") + Len("<div class=""vm-video-title"">") j = k Next downloadPLAYLIST() End Function Function ExtractTEXT(k1, k2, k3 , t1 ,t2) kt = InStr(t2, k1, k2) + Len(k2) + t1 lt = InStr(kt, k1, k3) ExtractTEXT = Mid(k1, kt , lt- kt) End Function Function ExtractURL(kappa1) ktext = InStr(kappa1, "fmt_stream_map=url%3Dhttp%253A%252F%252F") + Len("fmt_stream_map=url%3Dhttp%253A%252F%252F") mtext = InStr(ktext, kappa1, "%2526id%253D") + Len("%2526id%253D") ltext = InStr(mtext, kappa1, "%") ExtractURL = Mid(kappa1, ktext, ltext - ktext) End Function Function EncodeURL(strURL) e1 = Replace(strURL,"%25","%") e1 = Replace(e1,"%25","%") e2 = Replace(e1,"%2F","/") e3 = Replace(e2,"%3F","?") e4 = Replace(e3,"%3D","=") e5 = Replace(e4,"%26","&") e6 = Replace(e5,"%3B" , ";") e6 = Replace(e6,"%2B" , "+") EncodeURL = e6 End Function Function videoTYPE(ka1) ktxt = InStr(ka1, "fmt_stream_map=url%3Dhttp%253A%252F%252F") + Len("fmt_stream_map=url%3Dhttp%253A%252F%252F") mtxt = InStr(ktxt, ka1, "%2526id%253D") + Len("%2526id%253D") ltxt = InStr(mtxt, ka1, "type%3Dvideo%252F") + Len("type%3Dvideo%252F")	videoTYPE = "."  & Mid(ka1, ltxt, 3) End Function Function GetTitle(sText) comienzo = InStr(sText ,"<meta name=""title"" content=""") + Len("<meta name=""title"" content=""") fin = InStr(comienzo ,sText ,""">") word_a = Mid(sText, comienzo , fin - comienzo ) word = Replace(word_a ,"+" ," ") word = Replace(word ,"%26" ," ") word = Replace(word ,"%27" ," ") word = Replace(word ,"%28" ," ") word = Replace(word ,"%29" ," ") word = Replace(word ,"%7E" ," ") word = Replace(word ,"%5D" ," ") word = Replace(word ,"%5B" ," ") word = Replace(word ,"%" ," ") word = Replace(word ,"&amp" ,"&") GetTitle = Replace(word ,"%2F" ," ") End Function Function currentURL(pageURL) if IsEmpty(pageURL) then Wscript.Quit Set Http = CreateObject("MSXML2.ServerXMLHTTP.3.0") Http.open "GET", pageUrl, False Http.send If Http.status <> 200 Then WScript.Echo "Failed getting video page at: " & Url & vbCrLf & _                     "Error: " & Http.statusText		WScript.Quit End If str_a = "http://" + ExtractURL(Http.responseText) str_b = EncodeURL(CStr(str_a)) x = videoTYPE(Http.responseText) videoTitle = GetTitle(Http.responseText) set Http = nothing sname = "http://img.youtube.com/vi/" + Mid(pageURL ,32) + "/0.jpg" If jump = False Then downloadELEMENT sname , videoTitle , "C:\VIDEOS\YOUTUBE\thumbs\" , ".jpg" , False downloadELEMENT str_b , videoTitle , "C:\VIDEOS\YOUTUBE\vids\" , x , True End Function Function downloadPLAYLIST() If q = 0 Then If myERROR = false Then q = q + 1 If myERROR = false Then myERROR = True currentURL(Playlist(q-1)) End If If  q < numVIDEOS Then If myERROR = false Then q = q + 1 If myERROR = false Then myERROR = True currentURL(Playlist(q-1)) End If If q => numVIDEOS then WScript.Quit End Function Function downloadELEMENT(anyURL, fileN, folderN, xtnsn, lock) Set xml = CreateObject("MSXML2.ServerXMLHTTP.3.0") set oStream = createobject("Adodb.Stream")		xml.Open "GET", anyURL , False	xml.Send If xml.status <> 200 And lock= True Then		myERROR = True jump = True downloadPLAYLIST() End If If Err.Number <> 0 Then myERROR = True jump = True downloadPLAYLIST() End If oStream.type = adTypeBinary oStream.open oStream.write xml.responseBody oStream.savetofile folderN & fileN & xtnsn, adSaveCreateNotExist If Err.Number <> 0 Then myERROR = False jump = False q = q + 1 downloadPLAYLIST() End If oStream.savetofile folderN & fileN & xtnsn, adSaveCreateOverWrite If Err.Number <> 0 Then myERROR = False jump = False q = q + 1 downloadPLAYLIST() End If oStream.close set oStream = nothing Set xml = Nothing If lock= True Then myERROR = false jump = false downloadPLAYLIST() End If On Error GoTo 0 End Function Sub Main pname = InputBox ("Write playlist URL (ie: http://www.youtube.com/my_playlists?p=7B1016E1EA01BFF0)") if IsEmpty(pname) then Wscript.Quit getPLAYLIST(pname) End Sub Main