Podcast downloader (VBScript)
An easy way to automate downloading of new podcast episodes without using iTunes or other media managers.This lightweight script is compatible with the RSS feeds of most podcasts. It parses the RSS feed and silently downloads the 10 newest audio/video files referenced in the feed, gathering the episodes in a folder, ready to be transferred to your favorite portable media player. Only new podcast episodes not already stored on your computer will be downloaded, saving bandwidth for subsequent runs.
Usage: The script takes two command line parameters: RSSFeedURL and StoreFolder
Example: The following commands will download This American Life and 99% Invisible episodes to D:\Podcasts
DownloadPodcasts.vbs "http://feeds.thisamericanlife.org/talpodcast" "D:\Podcasts"
DownloadPodcasts.vbs "http://feeds.99percentinvisible.org/99percentinvisible" "D:\Podcasts"
You can make a batch file of the above and set up a daily scheduled run for a fully automatic setup.
Save the source code below as DownloadPodcasts.vbs
Option Explicit
Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
Call DownloadPodcasts(WshArgs.Item(0), WshArgs.Item(1))
Else
wscript.echo("Wrong number of arguments." & vbcrlf & vbcrlf & _
"Function syntax: DownloadPodcasts RSSFeedURL StoreFolder")
End If
Sub DownloadPodcasts(strRssFeedURL, strFolder)
Dim i
Dim arrLinks
Dim strFilename
Const VBTextCompare = 1
arrLinks = GetAllMediaLinksFromURL(strRssFeedURL)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
For i = 0 to uBound(arrLinks)
If i < 10 Then ' Only download the first 10 media files found in the feed. Remove this 'If' if you want to download all episodes
strFilename = GetFilenameFromURL(arrLinks(i))
If strFilename <> "" Then
If Not InStr(LCase(GetFolderContents(strFolder)), "|" & LCase(strFilename) & "|") > 0 Then ' Only download file if not already on disk
Call SaveBinaryFile(BinaryGetURL(arrLinks(i)), strFolder & strFilename)
End If
End If
End If
Next
End Sub
Function GetAllMediaLinksFromURL(strURL)
Dim i
Dim j
Dim arrURLs
Dim arrFileTypes
Dim strReturn
arrFileTypes = Array( _
".mp3", ".m4a", ".m4b", ".m4p", ".m4v", ".m4r", ".aac", ".3gp", ".mp4", ".mov")
arrURLs = GetURLsFromText(GetDataFromURL(strURL, "GET", ""))
For i = 0 to UBound(arrURLs)
For j = 0 to UBound(arrFileTypes)
If InStr(arrURLs(i), arrFileTypes(j)) > 0 Then
strReturn = strReturn & arrURLs(i) & "|"
End If
Next
Next
If Len(strReturn) > 0 Then
strReturn = Left(strReturn, Len(strReturn) - 1)
End If
GetAllMediaLinksFromURL = Split(strReturn, "|")
End Function
Function GetURLsFromText(strData)
Dim regEx
Dim Match
Dim Matches
Dim strReturn
Set regEx = New RegExp
regEx.Pattern = "([\w]+?://[^ ,""\s<]*)"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strData)
For Each Match in Matches
If InStr(strReturn, Match.Value & "|") = 0 Then
strReturn = strReturn & Match.Value & "|"
End If
Next
If Len(strReturn) > 0 Then
strReturn = Left(strReturn, Len(strReturn) - 1)
End If
GetURLsFromText = Split(strReturn, "|")
End Function
Function GetDataFromURL(strURL, strMethod, strPostData)
Dim strReturn
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "podcast_downloader/1.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
strReturn = objWinHttp.ResponseText
Else
strReturn = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
strReturn = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
GetDataFromURL = strReturn
End Function
Function GetFilenameFromURL(strURL)
Dim strReturn
strReturn = Right(strURL, Len(strURL) - InStrRev(strURL, "/"))
If InStr(strReturn, "?") Then
strReturn = Left(strReturn, InStr(strReturn, "?") - 1)
End If
If InStr(strReturn, "&") Then
strReturn = Left(strReturn, InStr(strReturn, "&") - 1)
End If
GetFilenameFromURL = strReturn
End Function
Function GetFolderContents(strFolder)
Dim objFso
Dim objFolder
Dim objFile
Dim sReturn
sReturn = "|"
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FolderExists(strFolder) Then
Set objFolder = objFso.GetFolder(strFolder)
For Each objFile in objFolder.files
sReturn = sReturn & objFile.name & "|"
Next
Else
CreateFolder(strFolder)
sReturn = ""
End If
Set objFso = Nothing
GetFolderContents = sReturn
End Function
Sub CreateFolder(strFolder)
Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
objFso.CreateFolder(strFolder)
Set objFso = Nothing
End Sub
Sub SaveBinaryFile(arrByteArray, strFileName)
If VarType(arrByteArray) >= 8192 Then
Dim objBinaryStream
Set objBinaryStream = CreateObject("ADODB.Stream")
objBinaryStream.Type = 1
objBinaryStream.Open()
objBinaryStream.Write(arrByteArray)
objBinaryStream.SaveToFile strFileName, 2
End If
End Sub
Function BinaryGetURL(strURL)
Dim objWinHttp
Dim lngTimeout
Dim strMethod
Dim strPostData
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
lngTimeout = 59000 ' milliseconds.
strMethod = "GET"
strPostData = ""
strUserAgentString = "podcast_downloader/1.1"
intSslErrorIgnoreFlags = 13056 ' 13056 = ignore all err, 0 = accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
objWinHttp.Open strMethod, strURL, False
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
objWinHttp.Send(strPostData)
If (objWinHttp.Status = 200) Then
BinaryGetURL = objWinHttp.ResponseBody
End If
Set objWinHttp = Nothing
End Function
Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
Call DownloadPodcasts(WshArgs.Item(0), WshArgs.Item(1))
Else
wscript.echo("Wrong number of arguments." & vbcrlf & vbcrlf & _
"Function syntax: DownloadPodcasts RSSFeedURL StoreFolder")
End If
Sub DownloadPodcasts(strRssFeedURL, strFolder)
Dim i
Dim arrLinks
Dim strFilename
Const VBTextCompare = 1
arrLinks = GetAllMediaLinksFromURL(strRssFeedURL)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
For i = 0 to uBound(arrLinks)
If i < 10 Then ' Only download the first 10 media files found in the feed. Remove this 'If' if you want to download all episodes
strFilename = GetFilenameFromURL(arrLinks(i))
If strFilename <> "" Then
If Not InStr(LCase(GetFolderContents(strFolder)), "|" & LCase(strFilename) & "|") > 0 Then ' Only download file if not already on disk
Call SaveBinaryFile(BinaryGetURL(arrLinks(i)), strFolder & strFilename)
End If
End If
End If
Next
End Sub
Function GetAllMediaLinksFromURL(strURL)
Dim i
Dim j
Dim arrURLs
Dim arrFileTypes
Dim strReturn
arrFileTypes = Array( _
".mp3", ".m4a", ".m4b", ".m4p", ".m4v", ".m4r", ".aac", ".3gp", ".mp4", ".mov")
arrURLs = GetURLsFromText(GetDataFromURL(strURL, "GET", ""))
For i = 0 to UBound(arrURLs)
For j = 0 to UBound(arrFileTypes)
If InStr(arrURLs(i), arrFileTypes(j)) > 0 Then
strReturn = strReturn & arrURLs(i) & "|"
End If
Next
Next
If Len(strReturn) > 0 Then
strReturn = Left(strReturn, Len(strReturn) - 1)
End If
GetAllMediaLinksFromURL = Split(strReturn, "|")
End Function
Function GetURLsFromText(strData)
Dim regEx
Dim Match
Dim Matches
Dim strReturn
Set regEx = New RegExp
regEx.Pattern = "([\w]+?://[^ ,""\s<]*)"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strData)
For Each Match in Matches
If InStr(strReturn, Match.Value & "|") = 0 Then
strReturn = strReturn & Match.Value & "|"
End If
Next
If Len(strReturn) > 0 Then
strReturn = Left(strReturn, Len(strReturn) - 1)
End If
GetURLsFromText = Split(strReturn, "|")
End Function
Function GetDataFromURL(strURL, strMethod, strPostData)
Dim strReturn
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "podcast_downloader/1.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
strReturn = objWinHttp.ResponseText
Else
strReturn = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
strReturn = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
GetDataFromURL = strReturn
End Function
Function GetFilenameFromURL(strURL)
Dim strReturn
strReturn = Right(strURL, Len(strURL) - InStrRev(strURL, "/"))
If InStr(strReturn, "?") Then
strReturn = Left(strReturn, InStr(strReturn, "?") - 1)
End If
If InStr(strReturn, "&") Then
strReturn = Left(strReturn, InStr(strReturn, "&") - 1)
End If
GetFilenameFromURL = strReturn
End Function
Function GetFolderContents(strFolder)
Dim objFso
Dim objFolder
Dim objFile
Dim sReturn
sReturn = "|"
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FolderExists(strFolder) Then
Set objFolder = objFso.GetFolder(strFolder)
For Each objFile in objFolder.files
sReturn = sReturn & objFile.name & "|"
Next
Else
CreateFolder(strFolder)
sReturn = ""
End If
Set objFso = Nothing
GetFolderContents = sReturn
End Function
Sub CreateFolder(strFolder)
Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
objFso.CreateFolder(strFolder)
Set objFso = Nothing
End Sub
Sub SaveBinaryFile(arrByteArray, strFileName)
If VarType(arrByteArray) >= 8192 Then
Dim objBinaryStream
Set objBinaryStream = CreateObject("ADODB.Stream")
objBinaryStream.Type = 1
objBinaryStream.Open()
objBinaryStream.Write(arrByteArray)
objBinaryStream.SaveToFile strFileName, 2
End If
End Sub
Function BinaryGetURL(strURL)
Dim objWinHttp
Dim lngTimeout
Dim strMethod
Dim strPostData
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
lngTimeout = 59000 ' milliseconds.
strMethod = "GET"
strPostData = ""
strUserAgentString = "podcast_downloader/1.1"
intSslErrorIgnoreFlags = 13056 ' 13056 = ignore all err, 0 = accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
objWinHttp.Open strMethod, strURL, False
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
objWinHttp.Send(strPostData)
If (objWinHttp.Status = 200) Then
BinaryGetURL = objWinHttp.ResponseBody
End If
Set objWinHttp = Nothing
End Function
Page last updated 2014-11-03 18:45. Some rights reserved (CC by 3.0)