#!/usr/bin/perl use strict; use Win32::Process; use Tk; use Win32::OLE qw(EVENTS); use Win32::OLE::Const 'Microsoft Outlook'; use IO::Socket; use subs qw(dump_calendar Event GetMessage ErrorReport exit_app); require Tk::ROText; my $homelog = "H:/outlook_calendar.dump"; my $ProcessObj; Win32::Process::Create($ProcessObj, 'C:\Perl\bin\perl.exe', 'perl H:\bin\receiver.pl', 0, DETACHED_PROCESS , ".")|| die ErrorReport(); ######client coonection to above server process my $socket = IO::Socket::INET->new( PeerAddr => 'localhost', PeerPort => '8008', Proto => 'tcp', ); defined $socket or die "ERROR: Can't connect to port 8008\n"; #Get the active outlook process my $outlook = Win32::OLE->GetActiveObject('Outlook.Application') or die "Error! $!\n"; #Event handler for newmails/reminders/etc Win32::OLE->WithEvents($outlook,\&Event,"ApplicationEvents_10"); ######################################### #Create a basic window with a text widget my $mw = new MainWindow; my $mw_text = $mw->Scrolled(qw/ROText -scrollbars ose/)->pack; my $mw_entry = $mw->Entry()->pack(qw/-fill x -pady 5/); $mw->bind('' => sub { $mw_entry->Tk::focus }); #$mw_entry->bind('' => [\&broadcast, $socket]); $mw_entry->bind('' => sub { my $text = $mw_entry->get; $mw_entry->delete(qw/0 end/); print $socket "$text\n"; }); $mw->protocol('WM_DELETE_WINDOW', \&exit_app); MainLoop; ########################################### #Win32::OLE->MessageLoop(); #Don't need it? already in tk mainloop sub broadcast { my ($ent, $sock) = @_; my $text = $ent->get; $ent->delete(qw/0 end/); print $socket $text, "\n"; } sub ErrorReport{ print Win32::FormatMessage( Win32::GetLastError() ); } sub dump_calendar { my $namespace = $outlook->GetNamespace("MAPI"); my $folder = $namespace->GetDefaultFolder(olFolderCalendar); my $items = $folder->Items; #Format a date string to use for a Start time filter### my ($dsec,$dmin,$dhour,$dmday,$dmon,$dyear,$dwday,$dyday,$disdst) = localtime(time); my $fixed_year = $dyear - 100; my $fixed_month = $dmon + 1; my $mon = sprintf("%02d", $fixed_month); my $day = sprintf("%02d", $dmday); my $year = sprintf("%02d", $fixed_year); print "DATE: $mon : $day : $year\n "; my $date_string = "$mon/$day/$year"; ####################################################### my $strToday = "[Start] >= '" .$date_string ." 12:00 am' and [Start] <= '". $date_string . " 11:59 pm'"; $items->Sort("[Start]"); $items->{IncludeRecurrences} = 1; my $appts = $items->Restrict("$strToday"); $appts->Sort("[Start]"); open (HL, ">$homelog") or die "Couldn't open $homelog: $!\n"; my $current_item = $appts->GetFirst; while ($current_item){ #print "Subject = " . $current_item->{Subject} . "\n"; print HL "Subject = " . $current_item->{Subject} . "\n"; print HL "Start = " . $current_item->{Start}->Date . " " . $current_item->{Start}->Time ."\n"; print HL "Location = " . $current_item->{Location} . "\n"; $current_item = $appts->GetNext; } close (HL); } sub Event { my ($Obj,$Event,@Args) = @_; if ($Event eq "NewMail" ) { &GetMessage; } elsif ($Event eq "Reminder") { my $appt_item = shift @Args; my $start_time = 'N/A'; my $subject = $appt_item->Subject; my $location = $appt_item->Location; if (defined $appt_item->{Start}){ $start_time = $appt_item->{Start}->Time; } print $socket "APPT: $subject Location: $location Start: $start_time\n"; } print "EVENT: $Event\n"; #Win32::OLE->QuitMessageLoop(); } sub GetMessage { my $namespace = $outlook->GetNamespace("MAPI"); my $folder = $namespace->GetDefaultFolder(olFolderInbox); my $mailitems = $folder->Items; my $firstmail = $mailitems->GetFirst; my $subject = $firstmail->Subject; #my $sendername = $firstmail->SenderName; #Outlook security prompt my $sendername = 'unknown'; #print "Sender: '$sendername' Subject: '$subject'\n"; print $socket "MAIL: Sender: '$sendername' Subject: '$subject'\n"; } sub exit_app { $ProcessObj->Kill(0); $mw->destroy; }