#!c:\perl\bin\perl.exe -w use Tk; use Win32::OLE; ###################### # Begin user defaults # (Stuff you can change) ###################### $loop_minutes = 2; # How many minutes between trips $char_string = "\040\010"; # What char string to trip the shell with. $exit_time_regex = "23:[0-9]{2}:[0-9]{2}"; # When to exit program. ###################### # End user defaults # Begin GUS subs ###################### # Return Date Time Group in ISO 8601 approved fashion. sub update_DTG { my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time); my $DTG = sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec ); return ("$DTG"); } # Send a character string to trip any screensaver. sub trip_screensaver { $WshShell = new Win32::OLE 'WScript.Shell' || die "No new shell object $! $?"; $WshShell->SendKeys($char_string); } ###################### # End GUS subs # Begin GUI stuff ###################### # First declare the main GUI frame and all her daughters. my $mw = MainWindow->new( -title => ' Screensaver Delay' ); my $fm_top = $mw->Frame( -relief => 'flat', -borderwidth => 5 ); # Make all the frames. my $fm_btm = $mw->Frame( -relief => 'flat', -borderwidth => 5 ); # Build the label and entry box widgets for the 'File path' frame. $fm_top->Entry( -textvariable => \$last_trip, -background => "white", -foreground => 'blue', -relief => 'sunken', -font => 'courier' )->pack( -side => 'left', -expand => 1, -fill => 'x' ); $fm_btm->Button( -text => ' Start ', -command => \&start_tripping, -background => 'gray', -activebackground => 'red', -relief => 'raised', )->pack( -side => 'left', -expand => 1, -fill => 'x' ); $fm_btm->Button( -text => ' Pause ', -command => \&stop_tripping, -background => 'gray', -activebackground => 'blue', -relief => 'raised', )->pack( -side => 'left', -expand => 1, -fill => 'x' ); $fm_btm->Button( -text => ' Exit ', -command => \&exit, -background => 'gray', -activebackground => 'green', -relief => 'raised', )->pack( -side => 'left', -expand => 1, -fill => 'x' ); # Pack all the frames last. $fm_top->pack( -side => 'top', -expand => 1, -fill => 'x' ); $fm_btm->pack( -side => 'top', -expand => 1, -fill => 'x' ); $trip_flag = 0; sub start_tripping { $last_trip = "SS Delay Engaged."; $trip_flag = 1; } sub stop_tripping { $last_trip = "SS Delay Paused."; $trip_flag = 0; } $mw->repeat( $loop_minutes * 60 * 1000, \&ss_trip ); sub ss_trip { exit if update_DTG =~ /$exit_time_regex/; if ( $trip_flag ) { trip_screensaver(); $last_trip = update_DTG(); } } MainLoop;