一、准备

二、实干

三、等待

四、拼接

五、观影及xls工程下载

刚刚看了一个视频网站的资源，用 chrome 分析 Network 部分，发现其使用的也是 m3u8 格式

（Html源码图）

看了几位大神的文章，有说到直接用： ffmpeg -i http://www.xxx.com/xxx.m3u8 name.mp4 下载，试了下，的确很爽，可是今天另一集用 ffmpeg 爬不了了，因为切片资源格式异常问题一直报错，最终卡死了，下了 20% 不到就不动了。

无奈之下，看来得自己写一个下载 m3u8 指向的 ts 文件资源的小程序了。

一、准备

1.1 chrome

二、实干

2.1 解析取得资源文件及链接

用 chrome 分析 Network 部分，会发现有两个 m3u8 文件，为了一步到位，我们一般选择大的那个，小的其实只是指向大的这个的链接。在资源列表文件上点右键，选择打开在新标签页，这样就可以将其下载到我们的电脑上：

（图）

找到下载的 m3u8 文件，复制到你准备的工作目录，例如我的：H:\Media\m3u8download\1-08\

同时，复制这个 m3u8 文件的链接，留作下一步用：

用记事本打开下载的那个 m3u8 文件，你会发现里面实际上是个列表，但是缺少主域名路径，这就需要用到上面复制的链接地址：

去除相同部分，得到我们下面代码中需要用到的根链接： https://www.yxlmbbs.com:65

2.2 下载所用源码（启动过程 runDownload）：

在 excel 中打开 VBA 编辑程序，添加模块，填入以下代码，然后在 runDownload 内按 F5 运行即可。

