VBA调用 M3U8批量下载器方式实现下载加密m3u8

前面有一篇文章说到，可以用VBA的http方式调用M3U8批量下载器 V1.4.5https://www.52pojie.cn/thread-1256288-1-1.html
但是这种方式只能对链接进行post，如果遇到是对m3u8内容加密的，那么这种方式就无效了。

在对于前一篇文章说到https://www.52pojie.cn/thread-1258605-1-1.html，是对m3u8内容加密的，那么这种情况如何使用http方式调用M3U8批量下载器 V1.4.5进行下载呢？

首先根据上一篇文章，已经对m3u8内容进行解密了，这里就详细说如何postm3u8内容
[Visual Basic] 纯文本查看 复制代码Sub cutepostdata()
Dim htmlurl As String
Dim body() As Byte
Dim response As String
\’目标网站
htmlurl = "https://www.h2sheji.com/demo/player/dplayer/drm.php?utype=m3u8&url=https://www.h2sheji.com/demo/player/m3u8/drmss.m3u8"
Dim http As Object
\’获取网页源代码
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
With http
.Open "GET", htmlurl, False
.Send
body = .responseBody
response = encoding(body, "utf-8")
End With
Dim reg As Object
Dim m3u8url As String
\’正则匹配m3u8地址
Set reg = CreateObject("VbScript.regexp") \’创建正则项目
With reg
.Pattern = "\’vurl\’:\’.+(?=,)" \’正则表达式
m3u8url = .Execute(response)(0)
End With
m3u8url = Mid(m3u8url, 9, Len(m3u8url) – 9)
\’获取m3u8文本
With http
.Open "GET", m3u8url, False
.Send
body = .responseBody
response = encoding(body, "utf-8")
End With
Dim m3u8text As String
\’根据js替换字符串
m3u8text = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(response, "_", "A"), "-", "h"), "*", "I"), "!", "N"), "@", "O"), "(", "s"), ")", "X"), "/", "B")
\’base64解码
m3u8text = encoding(b64decode(m3u8text), "utf-8")
\’根据要求要构建一个json，因为vba无法进行对象的反序列化（如果有大佬会的，可以在评论区教我，先谢谢），所以用最原始的方式拼接字符串
Dim data As String
data = "{""data"":""" & m3u8text & """}"
Dim title As String
title = "demodrm"
\’根据要求对内容进行gbk编码,然后base64编码，最后加上"base64:"的前缀
data = "base64:" & b64encode(encodegbk(data))
\’根据要求对标题和内容进行拼接
data = title & "," & data
\’根据要求再次对内容进行gbk编码,然后base64编码，拼接最终的请求体，并需要进行URL编码
data = "data=" & Application.WorksheetFunction.EncodeURL(b64encode(encodegbk(data)))
With http
\’按要求使用post方式，选择同步模式
.Open "POST", "http://127.0.0.1:8787/", False
\’必须设置请求头，请求类型是提交表单
.setRequestheader "Content-Type", "application/x-www-form-urlencoded"
\’发送请求体
.Send (data)
\’解析响应体
body = .responseBody
response = encoding(body, "gbk")
End With
Debug.Print response
End Sub

其中需要用到的自定义函数
[Visual Basic] 纯文本查看 复制代码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 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
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 b64decode(body As String) As Byte()
\’获取base64字符串长度
Dim top As Long
top = Len(body)
\’载入base64索引表
Dim Base64Char As String
Base64Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
\’将base64字符串切分为base64索引数组
Dim base64()
ReDim base64(0 To top – 1)
Dim temp As Long
For temp = 0 To top – 1 Step 1
base64(temp) = InStr(1, Base64Char, Mid(body, temp + 1, 1), vbBinaryCompare) – 1
Next temp
\’将索引转换为二进制6位字符串
For temp = 0 To top – 1 Step 1
If base64(temp) = 64 Then
base64(temp) = "xxxxxx"
Else
base64(temp) = Application.WorksheetFunction.Dec2Bin(base64(temp), 6)
End If
Next temp
\’合并二进制6位字符串且去除尾部填充
Dim base64list As String
base64list = Replace(Join(base64, ""), "x", "")
If Len(base64list) Mod 8 <> 0 Then
base64list = Left(base64list, (Len(base64list) \\ 8) * 8)
End If
\’将bodylist由8个一组拆分
ReDim base64(0 To Len(base64list) / 8 – 1)
For temp = 0 To Len(base64list) / 8 – 1 Step 1
base64(temp) = Mid(base64list, temp * 8 + 1, 8)
Next temp
\’将二进制8位编码字符串转换为字节数组
Dim bytes() As Byte
ReDim bytes(0 To Len(base64list) / 8 – 1)
For temp = 0 To Len(base64list) / 8 – 1 Step 1
bytes(temp) = Application.WorksheetFunction.Bin2Dec(base64(temp))
Next temp
\’输出字节数组
b64decode = bytes
End Function

语美@五元普通

收藏 海报 链接