中国DOS联盟

#!/usr/bin/perl
open READ,"<next.x";

$lv_[1]=00000000;
$lv_[2]=11000000;
$lv_[3]=11100000;
$lv_[4]=11110000;
$lv_[5]=11111000;
$lv_[6]=11111100;

use utf8;

$a="我";
printf "%s\n",&code2utf(ord $a);
print "END!";
<STDIN>;


sub code2utf {
my ($code,$bin,$level,$hex,$tmp,$result);
$code=$_[0];
$bin=sprintf "%b",$code;

$level=1;
if (length($bin)>7) {
  while (length($bin)>=6) {
     $level+=1;
     $bin=~s/.{6}$//;
     $hex=sprintf "%X",&bin2int(10 . $&);
     $result=$hex ."-". $result;
  }
}

$tmp=substr($lv_[$level],0,8-length($bin));
$hex=sprintf "%X",&bin2int($tmp . $bin);
$result=$hex ."-". $result;
$result=~s/-$//;  
$result;   #result - string
}

sub bin2int {
my ($a,$str,$all,$act);
$a=$_[0];
$str="";
$all=0;
$act=0;
do {
   $b=($a % 10) * (2**$act);  #** as ^ of the calc
   $all+=$b;
   $act+=1;
   $a=int ($a/10);
} until ($a==0);
int ($all);
}

=info
    Edit: vicyang
    Mail: 523066680@163.com
    Date: 2016-06
=cut

use v5.16;
use utf8;
use Encode;
use LWP::UserAgent;
use LWP::Simple qw/getstore get/;
use IO::Handle;
STDOUT->autoflush(1);

our $website = "http://www.pep.com.cn/gzwl/jszx/tbjx/kb/dzkb/";
#our $website = "\x68\x74\x74\x70\x3A\x2F\x2F\x77\x77\x77\x2E\x70\x65\x70\x2E\x63\x6F\x6D\x2E\x63\x6E\x2F\x67\x7A\x77\x6C\x2F\x6A\x73\x7A\x78\x2F\x74\x62\x6A\x78\x2F\x6B\x62\x2F\x64\x7A\x6B\x62\x2F";

our $bookpage;
our $WORKDIR;
our $page1maps;
my  ($path, $begin, $end);

my @booklist = qw/
        bx1  bx2 xx11 xx12 xx21 xx22 xx23 xx31 xx32 xx33 xx34 xx35 /;


for my $book ( @booklist[0 .. $#booklist]  )
{
        print "Now is downloading: $book\n";
        $bookpage = $website. $book . "/";
        $WORKDIR  =  "D:\\Extra\\Book\\Physics\\" . $book;

        CreatePath($WORKDIR);

        ($path, $begin, $end) = get_pgnum_range( $bookpage );
        print "Path: $path, $begin to $end\n";

        #页面1 对应的 页码
        $page1maps = get_who_map_page1( $bookpage );

        get_picture( $bookpage, $path, $begin, $end );
}

system("pause");

sub get_pgnum_range
{
        my $bookpage = shift;
        my $all;
        $all = get($bookpage);   #使用lwp::simple 得到的是unicode，
                                 #使用lwp::UserAgent 得到的是GB2312
        my @pglist;
        my $path;

        $all =~s/.*封面//s;      #如果有封面，剔除

        #./201102/t20110217_1021412.htm
        for my $e ( split("\r?\n", $all)  )
        {
                if ($e=~/href="\.\/([^"]*_)(\d+).htm"/)
                {
                        $path = $1;
                        push @pglist, $2;
                }
        }

        @pglist = sort @pglist;
        return $path, @pglist[ 0, $#pglist ];
}

sub get_who_map_page1
{
        my $bookpage = shift;
        my $all = get($bookpage);

        $all=~s/\r?\n//g;
        if ( $all=~/\d+_(\d+)\.htm[^.]+第/ )
        {
                return $1;
        }
        else
        {
                die "first page code not found! ";
        }
}


sub get_picture
{
        my ($bookpage, $path, $begin, $end) = @_;

        our $page1maps;
        our $WORKDIR;
        my  $all;           #网页内容
        my  $subpage;       #子页面
        my  $pic;           #图片名
        my  $count = 0;     #页码计数
        my  $fname;         #文件名

        #该网页地址是逆序的，书本page+1，网址代码-1

        for (my $n = $end; $n >= $begin; $n-- )
        {
                $subpage = $bookpage . $path . $n . ".htm";

                $all = get( $subpage ) or next;
                if ( $all=~/IMG src="?\.\/([^".]*.jpg)"?/i )  #不一定有""符号
                {
                        $pic = $1;
                        $subpage =~s /[^\/]+$/$pic/;

                        if ( $n <= $page1maps )
                        {
                                $count++;
                                $fname = sprintf("%03d.jpg", $count);
                        }
                        else
                        {
                                $fname = $pic;
                        }

                        getstore($subpage, $WORKDIR."\\".$fname) or die "$!";
                        print "$pic\n";
                }
        }
}

sub CreatePath
{
    my $path = shift;
    my @arr=split(/[\\\/]/, $path);
    my $main;

    $main = shift @arr;  #以盘符开始

    for my $s (@arr)
    {
        $main .= "/" . $s;
        mkdir( $main ) if ( ! -d $main );
    }
}