=**************************************
= Name: Sending Email with Perl/Tk
= Description:This is a simple Perl/Tk a
= pplication that will send Email using th
= e Net::SMTP module. So if you ever wonde
= red about Creating a GUI to send email,
= then check this out.
= By: Randy McCleary
=
=This code is copyrighted and has = limited warranties.Please see http://w
= ww.Planet-Source-Code.com/vb/scripts/Sho
= wCode.asp?txtCodeId=540&lngWId;=6 =for details. =**************************************
#!/usr/bin/perl -w
#######################################################
## This is a simple Perl/Tk application that will send
## Email using a visual GUI Form and SMTP.
#######################################################
use strict;
use Tk;
use Tk::Dialog;
use Net::SMTP;
#############################################
## Here is where we set will the Constant
## values, that are used to send the Email
## $MailHost - HostName or IP Address
## $FromEmail - Email address sending from
## $FromName - Name sending from, will show
## in Inbox as the from name.
#############################################
my $MailHost = 'mailhost';
my $FromEmail = 'my_email_address@yahoo.com';
my $FromName = 'Email Tester';
my $frmMain = MainWindow->new;
$frmMain->title("SendEmail");
$frmMain->geometry("525x441+8+8");
######################################
## Create the Labels and the Text
## Entries.
######################################
my $lblTo = $frmMain->Label(
-anchor => "w",
-text => "To:",
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 10 bold",
-foreground => "#140F7B"
);
my $lblSubject = $frmMain->Label(
-anchor => "w",
-text => "Subject:",
-background => "#D4D0C8",
-cursor => "",
-font => "Tahoma 10 bold",
-foreground => "#140F7B"
);
my $txtTo = $frmMain->Entry(
-borderwidth => 1,
-cursor => "",
-font => "Tahoma 8 normal",
-foreground => "#000000",
-relief => "sunken"
);
my $txtSubject = $frmMain->Entry(
-borderwidth => 1,
-cursor => "",
-font => "Tahoma 8 normal",
-foreground => "#000000",
-relief => "sunken"
);
my $txtBody = $frmMain->Text(
-borderwidth => 1,
-font => "Tahoma 8 normal",
-relief => "solid"
);
######################################
## Place the Labels and Text Entries
## on the form.
######################################
$lblTo->place(
-width => 96,
-height => 24,
-x => 40,
-y => 32
);
$lblSubject->place(
-width => 96,
-height => 24,
-x => 40,
-y => 64
);
$txtTo->place(
-width => 264,
-height => 24,
-x => 144,
-y => 32
);
$txtSubject->place(
-width => 264,
-height => 24,
-x => 144,
-y => 64
);
$txtBody->place(
-width => 432,
-height => 256,
-x => 40,
-y => 128
);
###################################
## Create the command buttons
###################################
my $cmdSend = $frmMain->Button(
-activebackground => "#FFFCBF",
-activeforeground => "#E30229",
-background => "#FFFFFF",
-borderwidth => 1,
-text => "Send",
-command => sub{SendMail()},
-cursor => "",
-font => "Tahoma 8 bold",
-foreground => "#140F7B",
-relief => "solid"
);
my $cmdClear = $frmMain->Button(
-activebackground => "#FFFCBF",
-activeforeground => "#E30229",
-background => "#FFFFFF",
-borderwidth => 1,
-text => "Clear",
-command => sub{Clear()},
-cursor => "",
-font => "Tahoma 8 bold",
-foreground => "#140F7B",
-relief => "solid"
);
my $cmdExit = $frmMain->Button(
-activebackground => "#FFFCBF",
-activeforeground => "#E30229",
-background => "#FFFFFF",
-borderwidth => 1,
-text => "Exit",
-cursor => "",
-font => "Tahoma 8 bold",
-command => [$frmMain => 'destroy'],
-foreground => "#140F7B",
-relief => "solid"
);
######################################
## Place the command buttons
######################################
$cmdSend->place(
-width => 96,
-height => 32,
-x => 88,
-y => 400
);
$cmdClear->place(
-width => 96,
-height => 32,
-x => 200,
-y => 400
);
$cmdExit->place(
-width => 96,
-height => 32,
-x => 312,
-y => 400
);
MainLoop;
############################ SUBS ################################
##################################################################
## Sub: Calculate
## Description: This sub will clear all the Text Entries
##################################################################
sub Clear {
$txtTo->delete(0, 'end');
$txtSubject->delete(0, 'end');
$txtBody->delete('1.0', 'end');
}
##################################################################
## Sub: SendMail
## Description: This sub will get all the input data and Sends
## out the email message. It also checks to make sure your
## sending to a valid e-mail address and shows dialogs.
##################################################################
sub SendMail {
my $ToEmail = $txtTo->get;
my $Subject = $txtSubject->get;
my $Body = $txtBody->get('1.0', 'end');
my $smtp = Net::SMTP->new($MailHost);
my $dialog = '';
if (IsEmail($ToEmail) == 1) {
$smtp->mail($FromEmail);
$smtp->to($ToEmail);
$smtp->data();
$smtp->datasend("To: $ToEmail\n");
$smtp->datasend("Subject: $Subject\n");
$smtp->datasend("From: $FromName <$FromEmail> \n");
$smtp->datasend("$Body\n\n\n");
$smtp->datasend("Message Sent by Perl Application\n");
$smtp->dataend();
$smtp->quit();
$dialog = $frmMain->Dialog(
-title => "SendEmail: Message Sent",
-text => "The message was successfully sent to $ToEmail",
-buttons => ["OK"]);
$dialog->Show();
}
else {
$dialog = $frmMain->Dialog(
-title => "SendEmail: Message Not Sent",
-text => "You must specify a Valid Email address to send to.\n",
-buttons => ["OK"]);
$dialog->Show();
}
}
##################################################################
## Sub Name: IsEmail.
## Description: This sub validates the input to check to see if
## the input is a valid format of an e-mail address.
## Example: webmaster@msn.com.
##################################################################
sub IsEmail {
my $InputString = shift;
if ($InputString =~ /^[\w.]+@\w[\w.-]+\w\.[A-Za-z]{2,4}$/) {
return 1;
}
else {
return 0;
}
}
|
