No title
VisualBasic
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