jondy.net

#!/usr/bin/perl
#####################################
# jondy
# http://blog.csdn.net/jondynet
#####################################

use strict;
use warnings;
use IO::Socket;

my $host = “221.208.250.138″;
my $port = “80″;
my $sock = IO::Socket::INET->new(“$host:$port”)
|| die “Socket() error, Reason : $! \n”;

print $sock “POST /secu/fch_hljcontentauthact.jsp?isADSL=0
&qs=cmV0dXJsPWh0dHA6Ly8yMjEuMjA4LjI1MC4xMzgvZm
NoX2xvZ2luL2xvZ2luLmpzcCZpY3BpZD0xMDAxJmZvcmNl
bG9naW49MCZpc3BpZD0xMDAwMSZjaGFsbGVuZ2U9MTEzND
c5MTg5NDc3MSZ0aW1ld2luZG93PTEyMzQ1Ng== HTTP/1.1\r\n”;
print $sock “Accept: image/gif, image/x-xbitmap, image/jpe
g, image/pjpeg, application/x-shockwave-flash, */*\r\n”;
print $sock “Accept-Language: zh-cn\r\n”;
print $sock “Content-Type: application/x-www-form-urlencoded\r\n”;
print $sock “Accept-Encoding: gzip, deflate\r\n”;
print $sock “User-Agent: Mozilla/4.0 (compatible; MSIE 6.0;
Windows NT 5.2; .NET CLR 1.1.4322)\r\n”;
print $sock “Host: $host\r\n”;
print $sock “Content-Length: 105\r\n”;
print $sock “Connection: Keep-Alive\r\n”;
print $sock “Cache-Control: no-cache\r\n”;
print $sock “\r\n”;
print $sock “stopformer=false&clientusername=&showordernot
ice=1&localIP=&usernameinput=username&password
input=123456\r\n”;
print $sock “\r\n”;
print <$sock>;

#!/usr/bin/perl -w

use Tk;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::HList;
use strict;
use vars qw($top $f $lb_src $lb_dest $dnd_token $drag_entry);

$top = new MainWindow;

$top->Label(-text => “Drag items from the left HList to the right one”
)->pack;
$f = $top->Frame->pack;
$lb_src = $f->Scrolled(‘HList’, -scrollbars => “osoe”, -selectmode => ‘dragdrop’)
->pack(-side => “left”);
$lb_dest = $f->Scrolled(‘HList’, -scrollbars => “osoe”, -selectmode => ‘dragdrop’)
->pack(-side => “left”);

my $i=0;
foreach (sort keys %ENV) {
$lb_src->add($i++, -text => 

___FCKpd___0

);
}
# Define the source for drags.
# Drags are started while pressing the left mouse button and moving the
# mouse. Then the StartDrag callback is executed.
$dnd_token = $lb_src->DragDrop
(-event     => ‘<B1-Motion>’,
-sitetypes => ['Local'],
-startcommand => sub { StartDrag($dnd_token) },
);
# Define the target for drops.
$lb_dest->DropSite
(-droptypes     => ['Local'],
-dropcommand   => [ \&Drop, $lb_dest, $dnd_token ],
);
MainLoop;
sub StartDrag {
my($token) = @_;
my $w = $token->parent; # $w is the source hlist
my $e = $w->XEvent;
$drag_entry = $w->nearest($e->y); # get the hlist entry under cursor
if (defined $drag_entry) {
# Configure the dnd token to show the hlist entry
$token->configure(-text => $w->entrycget($drag_entry, ‘-text’));
# Show the token
my($X, $Y) = ($e->X, $e->Y);
$token->MoveToplevelWindow($X, $Y);
$token->raise;
$token->deiconify;
$token->FindSite($X, $Y, $e);
}
}
# Accept a drop and insert a new item in the destination hlist and delete
# the item from the source hlist
sub Drop {
my($lb, $dnd_source) = @_;
my $end = ($lb->info(“children”))[-1];
my @pos = (-after => $end) if defined $end;
my $y = $lb->pointery - $lb->rooty;
my $nearest = $lb->nearest($y);
if (defined $nearest) {
my(@bbox) = $lb->infoBbox($nearest);
if ($y > ($bbox[3]-$bbox[1])/2+$bbox[1]) {
@pos = (-after => $nearest);
} else {
@pos = (-before => $nearest);
}
}
$lb->add($drag_entry, @pos, -text => $dnd_source->cget(-text));
$lb_src->delete(“entry”, $drag_entry);
$lb->see($drag_entry);
}
__END__

#!/usr/bin/perl
#####################################
# jondy       #
# http://jondy.net/  #
##############################################
#            #
# 这是一个简单的登陆baidu和google的脚本  #
# 用Perl/Tk做的界面；       #
# 开发环境 WinXP sp2 + perl v5.8.4   #
# 转载请把这几行绿了吧唧的字留下    #
#            #
##############################################
use strict;
use warnings;
use encoding ‘euc-cn’;
use Tk;
use Tk::NoteBook;

my ($host,$phost,$postdata,$datalength,$line);

my $mw = new MainWindow;
$mw->title(‘登陆网站到搜索引擎’);
$mw->minsize(400,200);
$mw->resizable(0,0);

my $book = $mw->NoteBook()->pack( -fill=>‘both’, -expand=>1 );

my $tab1 = $book->add( “Sheet 1″, -label=>“www.baidu.com”);
my $tab2 = $book->add( “Sheet 2″, -label=>“www.google.com”, -raisecmd=>\&geturl);
##############################   baidu   #################
$tab1->Label(-text => “（例：http://zhack.blog.163.com）”,-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
my $url1 = $tab1->Entry(-width =>50,-relief=>‘groove’,-font=>‘{MS Sans Serif} 9 {normal}’)
->pack(-fill=>‘x’);
$tab1->Button(-text=>‘提交到百度’,-font=>‘{宋体} 9 {normal}’,-command=>\&baidu)->pack();
$tab1->Label(-text => “
一个免费登录网站只需提交一页（首页）,百度搜索引擎会自动收录网页.
符合相关标准您提交的网址，会在1个月内按百度搜索引擎收录标准被处理.
百度不保证一定能收录您提交的网站.                                “,
-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
##############################   google   ##################
$tab2->Label(-text => “（例：http://zhack.blog.163.com）”,-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
my $url2 = $tab2->Entry(-width =>50,-relief=>‘groove’,-font=>‘{MS Sans Serif} 9 {normal}’)
->pack(-fill=>‘x’);
$tab2->Label(-text => “（例：Perl 是一种方便的脚本语言！）”,-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
my $keys = $tab2->Entry(-width =>50,-relief=>‘groove’,-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
$tab2->Button(-text=>‘提交到Google’,-font=>‘{宋体} 9 {normal}’,-command=>\&google)->pack;
$tab2->Label(-text => “
登录网址时，只须提交最上层的网页，其它各页由 Googlebot 自行查找。
Google 会定期检索并更新所有网站；对于失效网页则将其删除。       “,-font=>‘{宋体} 9 {normal}’)
->pack(-fill=>‘x’);
MainLoop;

sub geturl{
$url2->delete(’0.0′,‘end’);
$url2->insert(0,$url1->get);
}

sub baidu {
$host=“utility.baidu.com”;
$phost=$url1->get;
$postdata = “url=$phost&ivc=UxxfRwFYVF8=&code=NNZZ&Submit=%CC%E1%BD%BB%CD%F8%D5%BE”;
$datalength = length($postdata);
&postcheck(“baidu”);
}

sub google {
$host=“www.google.com”;
$phost=$url2->get;
$postdata = “GET /intl/zh-CN/addurl?q=$phost&dq=$keys->get&submit=%B5%C7%C2%BC HTTP/1.1\r\n\r\n”;
$datalength = length($postdata);
&postcheck(“google”);
}

sub postcheck{
my ($tmp)=@_;
my ($name, $aliases, $type, $len, @thataddr, $a, $b, $c, $d, $that);
($name, $aliases, $type, $len, @thataddr) = gethostbyname($host);
($a, $b, $c, $d) = unpack(“C4″, $thataddr[0]);
$that = pack(‘S n C4 x8′, 2, 80, $a, $b, $c, $d);
socket(S, 2, 1, 0);
select(S);
$| = 1;
select(STDOUT);
connect(S, $that);
if ($tmp =~ /baidu/){
print S “POST /addurl/apply.php HTTP/1.1\r\n”;
print S “Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*\r\n”;
print S “Accept-Language: zh-cn\r\n”;
print S “Content-Type: application/x-www-form-urlencoded\r\n”;
print S “Accept-Encoding: gzip, deflate\r\n”;
print S “User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)\r\n”;
print S “Host: $host\r\n”;
print S “Content-Length: $datalength\r\n”;
print S “Connection: Keep-Alive\r\n”;
print S “Cache-Control: no-cache\r\n\r\n”;
print S “$postdata\r\n\r\n”;
my $s = <S>;
if ($s =~ /302/) {
&MsgShow(‘OK’,‘恭喜’,“$phost 添加到百度成功!”,“info”);
}
}
if ($tmp =~ /google/) {
print S $postdata;
my $s = <S>;
if ($s =~ /200/) {
&MsgShow(‘OK’,‘恭喜’,“$phost 添加到Google成功!”,“info”);
}
}
close(S);
}

sub MsgShow
{
my ($type,$title,$msg,$ico)=@_;
my $msgbox = $mw->messageBox(-type=>$type , -title => $title,-message => $msg,-icon => $ico);
return($msgbox);
}

#!c:/perl/bin/perl.exe

# jondy

# http://jondy.net

use strict;
use Tk;

my $mainbg = “sendmail.dat”;

my $main = new MainWindow;
$main->title(‘Perl SendMail 1.0;’);
$main->geometry(“39×24″);
if (-e “sendmail.dat”) {}
else{
&MsgShow(‘OK’,‘Warning’,“SendMail.BMP没找到，请重新安装！”,“error”);
exit;
}
$main->Photo(‘main_bg’, -file => “$mainbg”);
$main->Label(-image => ‘main_bg’)->pack(-side=>‘left’,-anchor=>‘n’);
$main->Label(-text => ‘Perl SendMail 1.0 , Desgined by jondy;’,-width=>30)->place(-x=>128,-y=>95);
$main->Label(-text => ‘服务器:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>115);
my $host = $main->Entry(-width => 34,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$host->place(-x=>62,-y=>115);
$main->Label(-text => ‘用户名:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>140);
my $user = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$user->place(-x=>62,-y=>140);
$main->Label(-text => ‘密 码:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’,width=>6)->place(-x=>160,-y=>140);
my $pass = $main->Entry(-width => 13,-show =>‘*’,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$pass->place(-x=>209,-y=>140);
$main->Label(-text => ‘发信人:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>10,-y=>165);
my $from = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$from->place(-x=>62,-y=>165);
$main->Label(-text => ‘收信人:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’)->place(-x=>160,-y=>165);
my $to = $main->Entry(-width => 13,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$to->place(-x=>209,-y=>165);
$main->Label(-text => ‘主 题:’,-font=>‘{MS Sans Serif} 10 {normal}’,-relief=>‘groove’,width=>6)->place(-x=>10,-y=>190);
my $subject = $main->Entry(-width => 34,-relief=>‘groove’,-font=>‘{MS Sans Serif} 10 {normal}’);
$subject->place(-x=>62,-y=>190);
my $body=$main->Scrolled(qw/Text -relief groove -scrollbars e -wrap word -width 39 -height 6 -setgrid 1/,-font=>‘{MS Sans Serif} 10 {normal}’)->place(-x=>10,-y=>215);
$main->Button(-text => ‘发 送’,-width=>’8′,-relief=>‘ridge’,
-font=>‘{Arial} 10 {bold}’,-command => sub{do_send($host,$user,$pass,$from,$to,$subject,$body)},
-activebackground=>‘white’)->place(-x=>10,-y=>322);
$main->Button(-text => ‘清 空’,-activebackground=>‘white’,-width=>’8′,-relief=>‘ridge’, -font=>‘{Arial} 10 {bold}’,-command => sub{do_clear()})->place(-x=>120,-y=>322);
$main->Button(-text => ‘关 于’,-activebackground=>‘white’,-width=>’8′,-relief=>‘ridge’, -font=>‘{Arial} 10 {bold}’,-command => sub{do_about()})->place(-x=>230,-y=>322);
my $status = $main->Label(-text=>“谢谢你使用 Perl SendMail 1.0 …”, -font=>‘{System} 9 {normal}’,-relief=>‘sunken’, -borderwidth=>2, -anchor=>“w”,-width=>45);
$status->place(-x=>0,-y=>360);

MainLoop;

sub do_send {
# Fill in status area.
my ($host,$user,$pass,$from,$to,$subject,$body) = @_;
my $host1 = $host->get;
my $user1 = $user->get;
my $pass1 = $pass->get;
my $from1 = $from->get;
my $to1   = $to->get;
my $subject1= $subject->get;
my $body1 = $body->get(’0.0′,‘end’);

if ($host1 eq “”){
&MsgShow(‘OK’,‘error’,“请输入SMTP服务器！”,“error”);
}
elsif ($user1 eq “”){
&MsgShow(‘OK’,‘error’,“请输入用户名！”,“error”);
}
elsif ($pass1 eq “”){
&MsgShow(‘OK’,‘error’,“请输入密码！”,“error”);
}
elsif ($from1 !~ /@/ or $from1 eq “”){
&MsgShow(‘OK’,‘error’,“发信人的信箱 $from1 格式错误，请重新输入！”,“error”);
}
elsif ($to1 !~ /@/ or $to1 eq “”){
&MsgShow(‘OK’,‘error’,“收信人的信箱 $to1 格式错误，请重新输入！”,“error”);
}else{
&sendmail($host1,$user1,$pass1,$from1,$to1,$subject1,$body1)
or die &MsgShow(‘OK’,‘失败’,“信件发送失败”,“error”);
&MsgShow(‘OK’,‘完成’,“给$to1的信件发送成功！”,“info”);
$status->configure(-text=>“给$to1的信件发送成功！”);
}
}
sub do_clear {
$host->delete(’0.0′,‘end’);
$user->delete(’0.0′,‘end’);
$pass->delete(’0.0′,‘end’);
$from->delete(’0.0′,‘end’);
$to->delete(’0.0′,‘end’);
$subject->delete(’0.0′,‘end’);
$body->delete(’0.0′,‘end’);
$status->configure(-text=>“清空完成，请重新输入……”);
&MsgShow(‘OK’,‘Clear’,“清空完成，请重新输入……”,“info”);
}

sub MsgShow
{
my ($type,$title,$msg,$ico)=@_;
my $msgbox = $main->messageBox(-type=>$type , -title => $title,-message => $msg,-icon => $ico);
return($msgbox);
}

sub Base64encode #Base64编码函数
{
my $res = “”;
while ($_[0] =~ /(.{1,45})/gs)
{
$res .= substr(pack(‘u’, $1), 1);
chop($res);
}
$res =~ tr| -_|A-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/‘=’ x $padding/e if ($padding);
return $res;
}

sub sendmail {
my ($host1,$user1,$pass1,$from1,$to1,$subject1,$body1) = @_;
my $SMTPPORT ||=25;
my ($a, $i, $name, $aliases, $proto, $type, $len, $thisaddr, $thataddr);
my @to = split(/,/, $host1);
my $AF_INET = 2;
my $SOCK_STREAM = 1;
my $SOCKADDR = ‘S n a4 x8′;
($name, $aliases, $proto) = getprotobyname(‘tcp’);
($name, $aliases, $SMTPPORT) = getservbyname($SMTPPORT, ‘tcp’) unless ($SMTPPORT =~ /^\d+$/);
($name, $aliases, $type, $len, $thataddr) = gethostbyname($host1);
my $this = pack($SOCKADDR, $AF_INET, 0, $thisaddr);
my $that = pack($SOCKADDR, $AF_INET, $SMTPPORT, $thataddr);
return 0 unless (socket(S, $AF_INET, $SOCK_STREAM, $proto));
return 0 unless (bind(S, $this));
return 0 unless (connect(S, $that));
select(S);
$| = 1;
select(STDOUT);
$a = <S>;
if ($a !~ /^2/)
{
close(S);
undef $|;
return 0;
}
print S “EHLO localhost\n”;
$a = <S>;
print S “AUTH LOGIN\n”;
$a = <S>;
my $smtpuser = Base64encode($user1);
print S “$smtpuser\n”;
$a = <S>;
my $smtppass = Base64encode($pass1);
print S “$smtppass\n”;
$a = <S>;
if ($a !~ /^2/){
&MsgShow(‘OK’,‘error’,“ESMTP验证错误，请检查用户名和密码！”,“error”);
close(S);
return 0;
}
print S “MAIL FROM: $from1\n”;
$a = <S>;
if ($a !~ /^2/)
{
close(S);
return 0;
}
print S “RCPT TO: <$to1>\n”;
$a = <S>;
if ($a !~ /^2/)
{
close(S);
return 0;
}
print S “DATA\n”;
print S “From: $user1<$from1>\n”;
print S “Subject: $subject1\n”;
print S $body1;
print S “\n\n”;
print S “.\n”;
$a = <S>;
print S “QUIT\n”;
$a = <S>;
close(S);
return 1;
}

sub do_about {
require Tk::LabFrame;
$status->configure(-text=>“关于 Perl SendMail 1.0 ….”);
my $about = $main->Toplevel;
$about->title(‘关于….’);
$about->geometry(“300×280″);
$about->Photo(‘main_bg’, -file => “$mainbg”);
$about->Label(-image => ‘main_bg’)->pack(-side=>‘left’,-anchor=>‘nw’);
$about->LabFrame(-label => “About…”,-labelside => ‘acrosstop’,width=>270,height=>100)->place(-x=>10,-y=>105);
$about->Label(-text => “        Perl SendMail 原是以前写的一段发邮件的 \n 代码，这几天学习 Perl/Tk 顺便给她做了个图形\n 界面。如果有什么疏漏之处还请朋友们 Mail 我,\n  谢谢你们的支持！                                                   “,
-font => ‘{Arial} 9 {normal}’
)->place(-x=>20,-y=>125);
$about->Label(-text => “- jondy”,-font => ‘{Comic Sans MS} 10 {normal}’)->place(-x=>218,-y=>199);
$about->Label(-text => “http://jondy.net \n Mail:h4ck\@163.com”,-font => ‘{Arial} 9 {normal}’)->place(-x=>20,-y=>190);
$about->Button(-text => ‘OK’,-width=>’10′,-relief=>‘ridge’, -font=>‘{Arial} 10 {normal}’,-command => sub{$about->destroy})->place(-x=>200,-y=>242);
}

#!/usr/bin/perl
# jondy# http://jondy.net
use MIME::Base64;
use Tk;
use Tk::LabFrame;

my $main = new MainWindow;
$main->title(‘Base64编码互换程序’);
$main->geometry(“300×150″);

$main->LabFrame(-label => “Main”,
-labelside => ‘acrosstop’,
width=>276,
height=>60)->place(-x=>8,-y=>10);
my $basecode = $main->Entry(-width => 20,
-relief=>’groove’,
-font=>’{Courier New} 13 {normal}’)->place(-x=>20,-y=>35);
my $ascicode = $main->Entry(-width => 20,
-relief=>’groove’,
-font=>’{Courier New} 13 {normal}’)->place(-x=>20,-y=>60);
$main->Button(-text => ‘转 换’,
-relief=>’groove’,
-font=>’{宋体} 9 {normal}’,
-command=>\&encode)->place(-x=>235,-y=>34);
$main->Button(-text => ‘还 原’,
-relief=>’groove’,
-height=>’0′,
-font=>’{宋体} 9 {normal}’,
-command=>\&decode)->place(-x=>235,-y=>59);
$main->Label(-text => ‘Base64编码转换程序’,
-font=>’{宋体} 9 {normal}’,
-width=>30)->place(-x=>128,-y=>105);
$main->Label(-text => “Powered by jondy \n jondy\@tom.com”,
-font=>’{宋体} 9 {normal}’,
-width=>30)->place(-x=>128,-y=>120);

$basecode -> insert(’0′,’BASE64′);
$ascicode -> insert(’0′,’ASCII’);

MainLoop;

sub encode{
my $asci2code = $basecode->get;
$asci2code = decode_base64($asci2code);
$ascicode -> delete(’0′,’end’);
$ascicode -> insert(’0′,$asci2code);
}

sub decode{
my $base64code = $ascicode->get;
$base64code = encode_base64($base64code);
chop($base64code);
$basecode -> delete(’0′,’end’);
$basecode -> insert(’0′,$base64code);
}