#! /usr/bin/perl -w # SMB Messenger # Waider, January 1998 # Modified January 2001 use strict 'vars'; use Tk; my $msgcmd = "/usr//bin/smbclient -d0 -M"; my $host = "waidernt"; my $message = "ping!"; my $main = new MainWindow; $main->Label( -text => 'WinPopup' )->pack; my $frame = $main->Frame; $frame->Label(-text => 'Host: ')->pack( -side => 'left' ); my $hostEntry = $frame->Entry( -textvariable=>\$host ); $hostEntry->pack(-fill=>'x', -expand=>'yes' ); $frame->pack(-fill=>'x', -expand=>'yes'); $frame = $main->Frame; my $listenEntry = $frame->Text( -width => '10', -height => '10' ); $listenEntry->pack( -fill => 'x', -expand => 'yes' ); $frame->pack(-fill=>'x', -expand=>'yes'); $main->Button( -text => 'Send', -command => sub{ &sendmes } ) ->pack( -side => 'right' ); MainLoop; sub sendmes { $message = $listenEntry->get( '1.0', 'end' ); if ( $message !~ /^\s*$/ ) { open( MSG, "|$msgcmd $host >/dev/null 2>&1"); print MSG $message; close( MSG ) or warn $! ? "Perl error $!" : "Returned $?"; $listenEntry->delete( '1.0', 'end' ); } }