Posts Tagged “utility”

nhd-seeding.user.js

這是一個用於NexusHD的Greasemonkey User Script,用於在torrents.php頁面標示出哪些種子是已在做種的。因為自己經常忘記NHD上的某個種子是否已經下載過,每次都要點開details.php頁面看看有沒有自己,所以想到了寫個腳本搞定這個問題。每次訪問userdetails.php頁面的時候,都會自動更新做種列表,然後在torrents.php里修改正在做種種子的背景色以示區別。使用這個腳本的時候請把uid改成自己的。

Comments 3 Comments »

ACFUN上经常有一些考验暂停党的图集视频,内含各种哔哔和◯◯,但是对于反射弧比较长,暂停苦手的人们来说,只得反复折腾得肉牛满面。而我这种暂停四级考试完全不合格的人更是鸭梨很大。于是想到求助perl, imgseekmplayer,把视频中的所有图片提取出来。思路很简单,就是首先用mplayer将视频内容转为一帧一帧的png或jpg图片(视频分帧),再用Image::Seek来通过图片内容的相似度比较去除重复图片。写了一段简单的perl代码(wapauser.pl):

#!/usr/bin/perl

use strict;
use constant SCORE => -30;
use File::Temp qw(tempfile tempdir);
use Image::Imlib2;
use Image::Seek qw(loaddb cleardb add_image query_id remove_id);
use POSIX ':sys_wait_h';

our ($id, $db, $dir);

sub init {
	$id = 0;
	$dir = tempdir('wapauserXXXX', CLEANUP => 1, DIR => '.');
	$db = tempfile('wapauserXXXX', DIE => $dir, SUFFIX => 'db');
	loaddb($db);
	cleardb();
}

sub gao {
	my $file = shift;
	my $img = Image::Imlib2->load($file);
	add_image($img, $id);
	my @result = query_id($id, 2);
	if (!$id || $result[1]->[1] > SCORE) {
		++$id;
		link $file, sprintf './output/%04d.png', $id;	# or `cp`
	} else {
		remove_id($id);	# important
	}
}

sub wapauser {
	my ($file, @args) = @_;
	init();
	if (my $pid = fork) {
		wait;
		opendir(my $dh, $dir);
		my @pngs = grep {/\.png/} readdir($dh);
		closedir($dh);
		for my $png (sort @pngs) {
			gao("$dir/$png");
		}
	} else {
		chomp(my $path = `which mplayer`);
		unshift @args, '-vo', "png:outdir=$dir", '-nosound';
		print STDERR "path = $path\nfile = $file\n", join("  ", @args), "\n";
		close STDOUT;
		close STDERR;
		exec $path, $file, @args;
	}
}

wapauser(@ARGV);

拿某个长度4min的flv视频测试了一下,第一步和第二部分别花了4min的时间,最后从6000多帧中提取了70多张不同的图片。实验表明,SCORE的阀值大概取到-25~-30比较合适,具体的值还是要反复尝试。大多数相同的图结果都在-35以上,但也有可能只有-31。不同的图通常区别都在-15以内,但是只有一些小区别的几张图(你们懂的)之间的区别可能有负的二十多。总的来说还有以下问题:

  • 视频分帧结束后才开始图片去重,实际上两步可以同时进行,分步的结果就是得先消耗很大的临时空间来存储成千上万帧的图片,上面的测试就吃掉了4G的硬盘;
  • 生成的图片是非常大png,这也是为什么会吃掉那么多磁盘的原因,当然这可以通过设置参数z=<0-9>改成压缩较高的png,或者用参数-vo jpeg,并设置参数quality=<0-100>改成较小的jpg;
  • 这种方法只能处理完全静态的图集视频,对其它视频要么无能为力,要么作用很有限;
  • 生成的图片质量取决的视频质量,所有除非是高清视频,否则图片质量不会太好;
  • SCORE阀值的设置……凡是涉及到阀值的问题总是很头疼的,稍微高点低点,效果可能就差很多,这就像调试蓝田的热水一般(典故见附件)。

附件:我刚进浙大不久时的一篇文章《走进浙大—揭开蓝田浴室之谜》,想起来当时我们一看见校医院的救护车从蓝田方向开来就会说“又有人洗澡被烫伤了”……

发信人: botanyh (botany), 信区: Joke
标 题: 走进浙大—揭开蓝田浴室之谜ZZ
发信站: 缥缈水云间 (Mon Oct 30 11:33:02 2006), 站内

Comments 9 Comments »

