I wrote a program that can scan any of our threads for Youtube videos and add them to a playlist. For me, it makes it much more convenient to explore all the stuff people have posted. Although right now SoundCloud isn’t supported. If enough people care, I will look into figuring out a solution for it.
YouTube provides the capability via their public API. Unfortunately, the way it works is users are assigned a daily allowable usage quota which means I can only add 200 videos a day. So it will take a while to create most of the playlists.
For those curious, here’s the code which is written in VB .NET. I highly recommend using Python instead if anyone wants to mess around with the YouTube API.
Program Code
'This code is only ran within Visual Studio since input parameters are hardcoded.
Imports System.IO
Imports System.Threading
Imports Google.Apis.Auth.OAuth2
Imports Google.Apis.Services
Imports Google.Apis.YouTube.v3
Imports Google.Apis.YouTube.v3.Data
Imports HtmlAgilityPack
Module Module1
Sub Main()
Dim StopPost As Integer = 36 'This must be the final post number from HTML\
Dim StartPost As Integer = 1
Dim ThreadURL As String = "https://forum.hifiguides.com/t/guitar-instrumental/17238"
Dim PlaylistID As String = "PLZwSmpHx8xQnoz0vD1_lF6o65GNr2IAwt"
'ONLY IF CREATING A NEW PLAYLIST
Dim CreatePlaylist As Boolean = True
Dim PlaylistName As String = "HFG Instrumental Guitar Thread"
Dim PlaylistDescription As String = "Last updated on 6/19/2021"
Dim IDarr(0 To 20000) As String, PostTrackingArr(0 To 20000) As Integer, VideoInsertStatusArr(0 To 20000) As Boolean
ReadHFG(StopPost, StartPost, IDarr, ThreadURL, PostTrackingArr)
Dim Cred As UserCredential
Dim FS As New FileStream("C:\client_secret.json", FileMode.Open, FileAccess.Read)
Cred = GoogleWebAuthorizationBroker.AuthorizeAsync(GoogleClientSecrets.Load(FS).Secrets, {YouTubeService.Scope.Youtube}, "user", CancellationToken.None).Result
Dim YTservice As New YouTubeService(New BaseClientService.Initializer() With {.HttpClientInitializer = Cred, .ApplicationName = "YTserviceTest"})
Dim PL As New Playlist, PLitem As New PlaylistItem
If CreatePlaylist = True Then
PL.Snippet = New PlaylistSnippet
PL.Snippet.Title = PlaylistName
PL.Snippet.Description = PlaylistDescription
PL.Status = New PlaylistStatus
PL.Status.PrivacyStatus = "public"
PL = YTservice.Playlists.Insert(PL, "snippet,status").Execute
PLitem.Snippet = New PlaylistItemSnippet
PLitem.Snippet.PlaylistId = PL.Id
PLitem.Snippet.ResourceId = New ResourceId
PLitem.Snippet.ResourceId.Kind = "youtube#video"
Else
PLitem.Snippet = New PlaylistItemSnippet
PLitem.Snippet.PlaylistId = PlaylistID
PLitem.Snippet.ResourceId = New ResourceId
PLitem.Snippet.ResourceId.Kind = "youtube#video"
End If
Dim i As Integer = 0
Do While IDarr(i) IsNot Nothing
PLitem.Snippet.ResourceId.VideoId = IDarr(i)
ADD_VIDS:
Try
YTservice.PlaylistItems.Insert(PLitem, "snippet").Execute()
Debug.Print("Video " & IDarr(i) & " Added")
VideoInsertStatusArr(i) = True
Catch ex As Exception
If InStr(ex.Message, "Google.Apis.Requests.RequestError" & vbCrLf & "The request cannot be completed because you have exceeded your") > 0 Then
Debug.Print("Quota Limit Reached")
Debug.Print("Video Stopped on Post " & PostTrackingArr(i))
Stop
Exit Sub
End If
If InStr(ex.Message, "Internal error encountered. [500]") > 0 Then
Stop 'Will try adding again
GoTo ADD_VIDS
End If
Debug.Print(ex.Message)
Debug.Print("VIDEO FAILED TO ADD: " & IDarr(i))
VideoInsertStatusArr(i) = False
End Try
i = i + 1
Loop
Stop
End Sub
Sub ReadHFG(ByVal EndPost As Integer, ByVal StartPost As Integer, ByRef YT_IDarr() As String, ByVal ThreadURL As String, ByRef PostTrackingArr() As Integer)
Dim QueueSize As Integer = 14
Dim web As New HtmlWeb, PageHTML As String
Dim doc As HtmlDocument
Dim HFGpostArr() As String = New String(EndPost - StartPost) {}
Dim i As Integer, HTMLreads As Integer, arr() As String, EndPostChunk As Integer
HTMLreads = Math.Ceiling(CDbl(EndPost - StartPost) / QueueSize)
Dim URLpostNum As Integer
For i = 0 To HTMLreads - 1
URLpostNum = StartPost + i * QueueSize
doc = web.Load(ThreadURL & "/" & URLpostNum)
PageHTML = doc.DocumentNode.InnerHtml
If i = HTMLreads - 1 Then
'EndPostChunk = StartPost - 1 + i * QueueSize + EndPost Mod QueueSize
EndPostChunk = EndPost
Else
EndPostChunk = StartPost + (i + 1) * QueueSize - 1
End If
arr = SeparateHFGposts(PageHTML, StartPost + i * QueueSize, EndPostChunk)
Array.Copy(arr, 0, HFGpostArr, 0 + i * QueueSize, arr.Length)
Next i
Dim Pa As Integer, x As Integer, str As String, k As Integer, j As Integer
For i = 0 To HFGpostArr.Length - 1
'If StartPost + i = 108 Then Stop
x = 1
Pa = 1
Do While Pa > 0
Pa = InStr(x, HFGpostArr(i), "data-youtube-id=""",)
If Pa > 0 Then
YT_IDarr(j) = Mid(HFGpostArr(i), Pa + 17, 11)
PostTrackingArr(j) = i + StartPost
j = j + 1
x = Pa + 31
End If
Loop
Pa = 1
x = 1
Do While Pa > 0
Pa = InStr(x, HFGpostArr(i), "youtube.com/embed/",)
If Pa > 0 Then
x = Pa + 60
YT_IDarr(j) = Mid(HFGpostArr(i), Pa + 18, 11)
If YT_IDarr(j) = "videoseries" Then Continue Do
PostTrackingArr(j) = i + StartPost
j = j + 1
End If
Loop
Pa = 1
x = 1
k = 1
Do While Pa > 0
Pa = InStr(x, HFGpostArr(i), "https://www.youtube.com/watch?v=",)
If Pa > 0 Then
str = Mid(HFGpostArr(i), Pa + 32, 11)
x = Pa + 44
If j > 0 Then
k = 1
While PostTrackingArr(j - k) = i + StartPost ' code is for checking for duplicate ID's within the same post
If str = YT_IDarr(j - k) Then
Continue Do
End If
k = k + 1
If j - k < 0 Then Exit While
End While
YT_IDarr(j) = str
PostTrackingArr(j) = i + StartPost
j = j + 1
Else
YT_IDarr(j) = str
PostTrackingArr(j) = i + StartPost
j = j + 1
End If
End If
Loop
Next i
End Sub
Function SeparateHFGposts(ByVal HTML As String, StartPost As Integer, EndPost As Integer) As String()
Dim arr() As String = New String(EndPost - StartPost) {}
Dim i As Integer, SearchStr1 As String, SearchStr2 As String, post As Integer, Pa As Integer, Pb As Integer
For i = 0 To EndPost - StartPost
post = StartPost + i
SearchStr1 = "'position'>#" & post
SearchStr2 = "<meta itemprop='headline'"
Pa = InStr(1, HTML, SearchStr1) 'InStr(Pb, HTML, SearchStr1)
If Pa = 0 Then 'Post numbers apparently get skipped when posts are deleted
arr(i) = ""
Continue For
End If
Pb = InStr(Pa, HTML, SearchStr2)
If Pb = 0 Then
Pb = HTML.Length
End If
arr(i) = Mid(HTML, Pa + 10, Pb - Pa)
HTML = HTML.Remove(1, Pa - 20) 'neseccary to shorten the string because .NET string function can only index using 32bit integers
Next i
Return arr
End Function
End Module