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
Page last updated 2014-11-03 18:45. Some rights reserved (CC by 3.0)