Option Explicit
Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)Public Type SYSTEMTIMEwYear As IntegerwMonth As IntegerwDayOfWeek As IntegerwDay As IntegerwHour As IntegerwMinute As IntegerwSecond As IntegerwMilliseconds As Integer
End Type
'----------------获取系统完整时间例子
Public JsysData As SYSTEMTIME
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As LongPublic Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'--------所用API定义
Public Declare Function AllocConsole Lib "kernel32" () As Long
Public Declare Function FreeConsole Lib "kernel32" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Public Declare Function LstrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
'Public Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
'Public Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal dwMode As Long) As Long
Public Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
Public Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
Public Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long'-------------常量定义
'控制台输入输出句柄获取用常量
Public Const STD_INPUT_HANDLE = -10&
Public Const STD_OUTPUT_HANDLE = -11&
Public Const STD_ERROR_HANDLE = -12&
'部分前背景颜色代码，详见： 控制台色卡.png
Public Const FOREGROUND_BLUE = 9
Public Const FOREGROUND_GREEN = 10
Public Const FOREGROUND_RED = 12
Public Const FOREGROUND_INTENSITY = &H8
Public Const BACKGROUND_BLUE = &H10
Public Const BACKGROUND_GREEN = &H20
Public Const BACKGROUND_RED = &H40
Public Const BACKGROUND_INTENSITY = &H80
'设置输入模式常量 SetConsoleMode (input)
Public Const ENABLE_LINE_INPUT = &H2
Public Const ENABLE_ECHO_INPUT = &H4
Public Const ENABLE_MOUSE_INPUT = &H10
Public Const ENABLE_PROCESSED_INPUT = &H1
Public Const ENABLE_WINDOW_INPUT = &H8
'设置输出模式常量 SetConsoleMode (output)
Public Const ENABLE_PROCESSED_OUTPUT = &H1
Public Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
'-----------所需全局变量
Public hConsoleIn As Long ' 控制台输入句柄
Public hConsoleOut As Long ' 控制台输出句柄
'Public hConsoleErr As Long ' 控制台错误句柄Dim ResponseText, ResponseBodySub runDownload()Dim i, urlx, fp, fn, s, t, u() As String, dResponseText = 1ResponseBody = 2Call InitializeCall setTitle("下载 m3u8 切片资源")Call setCONColor(FOREGROUND_GREEN, 0)Call COut("----------- 开始 --------------" & vbCrLf)fp = FreeFileCall COut("----------- 加载 m3u8 列表文件 --------------" & vbCrLf)Open "H:\Media\m3u8download\1-08\index.m3u8" For Input As #fpDo While Not EOF(fp)Line Input #fp, ts = s & tDoEventsLoopClose #fpCall COut("----------- 完成！ --------------" & vbCrLf)u = Split(s, vbLf)d = UBound(u)fp = FreeFileCall COut("----------- 解析/下载切片文件开始 --------------" & vbCrLf)Open "H:\Media\m3u8download\1-08\lst1.txt" For Output As #fpFor i = 0 To dCall COut(i & "/" & d & "行：")s = Trim(Replace(u(i), vbCr, ""))If Mid(s, 1, 1) = "/" Then '此行判断根据具体文件格式而定'-----根域名链接地址 https://www.yxlmbbs.com:65urlx = "https://www.yxlmbbs.com:65" & s 'Worksheets("s1").Cells(i, 1).Value'-------指定下载文件保存位置fn = "H:\Media\m3u8download\1-08\ts\" & Mid(urlx, InStrRev(urlx, "/") + 1)Call GetDataToFile(urlx, ResponseBody, fn, True, "utf-8", "utf-8")'--------将下载的文件名生成用于 ffmpeg 拼接的列表文件 lst1.txtPrint #fp, "file '" & fn & "'"ElseCall COut("非资源行跳过！" & vbCrLf)End IfDoEventsNextClose #fpCall COut("----------- 完成！ --------------" & vbCrLf)Delay 3000Call Terminate
End SubPublic Sub GetDataToFile(Url, DataStic, fname, varAsyncX, CodePageX, saveCodePage) 'As Variant'On Error GoTo ERR:Dim XMLHTTP 'As ObjectDim DataS, GetData  ' As VariantDim DataB, fn 'As IntegerSet XMLHTTP = CreateObject("Msxml2.XMLHTTP") '"Microsoft.XMLHTTP")XMLHTTP.Open "get", Url, varAsyncX, "", "" ' TrueXMLHTTP.sendCall COut("开始下载 " & Url & "：")If varAsyncX ThenDo Until XMLHTTP.ReadyState = 4Delay 200Call COut(".")'DoEventsLoopEnd If'--------------------------------------函数返回Select Case DataSticCase ResponseText'--------------------------------直接返回字符串DataS = XMLHTTP.ResponseTextGetData = DataSCase ResponseBody'--------------------------------直接返回二进制DataB = XMLHTTP.ResponseBodyGetData = DataBCase ResponseBody + ResponseText'------------------------------二进制转字符串[直接返回字串出现乱码时尝试]DataS = BytesToStr(XMLHTTP.ResponseBody, CodePageX)GetData = DataSCase Else'--------------------------------无效的返回GetData = ""End SelectIf Len(GetData) > 1 Then'fn = FreeFile'Open fname for Output As #fn'Print #fn, GetData'Close #fnsaveFile GetData, fname, saveCodePage'-----------'MsgBox "链接：" & Url & " ," & vbCrLf & "获取内容已保存至：" & fname, vbInformation, "--OK"Else'MsgBox "链接：" & Url & " 内容失败！", vbCritical, "Err"End IfCall COut("完成，并保存至：" & fname & vbCrLf)'--------------------------------------释放空间Set XMLHTTP = Nothing
End SubPublic Function BytesToStr(strBody, CodeBase)
Dim objStream
Set objStream = CreateObject("Adodb.Stream")
With objStream.Type = 1.Mode = 3.Open.Write strBody.Position = 0.Type = 2.Charset = CodeBaseBytesToStr = .ReadText.Close
End With
Set objStream = Nothing
End FunctionPublic Function saveFile(data, recfilen, CodePage)Dim fxt, txt, AstreamSet Astream = CreateObject("Adodb.Stream") 'asp Server.CreateObject("Adodb.Stream")fxt = Mid(recfilen, InStrRev(recfilen, ".") + 1)txt = FalseIf fxt = "asp" Or fxt = "xml" Or fxt = "aspx" Or fxt = "php" Or fxt = "txt" Or fxt = "jsp" Or fxt = "htm" Or fxt = "html" Or fxt = "js" Thentxt = TrueEnd IfIf txt ThenAstream.Type = 2 '1 bin,2 txtElseAstream.Type = 1 '1 bin,2 txtEnd IfAstream.Mode = 3 '     adModeRead　=1'　　adModeReadWrite =3'　　adModeRecursive =4194304'　　adModeShareDenyNone =16'　　adModeShareDenyRead =4'　　adModeShareDenyWrite =8'　　adModeShareExclusive =12'　　adModeUnknown　=0'　　adModeWrite　=2Astream.Open'Astream.CharSet = "GB2312"'Astream.LoadFromFile(recfilen) '装载文件'Assp=Astream.sizeAstream.Position = 0 '装载文件时设置为Assp'Astream.Writetext tmpstr00,1If txt Then'data=BytesToStr(data)Astream.Charset = CodePage '  "GB2312"Astream.Writetext data, 1'Astream.CharSet = "GB2312"ElseAstream.Write dataEnd If'msgbox recfilenAstream.SaveToFile recfilen, 2' "F:\temp\a.jpg",2Astream.CloseSet Astream = Nothing
End Function'
'    '延时函数
'
Public Sub Delay(DelayNum As Long) '毫秒Dim Ctr1, Ctr2, Freq As CurrencyDim Start As Long ', Stime2 As SingleIf QueryPerformanceFrequency(Freq) ThenQueryPerformanceCounter Ctr1DoSleep 1DoEventsQueryPerformanceCounter Ctr2Loop While (Ctr2 - Ctr1) / Freq * 1000 < DelayNumElse
'        MsgBox "不支持高精度计数器!"'设定开始时间Start = timeGetTimeDo While timeGetTime < Start + DelayNumSleep 1DoEventsLoopEnd If
End Sub'---------定义函数
Public Sub Initialize() '---初始化获取句柄Call AllocConsole'获得控制窗口的句柄'hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)'hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
End SubPublic Sub Terminate() '-----销毁句柄Call FreeConsole ' Destroy the console'Call CloseHandle(hConsoleIn)Call CloseHandle(hConsoleOut)
End SubPublic Sub COut(szOut As String)   '------文字输出到控制台函数WriteConsole hConsoleOut, szOut, LstrLen(szOut), vbNull, vbNull
End SubPublic Sub setTitle(s As String)SetConsoleTitle s '设置窗口标题 '获得控制窗口的句柄
End SubPublic Sub setCONColor(ByVal f As Long, ByVal b As Long) '---设置文字和背景显示颜色If b >= 0 And b <= 15 ThenIf f >= 0 And f <= 15 Thenb = b * &H10SetConsoleTextAttribute hConsoleOut, f Or bElse'MsgBox "输入的文字颜色代码错误！颜色代码详见：控制台色卡.png", vbCritical, "错误"End IfElse'MsgBox "输入的背景颜色代码错误！颜色代码详见：控制台色卡.png", vbCritical, "错误"End If
End Sub

