Tweet

WMIを使ってコーデックの一覧を得るスクリプト。かなり煩雑で独自表記っぽくなってるけど、これもMooseの勉強の一環ってことで。コマンドプロンプトからperl codec.plとすると次のような結果が得られる。

C:\> perl codec.pl
No.1
Manufacturer: Microsoft Corporation
Name: C:\Windows\system32\MSRLE32.DLL
Path: \windows\system32\
Version: 6.1.7600.16490
Caption: c:\windows\system32\msrle32.dll
Drive: c:
Extension: dll
FileType: Application Extension
Group: Video
CreationDate: 2010/02/11 16:41:07
InstallDate: 2010/02/11 16:41:07
LastModified: 2009/12/19 18:47:46

No.2
Manufacturer: None
Name: C:\Windows\system32\FF_ACM.ACM
Path: \windows\system32\

    〜以下省略〜

表示する情報を制限したり、管理者権限のあるユーザー名とパスワードがわかれば、他のPCにアクセスしてリストを取り出すこともできる。

C:\> perl codec.pl --server コンピューター名 --user ユーザー名 --password パスワード --prop Name --prop Manufacturer
No.1
Name: C:\Windows\system32\MSRLE32.DLL
Manufacturer: Microsoft Corporation

No.2
Name: C:\Windows\system32\FF_VFW.DLL
Manufacturer: None

No.3
Name: C:\Windows\system32\FRAPSV64.DLL
Manufacturer: Beepa P/L

    〜以下省略〜

使っているテクニックについては、日を改めて説明しよう。（一度に書いたらネタが無くなるしね！）

codec.pl

#!/usr/bin/perl
package Me;
use utf8;
use errors -with_using;
use Moose;
use MooseX::AttributeHelpers;

with "MooseX::Getopt";

use Win32::OLE qw! in !;
# 日付文字列の表示に必要
use Win32::OLE::Variant;

binmode STDOUT => ":raw :encoding(cp932)";
binmode STDERR => ":raw :encoding(cp932)";

# カラー表示するか否か
has color => ( is => "ro", isa => "Bool", default => 0 );

# 表示するプロパティ一覧
has prop => ( is => "ro", isa => "ArrayRef", auto_deref => 1,
    default => sub { [ qw!
        Manufacturer Name Path
        Version Caption Drive
        Extension FileType Group
        CreationDate InstallDate LastModified
    ! ] } );

# サーバー名
has server => ( is => "ro", isa => "Str", default => "localhost" );

# ユーザー名
has user => ( is => "ro", isa => "Str", default => "administrator" );

# パスワード
has password => ( is => "ro", isa => "Str", default => "" );

# カウンター
has _counter => ( metaclass => "Counter", default => 1 );

# 画面表示に使うprintf文字列
has _pString => ( is => "ro", isa => "Str", lazy_build => 1 );
sub _build__pString { my $self = shift;
    my $str = "";
    $str .= "\e[1;32m$_: \e[m%s\n" for $self->prop;
    $str .= "\n";
    if ( $self->color ) {
        # コンソールに色を付ける
        require Win32::Console::ANSI;
    } else {
        $str =~ s/\e.*?m//g;
    }
    $str;
}

# WMIオブジェクト
has _wmi => ( is => "ro", isa => "Object", lazy_build => 1 );
sub _build__wmi { my $self = shift;
    # UTF-8を使えるようにする
    # あと、警告レベルも上げる
    Win32::OLE->Option(
        CP => Win32::OLE::CP_UTF8,
        Warn => 3,
    );
    my $namespace = "root/CIMV2",
    my $locator = Win32::OLE->CreateObject( "WbemScripting.SWbemLocator" );
    try {
        $locator->connectserver(
            $self->server, $namespace, $self->user, $self->password );
    } catch Error using {
        $locator->connectserver;
    };
}

# 日付変換オブジェクト
has _wbemDateTime => ( is => "ro", isa => "Object",
    default => sub { Win32::OLE->CreateObject( "WBemScripting.SWbemDateTIme" ) } );

# メインルーチン
sub run { my $self = shift;
    my $items = $self->_wmi->ExecQuery( "Select * From Win32_CodecFile" );
    for my $i ( in $items ) {
        printf "No.%d\n", $self->_counter;
        printf $self->_pString, map {
            my $item = $i->$_;
            if ( defined $item ) {
                $item =~ /\d{14}\.\d{6}\+\d{3}/
                    and $item = $self->_getDate( $item );
                $item;
            } else  {
                "None";
            }
        } $self->prop;
        $self->inc__counter;
    }
}

# 日付文字列変換関数
sub _getDate { my $self = shift;
    $self->_wbemDateTime->{value} = shift;
    $self->_wbemDateTime->GetVarDate;
}

__PACKAGE__->meta->make_immutable;

package main;
Me->new_with_options->run;