[Perl]抓取个人的所有闪存+格式化保存为文本
以下代码保存为utf8文本格式
环境:ActivePerl v5.16 built for MSWin32-x86
两个要调整的地方:
for my $i (17..45) { 这里改成自己对应的页码,比如发了30页的闪存,就改成1..30
还有就是这部分改成自己对应的ID和密码,中文ID还未测试过
tbUserName=>"ID",
tbPassword=>"密码",
抓取的结果参考截图:

=info
code: vicyang
mail: @.com
date: --
=cut #!/usr/bin/perl
use v5.;
use strict;
use utf8;
use Encode;
use IO::Handle;
use LWP::UserAgent;
binmode(STDOUT, ":encoding(gbk)");
STDOUT->autoflush();
my $ua = LWP::UserAgent->new;
$ua->cookie_jar( {} ); my $randserial=getRandHex();
my $response = $ua->get(
'http://passport.cnblogs.com/BotDetectCaptcha.ashx?get=image&c=c_login_logincaptcha&t='.$randserial
); print "$randserial\n"; if ($response->is_success) {
# 抓取验证码图片 #
open my $check_code_image, "> verifycode.BMP" #默认验证图片的位置在当前目录
or die "$!"; binmode($check_code_image);
print $check_code_image $response->content;
close $check_code_image; #关闭print对句柄的控制
system("start verifycode.BMP");
} else {
print "wrong\n";
} print "please input verifycode:";
my $inp=<STDIN>;
$inp=~s/\r?\n$//; print "[$inp]\n"; my $res= $ua->post('http://passport.cnblogs.com/login.aspx?ReturnUrl=http://home.cnblogs.com/ing/',
[
__EVENTTARGET=>"",
__EVENTARGUMENT=>"",
__VIEWSTATE=>"/wEPDwUKLTM1MjEzOTU2MGQYAQUeX19Db250cm9sc1JlcXVpcmVQb3N0QmFja0tleV9fFgEFC2Noa1JlbWVtYmVy4b/ZXiH+8FthXlmKpjSEgi7XBNU=",
__VIEWSTATEGENERATOR=>"C2EE9ABB",
__EVENTVALIDATION=>"/wEdAAYIqCk3Gcmu25zI9fQWqoC7hI6Xi65hwcQ8/QoQCF8JIahXufbhIqPmwKf992GTkd2Mxo6xcg+Ng5CZxsqMUGnVMKtTyqevv9cjRp4Oh+9VMaKeKEbp39eHc9mbdvkCgxCM74oSoIAJofLsQdCCbtmog/0fDw==",
tbUserName=>"改成自己的ID",
tbPassword=>"改成自己的密码",
chkRemember=>"on",
LBD_VCID_c_login_logincaptcha=>$randserial,
LBD_BackWorkaround_c_login_logincaptcha=>,
CaptchaCodeTextBox=>$inp,
btnLogin=>"登++录",
#txtReturnUrl=>"http://home.cnblogs.com/u/paktc/"
],
); my $fh;
our $main='http://home.cnblogs.com/ing';
our $limit=;
my $all;
my @ech; for my $i (..) {
print STDOUT "Code: $i\n"; open $fh, ">:encoding(gbk)", "ing$i.txt";
select $fh;
$fh->autoflush();
$res = $ua->get("http://home.cnblogs.com/u/paktc/feed/$i.html") or warn "$!"; unless ($res->is_success) {
print "wrong\n";
} $all=$res->content;
@ech=($all=~/GetIngRecentComments\((\d+)/gi); for (@ech) {
&getDetail($_);
} close $fh;
}
print STDERR "over";
<STDIN>; sub getDetail {
our $main;
our $limit;
my $pagecode=shift;
$res = $ua->get($main."/".$pagecode) or warn "$!";
my @all=split(
/\r?\n/,
decode('utf8', $res->content)
); my (
$p_time, $message,
$comment_count,
$comment_author,
$comment_text,
$comment_time
); for (my $i=; $i<=$#all; $i++)
{
if ($all[$i]=~/\d+-\d+-\d+ \d+:\d+$/)
{
$p_time=$&;
print "\n$p_time\n";
}
if ($all[$i]=~/ing_detail_body">(.*)/i)
{
$message=$1;
while (not $message=~s/<\/div>//i) {
$message .= $all[++$i];
}
#case <div id="ing_detail_body"><a href="/ing/tag/..." class="ing_tag">[组图]</a>
# [标签]
$message=~s/<a href=".*class="ing_tag">([^<]+)<\/a>/$/i;
#case 幸运闪 其他情况还未考虑
$message=~s/<img src=.*alt="([^"]+)" title=".*"\/>/☆/i;
#case 链接
$message=~s/<a href="([^"]+)" .*<\/a>/<$>/gi; &charResume(\$message); #必须传入一个引用,否则会崩溃 my @msg=splitText2($message, $limit, );
print " ", "┈"x($limit/), "\n";
print decode('gbk', join("", @msg));
print " ", "┈"x($limit/), "\n"; print STDOUT decode('gbk', join("", @msg)), "\n";
}
if ($all[$i]=~/ing_comment_count">(.*)(<\/div>)?/i)
{
$comment_count=$1;
}
if ($all[$i]=~/comment_author_.*ing\/">(.*)<\/a>/)
{
$comment_author = $;
($comment_text = $all[$i+]) =~ s/^ +//;
$comment_text =~s/<a href="([^"]+)" .*<\/a>/<$1>/gi; #替换链接
&charResume(\$comment_text); $all[$i+2] =~/(\d+-\d+-\d+ \d+:\d+)/;
$comment_time = $1;
printf(" <%s> ", $comment_author);
my $name_length = length(encode('gbk', $comment_author))+7; #length " <%s> "
my @msg = splitText2($comment_text, ($limit - $name_length), 0);
print decode('gbk', shift @msg); for (@msg) {
print " "x$name_length . decode('gbk', $_);
}
print "\n"; $i+=2;
}
}
} sub splitText2 {
my ($text, $limit, $indent) = @_;
my ($a, $b, @arr); $b = encode('gbk', $text);
while (length($b) > $limit) {
($a, $b) = &cut_gbk($limit, $b);
push (@arr, " "x$indent . $a ."\n");
}
# At last
push (@arr, " "x$indent . $b ."\n"); return @arr;
} sub cut_gbk {
my ($limit, $gstr) = @_;
my $i;
my $cut = 0;
my $gstr_a;
my $gstr_b;
foreach $i (
split("", decode('gbk', $gstr))
) {
if (ord($i) < 128) {
$cut+=1;
} else {
$cut+=2;
}
if ($cut >= $limit) {
$gstr_a = substr($gstr, 0, $cut);
$gstr_b = substr($gstr, $cut);
last;
}
}
return ($gstr_a, $gstr_b);
} sub charResume {
#传入unicode格式的字符串
my $ref = shift;
my $char;
my $count=0;
${$ref}=~s/\</</gi;
${$ref}=~s/\>/>/gi;
${$ref}=~s/\"/"/gi;
${$ref}=~s/\ / /gi;
${$ref}=~s/\ / /gi;
${$ref}=~s/\&/\&/gi;
${$ref}=~s/\&/\&/gi;
while (${$ref}=~/\&#(\d+);/) {
$count++;
$char=chr($);
${$ref}=~s/\&#$1;/$char/g;
if ($count > ) {
print STDOUT "DEEP LOOP \n";
sleep 1.0;
exit;
}
} } sub getRandHex {
my $str="";
for my $i ( .. $_[]) {
$str .= sprintf("%x", int(rand()));
}
return $str;
}
[Perl]抓取个人的所有闪存+格式化保存为文本的更多相关文章
- HttpClients+Jsoup抓取笔趣阁小说,并保存到本地TXT文件
前言 首先先介绍一下Jsoup:(摘自官网) jsoup is a Java library for working with real-world HTML. It provides a very ...
- mysql perl 抓取update语句
<pre name="code" class="html"><pre name="code" class="ht ...
- 使用 Charles 抓取 App 网络请求
最近开发App的时候需要用到大量其他应用的数据,但接口不公开,所以想到了抓取.差不多要读到5W的用户数据,采用的是找到数据接口,然后不停发请求的方式.用到的抓取工具是Charles,本文讲解的应用是W ...
- 制作bat脚本,抓取Android设备logcat
::bat制作抓取Android设备的logcat,并保存以时间命名的txt文件至设备目录 1 @ECHO off adb wait-for-device ECHO 正在连接设备 adb logcat ...
- 使用JavaCV/OpenCV抓取并存储摄像头图像
http://blog.csdn.net/ljsspace/article/details/6702178 分类: 图形图像(3) 版权声明:本文为博主原创文章,未经博主允许不得转载. 本程序通过 ...
- TCPdump指定时间或者指定大小进行循环抓取报文
背景:我们用tcpdump工具循环抓取网卡上的报文,我们会遇到如下情况: 1. 抓取报文后隔指定的时间保存一次: 2. 抓取报文后达到指定的大小保存一次: 本文就这两种情况给出tcpdump的使用方法 ...
- windows中抓取hash小结(下)
书接上回,windows中抓取hash小结(上) 指路链接 https://www.cnblogs.com/lcxblogs/p/13957899.html 继续 0x03 从ntds.dit中抓取 ...
- [工具开发] Perl 爬虫脚本--从美国国家漏洞数据库抓取实时信息
一.简介 美国国家漏洞数据库收集了操作系统,应用软件的大量漏洞信息,当有新的漏洞出现时,它也会及时发布出来. 由于信息量巨大,用户每次都需要到它的网站进行搜索,比较麻烦.如果能有个工具,每天自动分析它 ...
- windows环境下nutch2.x 在eclipse中实现抓取数据存进mysql详细步骤
nutch2.x 在eclipse中实现抓取数据存进mysql步骤 最近在研究nutch,花了几天时间,也遇到很多问题,最终结果还是成功了,在此记录,并给其他有兴趣的人提供参考,共同进步. 对nutc ...
随机推荐
- windows下使用TortoiseGit代替Git命令行操作
windows下使用TortoiseGit代替Git命令行操作 大家在使用svn的时候,都非常喜欢使用小乌龟,也就是TortoiseSVN:那么git也有小乌龟版本,即TortoiseGit. 1.安 ...
- Navi.Soft30.产品.DataWindowNet.操作手册
1概述 1.1功能简介 Sybase公司的PowerBuilder开发工具,在以前VS工具没有成事以前,是相当风光的.微软都要与其合作,学习它Db方面的技术,才成就了SQLServer数据库.PB开发 ...
- 菜鸟学JS(四)——javascript为按钮注册回车事件(设置默认按钮)
不得不说,在JS方面,自己真的是个不折不扣的菜鸟.对于JS以及一些JS框架如JQuery等JS框架,自己也只是处在简单应用的阶段,当然自己也在不断的学习当中,希望将来能跟大家分享更多JS方面的心得.今 ...
- Android获取TextView显示的字符串宽度
工作上有业务需要判断textview是否换行,我的做法是判断textview要显示的字符串的宽度是否超过我设定的宽度,若超过则会执行换行. 项目中的其他地方也有这样的需求,故直接使用了那一块的代码.如 ...
- 不同iOS版本做代码适配__IPHONE_OS_VERSION_MAX_ALLOWED 和 __IPHONE_8_0等专业术语
目前开发只想最低版本支持iOS8了,iOS8以前的就不管了,然后现在iOS9和iOS10出来以后,有些新的API,也有些弃用的API,为了兼容,有时候代码里面需要编写判断不同iOS版本,或者只允许指定 ...
- 【转】JavaScript中的对象复制(Object Clone)
JavaScript中并没有直接提供对象复制(Object Clone)的方法.因此下面的代码中改变对象b的时候,也就改变了对象a. a = {k1:1, k2:2, k3:3}; b = a; b. ...
- ffmpeg中的sws_scale算法性能测试
经常用到ffmpeg中的sws_scale来进行图像缩放和格式转换,该函数可以使用各种不同算法来对图像进行处理.以前一直很懒,懒得测试和甄 别应该使用哪种算法,最近的工作时间,很多时候需要等待别人.忙 ...
- 在Sharepoint2010中一种自定义调查列表的不允许再次答复提示的处理方法!
在Sharepoint中默认创建的调查列表系统只允许答复一次,再次答复将报错误信息,这对最终用户而言是非常不友好的体验,当然你也可以在调查设置中的常规设置中设置允许多次答复,这样就会有错误提示信息,但 ...
- 转载 jQuery的三种$()
$号是jQuery“类”的一个别称,$()构造了一个jQuery对象.所以,“$()”可以叫做jQuery的构造函数(个人观点,呵呵!). 1.$()可以是$(expresion),即css选择器 ...
- HIVE: Map Join Vs Common Join, and SMB
HIVE Map Join is nothing but the extended version of Hash Join of SQL Server - just extending Hash ...