diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Win32/Exe/IconFile.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Win32/Exe/IconFile.pm | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Win32/Exe/IconFile.pm b/Master/tlpkg/tlperl.straw/lib/Win32/Exe/IconFile.pm new file mode 100755 index 00000000000..8c24160951d --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Win32/Exe/IconFile.pm @@ -0,0 +1,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; |