根据您的网速和视频资源总大小，下载时间不定。为了便于观看进度，上面使用了控制台窗口输出工作进程。

最后，有人会问，为什么不直接用 VB6 来跑上面的进程呢？

因为，win7 x64 用不了 VB6 ，我又懒得开虚拟机，而这个程序主要是下载文件，并不复杂，所以，偷个懒，能在 excel 里面运行的程序我现在都是尽量在 excel 的 VBA 环境来运行了，实属无奈。同时，现在调试一些 VBS 程序或 ASP 程序我也是用 excel + VBA 。

三、等待

执行上面的代码，然后等待......

四、拼接

源码执行下载时，顺便生成了 ffmpeg 拼接用的列表文件，如： lst1.txt ，视频输出文件名为暂定为 Out.mp4

启动 cmd.exe 切换到前面的工作目录 H:\Media\m3u8download\1-08\ ，即生成的 lst1.txt 所在目录，执行 ffmpeg 拼接命令：

ffmpeg -y -f concat -safe 0 -i lst1.txt -s 1080x806 -vcodec h264 -vf fps=25,format=yuv420p -b 1500000 Out.mp4

20220809修改：由于对 ffmpeg 不熟悉，发现以上拼接命令严重问题，即：对原视频进行了重编码，这肯定不好，于是找到直接拼接的参数，不再重编码，快多了：

