Option Explicit
Dim objHTTP As Object
Dim md As Date
Const err404$ = "error 404"

Sub OnsenStreamsListing()
  Dim json$, l&, c$, s$, p%, r%, a$(), b$(), i%
  Cells.ClearContents
  Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

  json = DownloadTextFromURL("https://www.onsen.ag/web_api/programs")
  For l = 1 To Len(json)
    c = Mid(json, l, 1)
    s = s & c
    Select Case c
      Case "{": p = p + 1
      Case "}": p = p - 1
                If p = 0 Then
                  r = r + 1
                  a = Split(s, ",""")
                  For i = UBound(a) To 0 Step -1
                    b = Split(a(i), """")
                    If UBound(b) >= 2 Then
                      Select Case b(0)
                        Case "title":
                            Cells(r, 1) = b(2)
                        Case "updated":
                            Cells(r, 2) = b(2)
                        Case "delivery_interval":
                            Cells(r, 3) = b(2)
                        Case "streaming_url":
                            Cells(r, 4) = b(2)
                            s = Split(b(2), "/")(6)
                            Cells(r, 5) = Split(b(2), "/")(5)
                            Cells(r, 6) = DetectStreamFile(s)
                            If Cells(r, 6) <> err404 Then Cells(r, 7) = Format(md, "'yyyy/mm/dd hh:mm:ss")
                      End Select
                    End If
                  Next
                  s = ""
                End If
    End Select
  Next

  Call Sort1
  MsgBox ("    Done.")
End Sub

Function DownloadTextFromURL$(url$)
  objHTTP.Open "GET", url, False
  objHTTP.Send
  DownloadTextFromURL = objHTTP.ResponseText
End Function

Function DetectStreamFile$(fname$)
  Dim a$(), x$, y$, b$(5), i%, j%, s$, t$
  a = Split(fname, "-")
  ReDim Preserve a(UBound(a) - 1)
  s = Join(a, "-")
  x = Left(s, Len(s) - 4)
  y = UCase(Right(s, 4))
  For i = 1 To 4
    b(i) = Mid(y, i, 1)
  Next
  For i = 1 To 4
    b(i) = LCase(b(i))
    s = x & b(1) & b(2) & b(3) & b(4) & ".mp"
    For j = 3 To 4
      t = s & j
      If httpStatus("https://onsen-dl.sslcs.cdngc.net/radio/" & t) = 200 Then
        DetectStreamFile = t
        Exit Function
      End If
    Next
    b(i) = UCase(b(i))
  Next
  DetectStreamFile = err404
End Function

Function httpStatus%(url$)
  Dim s$, a$(), n%, t As Date
  objHTTP.Open "HEAD", url, False
  On Error Resume Next
  objHTTP.Send
  n = Val(objHTTP.Status)
  httpStatus = n
  
  If n = 200 Then
    s = Split(objHTTP.GetAllResponseHeaders, "Last-Modified: ")(1)
    a = Split(s, " ")
    t = TimeValue(a(4)) + TimeValue("9:00:00")
    a(0) = ""
    ReDim Preserve a(3)
    md = DateValue(Join(a, " ")) + t
  End If
  On Error GoTo 0
End Function

Sub Sort1()
  With ActiveWorkbook.ActiveSheet.Sort
    .SortFields.Clear
    .SetRange Range("A:G")
    .SortFields.Add2 Key:=Range("E:E"), Order:=xlDescending
    .SortFields.Add2 Key:=Range("B:B"), Order:=xlDescending
    .Apply
  End With
End Sub

• Like
• LINE
• Tweet
• Copy URL