吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 5517|回复: 18
收起左侧

[其他原创] M3U8批量下载器 V1.4.5 http方式调用之VBA的实现

[复制链接]
漁滒 发表于 2020-8-29 02:34
逍遥一仙的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实现的方式
主函数
[Visual Basic] 纯文本查看 复制代码
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


需要用到的自定义函数
[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 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

免费评分

参与人数 4吾爱币 +10 热心值 +4 收起 理由
pggs666 + 1 + 1 我很赞同!
苏紫方璇 + 7 + 1 欢迎分析讨论交流,吾爱破解论坛有你更精彩!
画中画。 + 1 + 1 谢谢@Thanks!
cxb1998 + 1 + 1 我很赞同!

查看全部评分

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

 楼主| 漁滒 发表于 2020-8-29 09:17
火柴天堂0321 发表于 2020-8-29 03:04
大佬,请问 爱奇艺、腾讯视频、优酷视频 的 超前点播的付费视频如何下载,资源我都有,不想要现成的资源, ...

三家超前都是使用的wv加密,需要逆向dll找密钥,然后用Bento4工具解密。或者修改浏览器底层进行dump
iloveshe 发表于 2020-8-29 02:43
芯王宇 发表于 2020-8-29 03:01
火柴天堂0321 发表于 2020-8-29 03:04
大佬,请问 爱奇艺、腾讯视频、优酷视频 的 超前点播的付费视频如何下载,资源我都有,不想要现成的资源,我想求下载技术,付费学习也可以,求大佬帮忙
荒原love狼 发表于 2020-8-29 07:00
谢谢楼主分享
自我意识障碍 发表于 2020-8-29 07:19
辛苦大佬分享了 好人一生平安
头像被屏蔽
又要取名字 发表于 2020-8-29 07:31
提示: 作者被禁止或删除 内容自动屏蔽
bsjasd 发表于 2020-8-29 07:35
谢谢分享虽然看不懂
yu88888888 发表于 2020-8-29 07:56

厉害厉害小白看不懂 感谢分享~!
feichedang 发表于 2020-8-29 08:26
厉害了,我的楼主。
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2024-11-18 10:24

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表