ffmpeg -y -f concat -safe 0 -i lst1.txt -c copy out.mp4

然后就等待 ffmpeg 慢慢拼接吧！

五、观影及xls工程下载

播放视频，查看拼接是否正确。

若您懒得自己做上面的代码，也可以直接下载我做好的 xls 文件：excelVBA下载m3u8资源.zip-VB文档类资源-CSDN下载，将上面说到的工作目录和根链接地址填入，点击“下载 M3U8”按钮即可，打开这个 xls 文件时记得选择允许运行宏即可：

此记！

‘-------------------------------------------

20220809 修正拼接参数 bug

用 chrome + excel + VBA + XMLHTTP 爬视频网站 video 标签中的 blob:http m3u8 视频资源，ffmpeg 拼接资源相关推荐

视频网站中video标签中blob:http
视频网站中video标签中blob:http 一.问题场景想下载知乎视频资源,却发现视频链接是这个样子的 blob:https://v.vzuu.com/b6146956-6e52-406d-890 ...
html video标签播放直播视频,HTML5 Video 标签播放及控制视频
Video 是 HTML5 中新增的标签,使用 Video 标签可以播放 ogg.mp4.webm 等格式的视频,Video 标签的引入,减少前端页面对 Flash 动画的依赖. 0x0 预备知识不 ...
[html] 说说video标签中预加载视频用到的属性是什么？
[html] 说说video标签中预加载视频用到的属性是什么? 个人简介我是歌谣,欢迎和大家一起交流前后端知识.放弃很容易, 但坚持一定很酷.欢迎大家一起讨论主目录与歌谣一起通关前端面试题
【实战问题】【3】iPhone无法播放video标签中的视频
问题:视频都是MP4格式,视频可以在手机上正常播放.video标签中的视频在安卓点击可以播放,但在iPhone无法播放解决方案: 1,视频编码格式问题,具体iPhone手机支持的是哪些格式可见官方的 ...
html网站video标签blob视频如何下载
在淘宝或tdtu知乎等有时想下载里面的视频资源,看了一下视频标签里的video不是MP4格式url,而是blob+url的方式. 是blob:https并不是一种协议,而是html5中blob对象在赋 ...
如何下载视频网站中video标签中的视频资源以blob:http开头的地址的资源
一.问题场景想下载知乎视频资源,却发现视频链接是这个样子的 blob:https://v.vzuu.com/b6146956-6e52-406d-8909-f3f1b81ae461 当时一脸懵比啊 ...
视频网站中video标签中的视频资源以blob:http呈现的探索
一.问题场景想下载知乎视频资源,却发现视频链接是这个样子的 blob:https://v.vzuu.com/b6146956-6e52-406d-8909-f3f1b81ae461 当时一脸懵比啊 ...
下载链接中带有blob:https的视频文件
想下载某酷上的视频资源,想当然的像下载图片一样:在浏览器找到图片的地址然后直接下载就行了呗.却发现https路径前带有blob: blob:https并不是一种协议,而是html5中blob对象在赋给 ...
如何下载video标签中的视频资源以blob:http开头地址的资源m3u8
一.问题场景想下载知乎视频资源,却发现视频链接是这个样子的 blob:https://v.vzuu.com/b6146956-6e52-406d-8909-f3f1b81ae461 当时一脸懵比啊 ...

用 chrome + excel + VBA + XMLHTTP 爬视频网站 video 标签中的 blob:http m3u8 视频资源，ffmpeg 拼接资源

一、准备

二、实干

三、等待

四、拼接

五、观影及xls工程下载

用 chrome + excel + VBA + XMLHTTP 爬视频网站 video 标签中的 blob:http m3u8 视频资源，ffmpeg 拼接资源相关推荐

最新文章

热门文章