Skip to content

Instantly share code, notes, and snippets.

@gardejo
Created May 6, 2010 12:35
Show Gist options
  • Save gardejo/392076 to your computer and use it in GitHub Desktop.
Save gardejo/392076 to your computer and use it in GitHub Desktop.
Toggle Excel every N seconds.
#!perl
# (ネタ) ExcelをN秒毎に閉じたり開いたりするだけの簡単なお仕事
# ****************************************************************
# pragma(ta)
# ****************************************************************
use strict;
use warnings;
use utf8;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
# use List::Util qw(
# first
# );
use Regexp::Assemble qw();
use Win32::GuiTest qw(
:SW
FindWindowLike
GetWindowText
IsWindowVisible
SendMessage
ShowWindow
UnicodeSemantics
WaitWindowLike
);
# use Win32::Registry qw(
# HKEY_LOCAL_MACHINE
# );
# ****************************************************************
# global constant(s)
# ****************************************************************
# 敢えてReadonlyを使うまでもないかと思ったので、constantもしていない。
my %CLASS_OF = (
EXCEL_WINDOW => qr{^XLMAIN$},
);
# my %NUMBER_OF = (
# TRIALS => 3,
# );
my %SECOND_OF = (
TICK => 3,
WAIT_BEFORE_GIVING_UP => 5,
);
my %TITLE_OF = (
EXCEL_WINDOW => qr{^Microsoft Excel - }, # 環境によって変わりそう……。
);
my %HANDLE_OF = (
ROOT => 0,
);
my %WM = ( # Win32::GuiTestには":SW"はあるけど":WM"とかはない?
CLOSE => 0x0010,
);
# ****************************************************************
# main routine
# ****************************************************************
main()
unless caller(); # Stolen from id:lestrrat.
sub main {
# Was it alternated by "use Win32::GuiTest"?
die 'This script runs only under Win32 environment'
if $^O ne 'MSWin32';
UnicodeSemantics(1);
my $excel_window = _get_excel_window();
local $SIG{INT} = sub {
SendMessage($excel_window, $WM{CLOSE}, 0, 0);
_farewell();
};
# Do not write int($ARGV[0] || $Const)" because 0.2 is invalid!
my $tick = defined $ARGV[0] && int($ARGV[0]) || $SECOND_OF{TICK};
my $minimized = 0;
while (1) {
_farewell()
unless IsWindowVisible($excel_window);
sleep $tick;
# my $preserved_window = Win32::GuiTest::GetForegroundWindow();
# "Win32::GuiTest::SendKeys('%{SPACE}n')" is quite forcible.
ShowWindow($excel_window, $minimized ? SW_RESTORE : SW_MINIMIZE);
$minimized = ~$minimized; # Flip the bit (not a regexp matching "=~").
# Win32::GuiTest::SetForegroundWindow($preserved_window);
}
return;
}
# ****************************************************************
# subroutine(s)
# ****************************************************************
# Excelウィンドウを新たに開いて、そのウィンドウハンドルを返す。
sub _get_excel_window {
my @existent_excel_windows = _find_excel_windows();
if (@existent_excel_windows) {
return _get_new_excel_window(@existent_excel_windows);
}
else {
_run_excel();
return _wait_excel_window();
}
}
# 起動時に既存であろうがなかろうが関係なく、実行時のExcelウィンドウ群を返す。
sub _find_excel_windows {
return FindWindowLike(
$HANDLE_OF{ROOT},
$TITLE_OF{EXCEL_WINDOW},
$CLASS_OF{EXCEL_WINDOW}, # これがあるのでTITLE_OF指定は要らないかも。
undef, # Child ID
undef, # Max level
);
}
# Excelを新たに起動し、そのウィンドウハンドルを返す。
sub _get_new_excel_window {
my @existent_excel_windows = @_;
_run_excel();
# There is a simple implementation without Regexp::Assemble.
# my $new_excel_window;
# my %existent_excel_window; # It is a look-up table.
# @existent_excel_window{@existent_excel_windows} = ();
# my $trial = 1;
# while ($trial ++ <= $NUMBER_OF{TRIALS}) {
# sleep $SECOND_OF{WAIT_BEFORE_GIVING_UP};
# $new_excel_window = first {
# ! exists $existent_excel_window{$_};
# } _find_excel_windows();
# return $new_excel_window
# if $new_excel_window;
# }
# die 'Could not identify a new excel window';
# There is a smart implementation with Regexp::Assemble.
my $regexp_assembler = Regexp::Assemble->new;
foreach my $existent_excel_window (@existent_excel_windows) {
$regexp_assembler->add(
'^(?!'
. GetWindowText($existent_excel_window) # It is utf8 flagged string.
. '$)'
);
}
return _wait_excel_window($regexp_assembler->re);
}
sub _run_excel {
# system()にExcelのフルパスを渡すと、開いたExcelを閉じるまで
# system()が処理を掴んで離さない。
# 結局、単に"start excel"を渡せば万事うまく行く。
# Excelだからいいようなものの、レジストリに書いてくれないような
# オレオレアプリの場合にどうするのが適当かは、その時に考えよう……。
# my $excel_path = _get_excel_path();
# system(qq(start "$excel_path"))
# and die 'Could not run Excel';
# Perl5ではシェルの返戻値とPerlの真偽値が逆転しているのでorではなくand。
# Perl6ではいい感じになったような……。
system("start excel")
and die 'Could not run Excel';
return;
}
# # 規定のサブキーは「短いパス(8.3)」なので、敢えて「長いパス」を得ている。
# sub _get_excel_path {
# $HKEY_LOCAL_MACHINE->Open(
# 'Software\Microsoft\Windows\CurrentVersion\App Paths\excel.exe',
# my $registry
# )
# or die 'Could not open registry';
# $registry->QueryValueEx('Path', my $type, my $value)
# or die 'Could not query the value of path of Excel';
# return $value . 'EXCEL.EXE';
# }
# Excelウィンドウの存否を確認し、最初に見つかったウィンドウハンドルを返す。
# Excelが複数枚上がっていても、一つしか返さない。
# Excelが上がっていない場合、$SECOND_OF{WAIT_BEFORE_GIVING_UP}秒待って死ぬ。
sub _wait_excel_window {
my $title_of_excel_window = shift || $TITLE_OF{EXCEL_WINDOW};
my $window_handle = WaitWindowLike(
$HANDLE_OF{ROOT}, # Parent window
$title_of_excel_window,
$CLASS_OF{EXCEL_WINDOW},
undef, # ID
undef, # Depth
0, # Parent window ID: Root (0)
$SECOND_OF{WAIT_BEFORE_GIVING_UP},
);
die 'Could not find an excel window'
unless $window_handle; # 引数有りの場合はanでなくtheの方が厳密だけど。
return $window_handle;
}
sub _farewell {
warn "Target window had been closed. Farewell!\n";
exit;
}
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=encoding utf-8
=head1 NAME
toggle_excel.pl - (ネタ) ExcelをN秒毎に閉じたり開いたりするだけの簡単なお仕事
=head1 SYNOPSIS
Toggle Excel every 3 seconds ...
% perl toggle_excel.pl
or toggle Excel every 1 second ...
% perl toggle_excel.pl 1
=head1 DESCRIPTION
=over 4
=item *
昨日でゴールデンウィークは終わりだお……
=item *
今日は休みの谷間なのに仕事だお……
=item *
年休を3日くっつけて11連休をぶっ込めば良かったお……
=item *
でも定期健康診断を明日に押し込まれたので諦めたんだお……
=item *
今日締めのレビューも(メール残業などが禁じられているので)まだあるんだお……
=item *
電車の乗車率も抑え目で、オフィスの人口も減り気味だお……
=item *
社員証兼IDカードを忘れてオフィスに入れなかった同期のMさんを共連れして入室したお……
=item *
今日はみんなリハビリが必要だお……
=item *
こんな日に真面目に仕事する気が湧かないお……
=item *
Excelを閉じたり開いたりして仕事をする振りをするお……
=item *
Excelを手で閉じたり開いたりするのはしんどいお……
=item *
N秒毎に自動でExcelを閉じたり開いたりするスクリプトを作ったお! ←いまここ
=back
=head1 MEMORANDUM
=over 4
=item *
既にExcelが開いてある場合、C<Win32::GuiTest::WaitWindowLike()>では新しく
Excelを開いても操作対象は古いExcelになります。
これを回避するため、意地でも新しいExcelのウィンドウハンドルを返すように
しています。
ウィンドウタイトル群をC<Win32::GuiTest::GetWindowText()>でそれぞれ得て、
L<Regexp::Assemble|Regexp::Assemble>で既存ウィンドウのウィンドウタイトル
「以外」という正規表現を構築し、それをC<Win32::GuiTest::WaitWindowLike()>へ
渡すという案配です(ウィンドウIDを正規表現では渡せないため)。
これはオーバーキル気味なので、コメントアウトしてあるような複数回試行をする方が
素直かも知れません。
=item *
既にExcelウィンドウが開かれている場合の処理など、色々余計なことを付け加えた
結果、ゴテゴテとしたスクリプトになってしまいました。SIGINTで無限ループを殺す
際にExcelを閉じないようにすればいいかと思いきや、既存のExcelがいた場合に
操作対象のウィンドウを同定しなければならないことは変わりません。
=item *
C<SW_HIDE>とC<SW_SHOW>をトグルするならC<Win32::GuiTest::IsVisible()>が
使えたのですが、これだとウィンドウ自体が隠れる(タスクバーからも消える)ので、
要件を厳密に満たすとは言い難く、臨場感にも欠けます(何のだよ)。
そこで、C<$minimized>というフラグによって最小化・元に戻すという挙動を
使い分けています(C<$minimized>は都度ビット反転しています)。
=item *
C<Win32::GuiTest::ShowWindow()>でウィンドウを元に戻した場合に、
戻したウィンドウが最前面に出てくることを防ぎたい場合、
当該処理以前に最前面にあるウィンドウをC<Win32::GuiTest::GetForegroundWindow()>
で保存しておき、C<Win32::GuiTest::SetForegroundWindow()>で戻す腹案があります。
ほぼノータイムで切り替えられるので、例えば連続する文字入力中でも、
基本的には切り替わりをほとんど気にせずに済みます。
もうちょっと洗練された方法がありそうなのですが、まあ、ほら、ネタですし。
=item *
敢えて140字以内に抑えてtweetしたい場合には、諸々の場合分けの他、
Excelの起動をも徹底的に省くと、以下のようなPerl golfを書けないこともありません。
perl -MWin32::GuiTest=:ALL -e "$h=WaitWindow('^Microsoft Excel');while(1){sleep 3;ShowWindow($h,IsWindowVisible($h)?SW_HIDE:SW_SHOW)}" #140字
L<Acme::PerlVMGolf|Acme::PerlVMGolf>はコードの文字数ではB<なく>
オペコードの処理数が判断基準なのですが、まあ、ほら、あくまでネタですし。
=item *
整数秒より細かい刻みで処理したい場合、L<Time::HiRes|Time::HiRes>を使って
C<sleep()>してください。
フォアグラウンドに真っ赤なパターンで塗りたくったExcelを、
バックグラウンドに真っ青なパターンで塗りたくったExcelを、
それぞれ用意した状態で0.1秒刻みでパカパカすると、ポケモン事件を再現出来ます!
=item *
先生、次は年末、櫛の歯を折るように人が一人また一人と休んでいく際に
使えると思います!
=item *
社内SNSにC<[露偽]悪趣味>でL<上記のDESCRIPTION|/DESCRIPTION>を書いたら、
本気にされそうになったでござる。
日頃の行い次第でござるね!
=back
=head1 SEE ALSO
=over 4
=item *
L<Win32::GuiTest|Win32::GuiTest>
=item *
L<http://twitter.com/gardejo/status/13466962452>,
L<http://twitter.com/gardejo/status/13467198479>
=back
=head1 TO DO
Just kidding.
=over 4
=item *
More tests
=item *
English translations of comments and documentation
=back
=head1 AUTHOR
=over 4
=item MORIYA Masaki, alias Gardejo
C<< <moriya at cpan dot org> >>,
L<http://gardejo.org/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2010 MORIYA Masaki, alias Gardejo
This script is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>.
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment