M3U8批量下载器 V1.4.5 http方式调用之VBA的实现
逍遥一仙的M3U8批量下载器 V1.4.5，现在还支持http调用的方式，可以说对于下载更加方便了。此时再也无需考虑如何更快更稳定的下载m3u8内容，更多的时间可以去研究网页的解析算法。
M3U8批量下载器 V1.4.5 https://www.52pojie.cn/thread-1216473-1-1.html
论坛上已有python和nodejs的调用方式
M3U8批量下载器 V1.4.5 http方式调用之Python的实现https://www.52pojie.cn/thread-1216587-1-1.html
发个M3U8批量下载器 http调用之NodeJS实现 https://www.52pojie.cn/thread-1256246-1-1.html
下面是VBA实现的方式
主函数
Sub cutepostm3u8()
Dim title As String
Dim url As String
Dim key As String
Dim data As String
'已知的标题和m3u8地址
title = "【岩石】单轴抗压强度试验"
url = "http://hls.videocc.net/fcb0a49163/9/fcb0a491634b4166ed3117a5c9f5bab9_2.m3u8"
'如果key有二次加密，则需已知原始key
key = ""
key = "gxuLoBkLDVK/IlKHop096w=="
'对请求体按要求进行拼接
If key = "" Then
data = title & "," & url
Else
data = "#KEY," & key & Chr(13) & Chr(10) & title & "," & url
End If
'按要求进行gbk编码
Dim databyte() As Byte
databyte = encodegbk(data)
'按要求进行base64编码
Dim database64 As String
database64 = b64encode(databyte)
'拼接最终请求体，并需要进行URL编码
data = "data=" & Application.WorksheetFunction.EncodeURL(database64)
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
With http
'按要求使用post方式，选择同步模式
.Open "POST", "http://127.0.0.1:8787/", False
'必须设置请求头，请求类型是提交表单
.setRequestheader "Content-Type", "application/x-www-form-urlencoded"
'发送请求体
.Send (data)
'解析响应体
Dim body() As Byte
body = .responseBody
Dim response As String
response = encoding(body, "gbk")
End With
Debug.Print response
End Sub
需要用到的自定义函数
Public Function encodegbk(body As String) As Byte() '将字符串gbk编码转换为字节数组
Dim i As Long
Dim gbkbyte() As Byte
Dim gbkl As Long
gbkl = 0
For i = 1 To Len(body)
Dim thischr As String
thischr = Mid(body, i, 1)
If Asc(thischr) < &HFF And Asc(thischr) > 0 Then
ReDim Preserve gbkbyte(0 To gbkl)
gbkbyte(gbkl) = Asc(thischr)
gbkl = gbkl + 1
Else
thischr = hex(Asc(thischr))
ReDim Preserve gbkbyte(0 To gbkl + 1)
gbkbyte(gbkl) = Application.WorksheetFunction.Hex2Dec(Mid(thischr, 1, 2))
gbkbyte(gbkl + 1) = Application.WorksheetFunction.Hex2Dec(Mid(thischr, 3, 2))
gbkl = gbkl + 2
End If
Next i
encodegbk = gbkbyte
End Function
Public Function b64encode(body() As Byte) As String
'获取字节数组长度
Dim top As Long
top = UBound(body)
'将二进制数组转换为二进制8位编码字符串
Dim byte2() As String
ReDim byte2(0 To top)
Dim temp As Long
For temp = 0 To top Step 1
byte2(temp) = Application.WorksheetFunction.Dec2Bin(body(temp), 8)
Next temp
'二进制8位编码字符串合并，并用“x”补全长度body为3的倍数的8倍
Dim bodylist As String
bodylist = Join(byte2, "")
If (top + 1) Mod 3 <> 0 Then
bodylist = bodylist & Application.WorksheetFunction.Rept("x", (3 - (top + 1) Mod 3) * 8)
End If
'将bodylist由6个一组拆分
ReDim byte2(0 To Len(bodylist) / 6 - 1)
For temp = 0 To Len(bodylist) / 6 - 1 Step 1
byte2(temp) = Mid(bodylist, temp * 6 + 1, 6)
Next temp
'将base64数组转换为base64索引
Dim base64key() As Byte
ReDim base64key(0 To Len(bodylist) / 6 - 1)
For temp = 0 To Len(bodylist) / 6 - 1 Step 1
If byte2(temp) = "xxxxxx" Then
base64key(temp) = "64"
Else
base64key(temp) = Application.WorksheetFunction.Bin2Dec(Replace(byte2(temp), "x", "0"))
End If
Next temp
'载入base64索引表
Dim Base64Char As String
Base64Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Dim arrBase64Char() As Byte
arrBase64Char = VBA.StrConv(Base64Char, vbFromUnicode)
'转换为base64编码且合并
Dim base64() As String
ReDim base64(0 To Len(bodylist) / 6 - 1)
For temp = 0 To Len(bodylist) / 6 - 1 Step 1
base64(temp) = Chr(arrBase64Char(base64key(temp)))
Next temp
'输出base64字符串
b64encode = Join(base64, "")
End Function
Public Function encoding(body() As Byte, CodeBase As String) As String
Dim ado As Object
Set ado = CreateObject("Adodb.Stream")
With ado '把提取到的数据转换编码
.Type = 1 '二进制
.mode = 3 '读写模式
.Open '打开对象
.Write body '写入需要转换编码的数据
.Position = 0 '位置的起始
.Type = 2 '字符串
.Charset = CodeBase '需转换成的编码
encoding = .readtext '编码转换结果
End With
End Function 火柴天堂0321 发表于 2020-8-29 03:04
大佬，请问 爱奇艺、腾讯视频、优酷视频 的 超前点播的付费视频如何下载，资源我都有，不想要现成的资源， ...
三家超前都是使用的wv加密，需要逆向dll找密钥，然后用Bento4工具解密。或者修改浏览器底层进行dump 谢谢楼主分享 厉害厉害小白看不懂 感谢分享~！{:1_893:} 大佬，请问 爱奇艺、腾讯视频、优酷视频 的 超前点播的付费视频如何下载，资源我都有，不想要现成的资源，我想求下载技术，付费学习也可以，求大佬帮忙 谢谢楼主分享 辛苦大佬分享了 好人一生平安 谢谢分享虽然看不懂
厉害厉害小白看不懂 感谢分享~！ 厉害了，我的楼主。
页:
[1]
2