Google's Database Add Links

Topic Sul Perl.

Moderator: dree

Google's Database Add Links

Postby DevilAuron on Fri Sep 21, 2007 3:56 pm

Code: Select all
#!/usr/bin/perl
#Powered By
#     .___          .__.__                                       
#   __| _/_______  _|__|  |   _____   __ _________  ____   ____
#  / __ |/ __ \  \/ /  |  |   \__  \ |  |  \_  __ \/  _ \ /    \
# / /_/ \  ___/\   /|  |  |__  / __ \|  |  /|  | \(  <_> )   |  \
# \____ |\___  >\_/ |__|____/ (____  /____/ |__|   \____/|___|  /
#      \/    \/                    \/                         \/
#                                                                 
#                  www.devilsnight.altervista.org                 
#       


use Tk;
use IO::Socket::INET;
$mw=MainWindow->new(-background=>"black");
$mw->minsize(230,130);
$mw->Label(-text=>"Google's Database Add Sites:",
-background=>"black",
-foreground=>"white")
->pack(-anchor=>"n");
$mw->Label(-text=>"Inserisci Url",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");

$mw->Entry(-textvariable=>\$url)
->pack(-anchor=>"s");

$mw->Label(-text=>"Inserisci Descrizione Sito:",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");

$mw->Entry(-textvariable=>\$desc)
->pack(-anchor=>"s");

$mw->Button(-text=>"Aggiungi Sito",
-background=>"black",
-foreground=>"orange",
-activebackground=>"orange",
-activeforeground=>"black",
-command=>sub{
$sock = IO::Socket::INET->new(
PeerAddr => 'www.google.it',
PeerPort => '80',
PeerProt => 'tcp',
Timeout  => '1'
) || die "\n=>Error: Retry\n";


print $sock "GET /addurl?q=" .$url . "&dq=" . $desc . "&submit=Aggiungi+URL HTTP/1.1\n";
print $sock "Host: www.google.it\n";
print $sock "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.12) Gecko/20070508 Firefox/1.5.0.12\n\n";
print $sock "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5";
print $sock "Accept-Language: en-us,en;q=0.5\n\n";
print $sock "Accept-Encoding: gzip,deflate\n\n";
print $sock "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n\n";
print $sock "Keep-Alive: 300\n\n";
print $sock "Connection: keep-alive\n\n";

@res = <$sock>;
close($sock);



$sw=MainWindow->new(-background=>"black");

$sw -> Label(-text=>"Url Inserito! \n Url: $url \n Descrizione: $desc \n\n Powered By DevilAuron - http://devilsnight.altervista.org",
-background=>"black",
-foreground=>"orange")->pack;

})->pack(-anchor=>"s");

MainLoop;

#Bye..
DevilAuron
Newbies
 
Posts: 18
Joined: Thu Sep 13, 2007 11:16 pm

Google's Database Add Links

Sponsor

Sponsor


Postby k8 on Fri Sep 21, 2007 4:01 pm

carino.. giusto per capire come funzian le tk..
Big-Bug cerca collaboratori.
Scrivete senza abbreviazioni e senza k, grazie.
k8
Admin
 
Posts: 2127
Joined: Tue Jun 06, 2006 4:00 pm

Postby _Andy_ on Fri Sep 21, 2007 8:32 pm

anche qui ti avrei consigliato LWP al posto di IO::Socket, inoltre non capisco a cosa ti serve
Code: Select all
@res = <$sock>;


cmq molto originale, ottima idea, compilmenti :D
User avatar
_Andy_
Variabile
 
Posts: 258
Joined: Thu Jun 15, 2006 8:00 pm
Location: 127.0.0.1


Return to Perl

Who is online

Users browsing this forum: No registered users and 1 guest

cron