虽然zip诞生之初只支持cp437,但对UTF-8的支持早已加入zip格式的标准之中,原本这样就该天下太平了。但这个世界爱自作主张和固守陈规的软件太多了,尤其是悲剧只发生在Linux用户的头上的时候(当然Win用户从JP下回的zip乱码的可能性也有,不过Win下JP的东西什么都是乱码,所以无所谓了)。于是常常会解压一个zip得到一大堆乱码的文件,如果运气好的话,可以convmv解决;但是遇到解压完的文件名里有一堆的“(invalid encoding)”,那convmv也回天乏术;更不幸的是直接解压不能,说什么

checkdir error:  cannot create ?R?X?v???-?^?Wblabla
                 Invalid or incomplete multibyte or wide character
                 unable to process ?R?X?v???-?^?Wbalbla/gao.

早先的unzip,比如UnZip 5.52,有个在usage, help和manpage等各种文档中都没提到的神秘参数-O可以指定文件名的编码,从而解决GBK/BIG5/shift_JIS等编码的乱码问题。比如:

unzip -O CP936 怎样打飞机.zip

可是到了新版本的unzip,比如UnZip 6.00,这个-O参数便名花有主了,而原来的-O功能似乎神隐了。用力搞了很久没搞定,最后求助perl。利用Archive::Zip和Encode,写了个简短的脚本,这个问题瞬间解决。

#!/usr/bin/perl

use Archive::Zip;
use Encode qw(decode encode);

sub usage {
	print <<USAGE;
USAGE: unzip.pl ZIPFILE [FROMCODE=utf-8 [TOCODE=utf-8]]
USAGE
	exit;
}

usage unless -e $ARGV[0];
$zip = Archive::Zip->new($ARGV[0]);
$from = $ARGV[1] || 'utf-8';
$to = $ARGV[2] || 'utf-8';

for ($zip->memberNames()) {
	$member = $zip->memberNamed($_);
	$_ = encode($to, decode($from, $_));
	$zip->extractMember($member, $_);
}

现在只要

perl unzip.pl 怎样打飞机.zip GBK

就能顺利解压了。至于开头提到的原因不明的乱码造成的解压不能的情况,可以直接将$_ = encode($to, decode($from, $_))这句修改文件名的代码替换为s#.*?/#gao/#等能解决问题的代码。

Comments 5 Comments »

专门针对验证码写了个识别脚本,当然不是光为识别验证码而识别的咯,至于拿来干什么“坏事”,再说吧。识别验证码也算挑战大自然了,当年百度复赛那道验证码识别就让无数人肉牛满面,所幸这需要识别的验证码只有数字,而且字迹工整,颜色统一,格式规范,背景简单。识别脚本利用基于ImageMagickImage::Magick处理验证码,分离出每个数字的二值图像,然后利用基于ImgSeekImage::Seek通过相似度比较识别验证码。

captcha

todigits是将验证码图像文件转换成每个数字的二值图像的函数。首先将验证码转为灰度图,再选择合适的阀值,将图像二值化。最后把每个数字裁剪出来并去掉白边。硬编码万岁!

# todigits.pl
use strict;
use Image::Magick;

sub todigits {
    my ($n, $threshold, $w, $h, $x, $y) = /该信息已被绿坝屏蔽/;
    my $filename = shift @_;
    my @retval = ();
    my $image = Image::Magick->new;

    $image->Read($filename);
    $image->Quantize(colorspace => 'gray');
    $image->Threshold(threshold => $threshold, channel => 'All');
    for (my $i = 0; $i < $n; ++$i) {
        my $digit = $image->Clone();
        $digit->Crop(width => $w, height => $h, x => $x + $i * $w, y => $y);
        $digit->Trim();
        push @retval, $digit;
    }
    return @retval;
}

1;

准备足够多的验证码,用脚本测试一下todigits,同时也生成了ImgSeek所需的所有数字的二值图像样本。

0123456789

Comments 19 Comments »

transmission-remote-dotnet is a Windows remote client to the RPC interface of transmission-daemon, which is part of the Transmission BitTorrent client. The application is quite like μTorrent in appearance and currently supports almost all the RPC specification.

transmission-remote-dotnet是用.Net开发的一个调用transmission的RPC(Remote Procedure Call Protocol, 远程过程调用协议)接口的客户端。简而言之就是你可以通过它来控制跑在另一台电脑上的transmission。由于公司网络禁止BT,所以我只能远程回学校的机器下。可通过ssh使用transmission-cli实在太不方便了;受网络限制,通过vnc控制transmission-gtk又太慢;通过transmission的web控制台倒可以解决不少问题,不过功能较弱,而且比较占资源,也许还会弹出“是否终止当前脚本”的对话框;相比之下transmission-remote-dotnet真是Windows下的完美解决方案。transmission-remote-dotnet的UI类似μTorrent,甚至比transmission-gtk提供了多得多的功能(当然transmission-gtk的功能本身就不算很强)。

transmission-remote-dotnet

Comments 5 Comments »