1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/IconFile.pm $ $Author: autrijus $
# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
package Win32::Exe::IconFile;
use strict;
use base 'Win32::Exe::Base';
use constant FORMAT => (
Magic => 'a2',
Type => 'v',
Count => 'v',
'Resource::Icon' => [ 'a16', '{$Count}', 1 ],
Data => 'a*',
);
use constant DEFAULT_ARGS => (
Magic => "\0\0",
Type => 1,
Count => 0,
Data => '',
);
use constant DISPATCH_FIELD => 'Magic';
use constant DISPATCH_TABLE => (
"\0\0" => '',
"MZ" => '__BASE__',
'*' => sub { die "Invalid icon file header: $_[1]" },
);
sub icons {
my $self = shift;
$self->members(@_);
}
sub set_icons {
my ($self, $icons) = @_;
$self->SetCount(scalar @$icons);
$self->set_members('Resource::Icon' => $icons);
$self->refresh;
foreach my $idx (0 .. $#{$icons}) {
$self->icons->[$idx]->SetImageOffset(length($self->dump));
$self->SetData( $self->Data . $icons->[$idx]->Data );
}
$self->refresh;
}
sub dump_iconfile {
my $self = shift;
my @icons = $self->icons;
my $obj = $self->require_class('IconFile')->new;
$obj->set_icons(\@icons);
return $obj->dump;
}
sub write_iconfile {
my ($self, $filename) = @_;
$self->write_file($filename, $self->dump_iconfile);
}
1;
|