TK Script Examples 1

[DANZIG]

Hello All I was wondering if anybody had any scripts using the TK module and it's various widgets that they wouldn't mind posting? I'd like to start using the module in some server reporting scripts but am not really sure where to start. The method examples included in the modules don't really show you the flow of a working script.

Thanks in advance

 

[luciddream]

here's one i made... it's an encrytion/decryption utility... the encryption and decryption is pretty stupid, but, it is an example of TK..

#!/usr/bin/perl
use Tk;
use Tk:ialog;

# Create main window.
my $main = new MainWindow;
$main->title('Encryption Utility');
$menubar = $main->Frame(-relief=>"groove", -borderwidth=>2);
$bar = $main->Frame(-borderwidth=>2);
$sillyframe = $main->Frame();
$to_label = $sillyframe->Label(-text => 'To: ');
$to_entry = $sillyframe->Entry(-relief => 'groove');
$to_entry->configure(-width => 30);
$frame = $main->Frame();
$filebutton = $menubar->Menubutton(-text=>"File", -underline => 0); # F in File
$filemenu = $filebutton->Menu(-tearoff=>0);
$filebutton->configure(-menu=>$filemenu);
$filemenu->command(-command => \&enc_choice, -label => "Encrypt", -underline => 0); # E in Encrypt
$filemenu->command(-command => \&dec_choice, -label => "Decrypt", -underline => 0); # d in dEcrypt
$filemenu->command(-command => \&matt_lind_is_gay, -label => "Place", -underline => 0); # d in dEcrypt
$filemenu->separator;
$filemenu->command(-label => "Exit", -command => \&exit_choice, -underline => 1); # "x" in Exit
$helpbutton = $menubar->Menubutton(-text=>"Help", -underline => 0); # H in Help
$helpmenu = $helpbutton->Menu(-tearoff=>0);
$helpmenu->command(-command => \&about_choice, -label => "About...", -underline => 0); # A in About
$helpbutton->configure(-menu=>$helpmenu);
$label = $main->Label(-text=>"Message:"
$button = $main->Button(-text=>"Encrypt", -command => \&encrypt, -relief=>"groove"
$text = $frame->Text(-relief=>"groove", -wrap=>"word", -height=>10);
$scroll = $frame->Scrollbar(-command => ['yview', $text]);
$text->configure(-yscrollcommand => ['set', $scroll]);
$label1 = $main->Label(-text=>" "
$status = $main->Label(-text=>"Status area", -relief=>groove, -borderwidth=>2, -anchor=>"w"
$dialog = $main->Dialog(-title=>"About", -text=>"This is a neat thing!"


#place the stuff on there
$filebutton->pack(-side => 'left');
$helpbutton->pack(-side => 'right');
$menubar->pack(-side => 'top', -fill => 'x');
#$to_label->pack(-side => 'left');
#$to_entry->pack(-side => 'left');
#$sillyframe->pack(-side => 'top', -fill => both);
$label->pack(-side => 'top', -anchor => w);
$frame->pack(-side => 'top', -fill => both);
$scroll->pack(-side => 'right', -fill => 'y', -anchor => e);
$text->pack(-side => 'right', -fill => 'both', -anchor => w);
$label1->pack(-side => 'top', -fill => 'both', -anchor => e);
$button->pack(-side=> 'top', -anchor => e);
$status->pack(-side => 'bottom', -fill => 'x', -anchor => n);

# Let Perl/Tk handle window events.
MainLoop;


# Subroutine to handle button click.
sub exit_choice {

print "You chose the Exit choice!\n";
exit;
}

sub john_doe_is_happy {

print "You chose the Exit choice!\n";
exit;
}

sub enc_choice {
# Fill in status area.
$status->configure(-text=>"Encryption."
$button->configure(-text=>"Encrypt", -command=>\&encrypt);
$label->configure(-text=>"Message:"
$text->delete('1.0', 'end');
}

sub dec_choice {
# Fill in status area.
$status->configure(-text=>"Decryption."
$button->configure(-text=>"Decrypt", -command=>\&decrypt);
$label->configure(-text=>"Encrypted Message:"
}

sub about_choice {
# Fill in status area.
$status->configure(-text=>"About program."
$dialog->show('-global');

}

sub encrypt
{
$unf = $text->index('end');
$mynewmessage = $text->get('1.0', $unf);
$numstr = "";
$len=length($mynewmessage);
$xi=":~?";
$key = 8;
if ($key =~ /^\D+$/)
{
$key = makeKey($key);
}
for($i=0;$i<$len;$i++)
{
$xi = giveLets(int(rand(10) + 1));
$unf = substr($mynewmessage, $i, 1);
$dx=ord($unf);
$dx=$dx<<$key;
$dx=$dx^$key;
$numstr .= ($dx.$xi);
}
$text->delete('1.0', 'end');
$text->insert('1.0', $numstr);
undef($numstr);
undef($mynewmessage);
}

sub decrypt
{
$unf = $text->index('end');
$mynewmessage = $text->get('1.0', $unf);
$numstr = &quot;&quot;;
@vm = split(/\D+/, $mynewmessage);
$key = 8;
if ($key =~ /^\D+$/)
{
$key = makeKey($key);
}

foreach (@vm)
{
$dx= $_;
$dx=$dx^$key;
$dx=$dx>>$key;
$zx= $dx;
$zx = chr($dx);
$numstr .= $zx;
}
$text->delete('1.0', 'end');
$text->insert('1.0', $numstr);
undef($numstr);
undef($mynewmessage);

}

sub giveLets($num)
{
$num = shift;
$d = &quot;&quot;;
for($l=0; $l<$num; $l++)
{
$x = int(rand(126)+34);
if($x >= 48 && $x <= 59)
{
$x += 20;
}
elsif($x > 128)
{
$x -= 35;
}
$p = chr($x);
$d .= $p;
}
return $d;
}
sub makeKey(key)
{
$z=0;
$klen=length($key);
for($f=0;$f<$klen;$f++)
{
$z .= ord(substr($key, $i, 1))
}
return $z
}
luciddream@subdimension.com