-
523066680
- Administrator
- 帖子: 573
- 注册时间: 2016年07月19日 12:14
-
联系:
帖子
由 523066680 »
首发:
https://zhuanlan.zhihu.com/p/36865994
视频示例:
https://www.zhihu.com/question/271736973/answer/389377346
其中 use Modern::Perl; 不是必需的。
2018-10 知乎的视频方案已经更新为MP4单文件,更新代码移步三楼
=info
Author: 523066680
Date: 2018-05
=cut
use Modern::Perl;
use LWP::UserAgent;
use File::Slurp;
use JSON;
STDOUT->autoflush(1);
goto_dir("D:/temp");
our $main = "https://lens.zhihu.com/api/videos/";
our $ua = LWP::UserAgent->new( );
our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
my $res = $ua->get( $target );
my $html = $res->content();
my @video = $html=~/>https:.*?video\/(\d+)</g;
my $oauth = get_oauth( $html );
for my $idx ( 0 .. $#video )
{
printf "Getting video %s - %s\n", $idx, $video[$idx];
my @vlinks = get_video_links( $oauth, $video[$idx] );
get_video( @vlinks );
}
# 获取 m3u8 列表并提取链接
sub get_video_links
{
our ($main, $ua);
my ( $oauth, $pgcode ) = @_;
my $res = $ua->get(
$main .$pgcode,
"authorization" => $oauth,
);
die unless $res->is_success();
my $data = decode_json( $res->content );
my $play_url = $data->{playlist}->{sd}->{play_url}; # m3u8 url
my $pre_url;
# 获取网址共用部分
$play_url =~/(.*?\w{32})/;
$pre_url = $1 ."/";
$res = $ua->get( $play_url );
my @vlinks = $res->content =~/\n(.*?\d+\.ts.*?)\n/g;
grep { $_ = $pre_url . $_ } @vlinks;
return $pgcode, @vlinks;
}
# 获取视频切片,合并
sub get_video
{
our $ua;
my $name = shift;
my $buff = "";
my $res;
while ( my $link = shift )
{
print $#_ + 1 ," ";
$res = $ua->get( $link );
$buff .= $res->content();
}
print "\n";
write_file( "${name}.ts", {binmode=>":raw"}, $buff );
}
sub get_oauth
{
our ( $ua );
my $html = shift;
my ($js) = $html =~/(https:[^<>]+main\.app[^<>]+js)/g;
my $res = $ua->get( $js );
# pattern: authorization:"oauth c3cef7c66a1843f8b3a9e6a1e3160e20"}
my ($oauth) = $res->content =~/authorization:"([^"]{30,})"/;
return $oauth
}
sub goto_dir
{
my $dir = shift;
mkdir $dir unless ( -e $dir );
chdir $dir;
}
__DATA__
-
523066680
- Administrator
- 帖子: 573
- 注册时间: 2016年07月19日 12:14
-
联系:
帖子
由 523066680 »
更新内容 - 知乎去掉了 oauth 授权的部分
=info
Author: 523066680
Date: 2018-07
更新:知乎去掉了 oauth 授权方式
=cut
use Modern::Perl;
use LWP::UserAgent;
use File::Slurp;
use JSON;
STDOUT->autoflush(1);
goto_dir("D:/temp");
our $main = "https://lens.zhihu.com/api/videos/";
our $ua = LWP::UserAgent->new( );
our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
my $res = $ua->get( $target );
my $html = $res->content();
my @video = $html=~/>https:.*?video\/(\d+)</g;
for my $idx ( 0 .. $#video )
{
printf "Getting video %s - %s\n", $idx, $video[$idx];
my @vlinks = get_video_links( $video[$idx] );
get_video( @vlinks );
}
# 获取 m3u8 列表并提取链接
sub get_video_links
{
our ($main, $ua);
my ( $pgcode ) = @_;
my $res = $ua->get( $main .$pgcode );
die unless $res->is_success();
my $data = decode_json( $res->content );
my $play_url = $data->{playlist}->{sd}->{play_url}; # m3u8 url
my $pre_url;
# 获取网址共用部分
$play_url =~/(.*?\w{32})/;
$pre_url = $1 ."/";
$res = $ua->get( $play_url );
my @vlinks = $res->content =~/\n(.*?\d+\.ts.*?)\n/g;
grep { $_ = $pre_url . $_ } @vlinks;
return $pgcode, @vlinks;
}
# 获取视频切片,合并
sub get_video
{
our $ua;
my $name = shift;
my $buff = "";
my $res;
while ( my $link = shift )
{
print $#_ + 1 ," ";
$res = $ua->get( $link );
$buff .= $res->content();
}
print "\n";
write_file( "${name}.ts", {binmode=>":raw"}, $buff );
}
sub goto_dir
{
my $dir = shift;
mkdir $dir unless ( -e $dir );
chdir $dir;
}
-
523066680
- Administrator
- 帖子: 573
- 注册时间: 2016年07月19日 12:14
-
联系:
帖子
由 523066680 »
=info
Author: 523066680
2018-07 知乎去掉了 oauth 授权方式
2018-10 从 ts 多文件,变更为 mp4 单文件下载
=cut
use JSON;
use Encode qw/from_to/;
use LWP::UserAgent;
use Mojo::DOM;
use File::Slurp;
STDOUT->autoflush(1);
our $wdir = "D:/temp";
our $main = "https://lens.zhihu.com/api/videos/";
our $ua = LWP::UserAgent->new();
our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
my $res = $ua->get( $target );
my $html = $res->content();
my @video = $html=~/>https:.*?video\/(\d+)</g; # 获取视频页面链接
my $title = get_title_name( $html );
my ($answerID) = ($target=~/\/(\d+)$/);
mkdir $wdir unless -e $wdir;
chdir $wdir;
for my $idx ( 0 .. $#video )
{
printf "Getting video %s - %s\n", $idx, $video[$idx];
get_video( $video[$idx], "${title}Answer_${answerID}_${idx}.mp4" );
}
sub get_video
{
our ($main, $ua);
my ( $pgcode, $fname ) = @_;
my $res = $ua->get( $main .$pgcode );
die unless $res->is_success();
my $data = decode_json( $res->content );
my $play_url = $data->{playlist}->{sd}->{play_url};
$res = $ua->get( $play_url );
write_file( $fname, {binmode=>":raw"}, $res->content );
}
sub get_title_name
{
my $html = shift;
my $dom = Mojo::DOM->new($html);
my $title = $dom->at("title")->text;
$title =~s/ - 知乎//;
from_to( $title, "utf8", "gbk" );
return $title;
}
-
523066680
- Administrator
- 帖子: 573
- 注册时间: 2016年07月19日 12:14
-
联系:
帖子
由 523066680 »
zzz19760225 写了:刷抖音
哈哈 抖音也刷。说起来,刷抖音时间流逝的真快啊。
-
zzz19760225
- 一代宗师
- 帖子: 930
- 注册时间: 2017年12月25日 11:12
-
联系:
帖子
由 zzz19760225 »
523066680 写了:zzz19760225 写了:刷抖音
哈哈 抖音也刷。说起来,刷抖音时间流逝的真快啊。
以前上过一次,发觉有些过度搞笑无下限,然后退出了。
后来学车的学员有人上抖音,就上来看看了,发觉正能量好多。
官方一看就是奉旨圈粉的,共青团,新闻联播,外交部,交通管理,应急支援(消防),,,,,
现在每天就是点点点,还好流量够用(就是有点贵)。
-
523066680
- Administrator
- 帖子: 573
- 注册时间: 2016年07月19日 12:14
-
联系:
帖子
由 523066680 »
移动好像有专属的抖音流量包。我那免费领了一个15G的。
正浏览此版面之用户: Ahrefs [Bot] 和 5 访客