[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创代码] [Perl]P站视频下载

P站大家懂的  

用到的模块:
JE (Javascript解析库)
Mojolicious (网络)

使用方法,将指定视频网址末尾15位的keyword复制放到 @list 数组中。以及找到Agent的地址更新到proxy设置
  1. use utf8;
  2. use Encode;
  3. use JE;
  4. use Modern::Perl;
  5. use File::Slurp;
  6. use Mojo::UserAgent;
  7. use Win32::Unicode::File;
  8. use JSON qw/from_json to_json/;
  9. STDOUT->autoflush(1);
  10. my $JE = new JE;
  11. my $ua = Mojo::UserAgent->new();
  12. init_ua();
  13. my %headers;
  14. init_headers(\%headers);
  15. # 这里放准备下载的 keyword 清单
  16. my @list = qw/
  17. ph60e6662d3221e
  18. ph5dc9ba7f1b...
  19. /;
  20. grep { getVideo($_) } @list;
  21. sub getVideo
  22. {
  23.     my $viewkey = shift;
  24.     my $url = "https://cn.pornhub.com/view_video.php?viewkey=${viewkey}";
  25.     my $res = $ua->get( $url )->result;
  26.     #print $html->body;
  27.     my $js = $res->dom->at(".video-wrapper script")->all_text;
  28.     my $id = $res->dom->at("#player")->attr("data-video-id");
  29.     my $title = $res->dom->at("title")->text; #unicode
  30.     $title =~s/\s+- Pornhub\.com//i;
  31.     $title =~s/[\\\/:*?"<>|]/ /g; #替换部分windows文件名不支持的字符
  32.     printf "%s %s\n", $id, gbk($title);
  33.     my $file = "E:/迅雷下载/${viewkey} ${title}.mp4";
  34.     if ( file_type( 'e' => $file ) ) {
  35.         printf "%s: file already exists\n", $viewkey;
  36.         return;
  37.     }
  38.     write_file("src.js", $js);
  39.     $JE->eval( $js );
  40.     my $x = $JE->value;
  41.     # 第三个节点对应 720P,->value 转换为Perl字符串
  42.     my $videolink = $x->{"qualityItems_${id}"}[2]{"url"}->value;
  43.     say $videolink;
  44.     my $tx = $ua->get( $videolink );
  45.     print $tx->error ? "\nDownloading failed: ".$tx->error->{message} : "\nDownloading finished!\n";
  46.     my $fh = Win32::Unicode::File->new("wb", $file);
  47.     $fh->write( $tx->result->body );
  48.     $fh->close();
  49. }
  50. sub init_headers
  51. {
  52.     my $ref = shift;
  53.     %$ref =  
  54.     (
  55.     'accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng',
  56.     'accept-encoding' => 'gzip, deflate, br',
  57.     'accept-language' => 'zh-CN,zh;q=0.9,zh-TW;q=0.8',
  58.     'user-agent' => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/93.0.4577.82 Safari/537.36',
  59.     );
  60. }
  61. sub init_ua
  62. {
  63.     $ua = $ua->max_redirects(5);
  64.     $ua = $ua->connect_timeout(10);
  65.     # Proxy server to use for HTTPS and WebSocket requests.
  66.     # https://docs.mojolicious.org/Mojo/UserAgent/Proxy#https
  67.     $ua->proxy->https("http://sri:secret\@127.0.0.1:10809")->http("http://sri:secret\@127.0.0.1:10809");
  68.     # 代理的具体地址,在代理工具设置、菜单中寻找
  69.     # 进度显示
  70.     $ua->on(start => sub {
  71.         my ($ua, $tx) = @_;
  72.         $tx->req->once(finish => sub {
  73.             $tx->res->on(progress => sub {
  74.                 state $prev = 0;
  75.                 my $msg = shift;
  76.                 return unless my $len = $msg->headers->content_length;
  77.                 my $size = $msg->content->progress;
  78.                 my $progress = int($size / ($len / 100));
  79.                 if ( $progress ne $prev ) {
  80.                     printf "%d%%\t", $progress;
  81.                 }
  82.                 $prev = $progress;
  83.             });
  84.         });
  85.     });
  86. }
  87. sub gbk { encode('gbk', $_[0]) }
  88. sub utf8 { encode('utf8', $_[0]) }
  89. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  90. sub uni { decode('utf8', $_[0]) }
复制代码
2

评分人数

2021-11 更新 m3u8 片段下载+合并的代码 RE: [Perl]P站视频下载

本帖最后由 523066680 于 2021-12-12 23:59 编辑
  1. =info
  2.     Author: 523066680
  3.       Date: 2021-11
  4.     P站m3u8视频片段批量下载+合并
  5.     11月更新后不再出现直接的视频地址,所以只能从m3u8清单下载了。
  6.     需要用到的重点模块:
  7.         Mojolicious
  8.         JE
  9.         Win32::Unicode:File
  10.    
  11.     需要有第三方命令工具:
  12.         ffmpeg.exe
  13. =cut
  14. use utf8;
  15. use Encode;
  16. use JE;
  17. use Modern::Perl;
  18. use File::Slurp;
  19. use Mojo::UserAgent -signatures;
  20. use Win32::Unicode::File;
  21. use JSON qw/from_json to_json/;
  22. STDOUT->autoflush(1);
  23. my $JE = new JE;
  24. my $ua = Mojo::UserAgent->new()->with_roles('+Queued');
  25. my $loop = Mojo::IOLoop->singleton;
  26. $loop   = $loop->max_accepts(3);
  27. $loop   = $loop->max_connections(3);
  28. $ua->max_active(5); # 最大在线同时请求数量
  29. init_ua();
  30. my %headers;
  31. init_headers(\%headers);
  32. my @list = qw/
  33. ph61668f9c9____视频ID1
  34. ph61668f9c9____视频ID2
  35. /;
  36. grep { getVideo($_) } @list;
  37. sub getVideo
  38. {
  39.     my $viewkey = shift;
  40.     my $url = "https://cn.{P站}.com/view_video.php?viewkey=${viewkey}";
  41.     my ( $title, $major, $m3u8_content ) = get_m3u8( $url );
  42.     my $cache = gbk("E:/temp/ts");
  43.     my $file = "E:/temp/${viewkey} ${title}.mp4"; #unicode
  44.     if ( file_type( 'e' => $file ) ) {
  45.         printf "%s: file already exists\n", $viewkey;
  46.         return;
  47.     }
  48.     mkdir $cache unless -e $cache;
  49.     my $buff = ""; #保存清单,用于ffmpeg合成视频
  50.     for my $e ( grep { /^seg/ } split(/\r?\n/, $m3u8_content) )
  51.     {
  52.         $e=~/(seg.*\.ts)/;
  53.         $buff .= "file ${1}\r\n";
  54.         my $tsfile = $cache ."/". $1;
  55.         # 考虑个别片段下载失败的情况,临时判断是10240byte.
  56.         # 最好是用 head 请求获取文件的实际大小做判断
  57.         #unless ( -e $tsfile and ( (-s $tsfile) > 10240 ) ) {
  58.             $ua->get( $major . $e, closure->($tsfile) );
  59.         #} else {
  60.         #    printf "File already exists: %s\n", $e;
  61.         #}
  62.     }
  63.     $loop->start unless $loop->is_running;
  64.     write_file( $cache ."/". "content.txt", $buff);
  65.     if ( -e "$cache/temp.mp4" )
  66.     {
  67.         printf "temp.mp4 already exists ? \n";
  68.         unlink "$cache/temp.mp4" if -e "$cache/temp.mp4";
  69.     }
  70.     system("ffmpeg -y -f concat -i \"$cache/content.txt\" -vcodec h264_nvenc -vb 2M \"$cache/temp.mp4\"");
  71.     moveW decode('gbk', "$cache/temp.mp4"), $file or warn $!;
  72.     # 基于某种原因,temp.mp4可能没有移除?下载多个视频时,前面视频的ffmpeg操作被忽略,直接进行了 moveW
  73.     # 可能是判断问题或者上一次中断导致没有删除temp.mp4   
  74.     # if ( ! -e "$cache/temp.mp4" ) {
  75.     #     system("ffmpeg -y -f concat -i \"$cache/content.txt\" -vcodec h264_nvenc -vb 2M \"$cache/temp.mp4\"");
  76.     # }
  77.     # moveW decode('gbk', "$cache/temp.mp4"), $file or warn $!;
  78. }
  79. sub get_m3u8
  80. {
  81.     my ($url) = @_;
  82.     my $res = $ua->get( $url )->result;
  83.     #print $html->body;
  84.     my $js = $res->dom->at(".video-wrapper #player script")->all_text;
  85.     my $id = $res->dom->at("#player")->attr("data-video-id");
  86.     my $title = $res->dom->at("title")->text; #unicode
  87.     $title =~s/\s+- P...hub\.com//i;
  88.     $title =~s/[\\\/:*?"<>|]/ /g; #替换部分windows文件名不支持的字符
  89.     printf "%s %s\n", $id, gbk($title);
  90.     # 获取 m3u8 实际地址
  91.     $JE->eval( $js );
  92.     # media_3 对应 720P,->value 转换为Perl字符串
  93.     my ($master_m3u8_url) = $JE->{"media_3"}->value;
  94.     $res = $ua->get( $master_m3u8_url )->result;
  95.     my ($major) = ($master_m3u8_url =~ /(.+\/)[^\/]+$/);  # m3u8 链接主地址 末尾已经包含/
  96.     write_file("master.m3u8", $res->body);
  97.     my ($index_m3u8) = ($res->body =~ /(index.+)\s/i);    # 获取索引文件
  98.     printf "%s\n", $major . $index_m3u8;                  # 主地址+尾部详细地址
  99.     $res = $ua->get( $major . $index_m3u8 )->result;
  100.     write_file("index.m3u8", $res->body);
  101.     return ($title, $major, $res->body);
  102. }
  103. sub closure ($file)
  104. {
  105.     return
  106.     sub ($ua, $tx) {
  107.         printf "%s\n", $file;
  108.         if ( $tx->result->is_success ) { # 如果失败则不写入文件
  109.             write_file( $file, {binmode=>":raw"}, $tx->result->body );
  110.         } else {
  111.             die "Failed to get segment $file\n";
  112.         }
  113.     }
  114. }
  115. sub init_headers
  116. {
  117.     my $ref = shift;
  118.     %$ref =  
  119.     (
  120.     'accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9',
  121.     'accept-encoding' => 'gzip, deflate, br',
  122.     'accept-language' => 'zh-CN,zh;q=0.9,zh-TW;q=0.8',
  123.     'upgrade-insecure-requests' => '1',
  124.     'user-agent' => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/93.0.4577.82 Safari/537.36',
  125.     );
  126. }
  127. sub init_ua
  128. {
  129.     $ua = $ua->max_redirects(5);
  130.     $ua = $ua->connect_timeout(10);
  131.     # 设置代理
  132.     # Proxy server to use for HTTPS and WebSocket requests.
  133.     # https://docs.mojolicious.org/Mojo/UserAgent/Proxy#https
  134.     $ua->proxy->https("http://sri:secret\@127.0.0.1:10809")->http("http://sri:secret\@127.0.0.1:10809");
  135.     #$ua->proxy(["http", "https"], "socks://127.0.0.1:1080");
  136. }
  137. sub gbk { encode('gbk', $_[0]) }
  138. sub utf8 { encode('utf8', $_[0]) }
  139. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  140. sub uni { decode('utf8', $_[0]) }
复制代码
为了避嫌,其中的关键网址 用 {P站} 代替,所以脚本并不能直接运行,需要自行替换。
但是我猜很少有人会真的下载,所以就当是刷一下存在感了。
1

评分人数

TOP

本帖最后由 523066680 于 2021-10-11 15:46 编辑

回复 8# slimay

     外贸赚钱,我不赚钱
跑题跑远了。

众所周知P站是一个学习网站,大胆补一张P站的截图

TOP

回复 7# 523066680
外贸赚钱吗

TOP

回复 6# slimay

     小小脚本,拿来冒泡,不足挂齿

TOP

回复 3# 523066680


脚本不错

TOP

回复 4# 老刘1号
老刘, 你多会成了音视频专业户了, 厉害啊

TOP

回复 2# slimay


    安卓缓存目录,拿ffmpeg合并一下音视频流就可以了

TOP

本帖最后由 523066680 于 2021-10-10 17:42 编辑

回复 2# slimay

    B站没试过,之前用手机保存本地(格式好像要手动改一下,音频也是独立的),从手机复制出来

油猴好像有现成脚本
https://greasyfork.org/zh-CN/scripts/413228-bilibili视频下载

TOP

B站视频怎么搞.

TOP

返回列表