#!perl -w
use strict;
use IO::File;
use Getopt::Long;
binmode STDOUT, ":utf8";

use Dumpvalue;
# see also:
# /Users/itsme-plain/phones/htc_typhoon/os/2_0_33_21/resfiles/extractdata.pl
#    convert bitmaps embedded in .rc's  into .BITMAP and .ICON
# /Users/itsme-plain/phones/htc_typhoon/os/2_0_33_21/resfiles/createbmpico.pl
#    convert .BITMAP and .ICON into .bmp and .ico
# /Users/itsme/cvsprj/xda-devtools/perlutils/imagedmp.pl
#    write info about various images

# todo: move decoders + savers in type specific handler objects.
# todo: separate dumping from decoding
# todo: saver should prefix filenames with source filename.
# todo: option to save all in one directory, or to mirror source dirtree
#
$|=1;
my $verbose=0;
my %resourcetypes= (
1 => { name=>'cursor', decoder=>\&cursordecoder, ext=>"cur", saver=>\&cursorsaver  },
2 => { name=>'bitmap', decoder=>\&bitmapdecoder, ext=>"bmp", saver=>\&bitmapsaver  },
3 => { name=>'icon', decoder=>\&icondecoder, ext=>"ico", saver=>\&iconsaver  },
4 => { name=>'menu', decoder=>\&menudecoder },
5 => { name=>'dialog', decoder=>\&dialogdecoder },
6 => { name=>'stringtable', decoder=>\&stringdecoder },
7 => { name=>'fontdir', decoder=>\&fontdirdecoder },
8 => { name=>'font', decoder=>\&fontdecoder },
9 => { name=>'accelerator', decoder=>\&acceleratordecoder },
10 => { name=>'rcdata', decoder=>\&rcdatadecoder },
11 => { name=>'messagetable', decoder=>\&messagetabledecoder },
12 => { name=>'group_cursor', decoder=>\&group_cursordecoder },
14 => { name=>'group_icon', decoder=>\&group_icondecoder },
16 => { name=>'version', decoder=>\&versiondecoder },
17 => { name=>'dlginclude', decoder=>\&dlgincludedecoder },
24 => { name=>'assembly', decoder=>\&asciidecoder },
# 23
222 => { name=>'mui', decoder=>\&muidecoder },
# 240
# 241
# 411

REGISTRY => { name=>'REGISTRY', decoder=>\&asciidecoder, ext=>"reg" },
TYPELIB => { name=>'TYPELIB', ext=>"tlb" },

WAVE => { name=>'WAVE',  ext=>"wav" },
IMAGE => { name=>'IMAGE',  ext=>"bmp" },
GIF => { name=>'GIF',  ext=>"gif" },
OSDGIFSRC => { name=>'OSDGIFSRC',  ext=>"gif" },
CERT => { name=>'CERT',  ext=>"cer" },
STYLESHEET => { name=>'STYLESHEET', decoder=>\&unicodedecoder, ext=>"css" },
#RCML_DLGDATA
23 => { name=>'genericfile'  },  # path[1] == filename
#CEUX/HI_RES_AWARE
);
my $bRecursive= 0;
my $savedir;

GetOptions(
    "v+"=>\$verbose,
    "r"=>\$bRecursive,
    "d=s"=>\$savedir,
) or die usage();
sub usage {
    "usage: winresdumper [-v {-v} {-v}] [-r] [-d SAVEDIR] {files or dirs or wildcards}\n";
}
die usage if (@ARGV==0);

sub canread {
    return -r $_[0] || ($^O eq 'cygwin' && -f $_[0]);
}
my ($resdata, $resrva);
for my $arg (@ARGV) {
    if ($arg eq "-") {
        processfile();
    }
    elsif (-d $arg) {
        processdir($arg);
    }
    elsif (canread($arg)) {
        processfile($arg);
    }
    else {
        for my $f (glob($arg)) {
            if (-d $f) {
                processdir($f);
            }
            elsif (canread($f)) {
                processfile($f);
            }
        }
    }
}
sub makeFullPath {
    my ($full, @parts)= @_;

    $full ||="";
    for my $path (@parts) {
        next if (!defined $path);
        $path =~ s{^/}{};         # remove leading slash
        $full =~ s{/?$}{/$path};  # remove trailing slash, append path
    }

    return $full;
}
sub processdir {
    my ($path)= @_;

    opendir(DIR, $path) or die "$!: reading $path\n";
    my @files= readdir DIR;
    closedir DIR;

    for (@files) {
        next if ($_ eq "." || $_ eq "..");
        my $file= makeFullPath($path, $_);
        if (-d $file)
        {
            $bRecursive && processdir($file);
        }
        elsif (canread($file)) {
            processfile($file);
        }
    }
}
sub filenamepart {
    my $fn= shift;
    $fn =~ s/[.\\\/]/_/g;
    return $fn;
}
sub processfile {
    my $fn= shift;
    my $data;
    if ($fn) {
        my $fh= IO::File->new($fn, "r") or die "$fn: $!\n";
        binmode $fh;
        $fh->read($data, -s $fh);
        $fh->close();
    }
    else {
        binmode STDIN;
        local $/;
        $data=<>;
    }

    my ($resofs, $ressize);
    ($resofs, $ressize, $resrva)= getexeresptr($data);
    if (!defined $resofs) {
        printf("---- no resources in %s\n", $fn) if $verbose>0;
        return;
    }

    $resdata= substr($data, $resofs, $ressize);

    printf("---- %08lx-%08lx %08lx  %s\n", $resofs, $resofs+$ressize, $resrva, $fn);

    my $tree= parseDirectory(filenamepart($fn), 0);
    my $resources= extractResources($tree);
}
sub extractResources {
    my $tree=shift;
    my %resbyid;
    for my $typenode ( @{$tree->{children}{ids}} ) {
        for my $idnode ( @{$typenode->{children}{ids}} ) {
            for my $langnode ( @{$typenode->{children}{ids}} ) {
                $langnode->{entry}->extractResources(\%resbyid);
            }
        }
    }
}
sub parseDirectory {
    my ($fn, $ofs, @path)= @_;
    my $hdrofs= $ofs;

    my %dir;
    (
        $dir{flags},
        $dir{timestamp},
        $dir{majversion},
        $dir{minversion},
        $dir{n_names},
        $dir{n_ids},
    )= unpack("VVvvvv",substr($resdata, $ofs, 16));

    $ofs+=16;

    my @fn= unpack("V*", substr($resdata, $ofs, $dir{n_names}*8));
    $ofs += $dir{n_names}*8;
    $dir{names}= [ map { {namerva=>$fn[2*$_], rva=>($fn[2*$_+1]&0x7ffffff), isleaf=>!($fn[2*$_+1]&0x80000000)} } 0..(@fn/2-1) ];

    my @fi= unpack("V*", substr($resdata, $ofs, $dir{n_ids}*8));
    $ofs += $dir{n_ids}*8;
    $dir{ids}= [ map { {id=>$fi[2*$_], rva=>($fi[2*$_+1]&0x7ffffff), isleaf=>!($fi[2*$_+1]&0x80000000)} } 0..(@fi/2-1) ];

    printf("%08lx-%08lx: directory %s n:%d i:%d\n", $hdrofs, $ofs, join("/", @path), $dir{n_names}, $dir{n_ids}) if $verbose>1;

    for (@{$dir{names}}) {
        if ($_->{namerva}&0x80000000) {
            $_->{name}= parseName($_->{namerva}&0x7fffffff);
        }
        else {
            $_->{nameid}= $_->{namerva};
        }
    }
    for (@{$dir{names}}, @{$dir{ids}}) {
        my $tag= exists $_->{name}?$_->{name}
                        :exists $_->{nameid}?sprintf("#%d", $_->{nameid})
                                :$_->{id};
        if ($_->{isleaf}) {
            $_->{entry}= parseEntry($fn, $_->{rva}, @path, $tag);
        }
        else {
            $_->{children}= parseDirectory($fn, $_->{rva}, @path, $tag);
        }
    }
    return \%dir;
}
sub parseName {
    my $ofs= shift;
    my $len= unpack("v", substr($resdata, $ofs, 2));
    $ofs+=2;
    my $name= pack 'U*', unpack 'v*', substr($resdata, $ofs, $len*2);
    printf("%08lx-%08lx: name '%s'\n", $ofs, $ofs+2+$len, $name) if $verbose>2;
    return $name;
}
sub typename {
    return "?" if !exists $resourcetypes{$_[0]};
    return "?" if !exists $resourcetypes{$_[0]}{name};
    return $resourcetypes{$_[0]}{name};
}
sub parseEntry {
    my ($fn, $ofs, @path)= @_;
    my %ent;
    (
        $ent{rva},
        $ent{size},
        $ent{cp},
        $ent{reserved},
    )= unpack("V*", substr($resdata, $ofs, 16));
    $ent{rva} -= $resrva;

    # !! in somefiles the resources are located in a packed UPX section
    #
    printf("%08lx-%08lx: entry %s %s\n", $ofs, $ofs+16, typename($path[0]), join("/", @path)) if $verbose>1;
    printf("%08lx-%08lx: data %s %s\n", $ent{rva}, $ent{rva}+$ent{size}, typename($path[0]), join("/", @path)) if $verbose>1;

    if ($ent{rva}<0) {
        printf("WARNING ENTRY not in resource section!!\n");
        return;
    }
    $ent{data}= substr($resdata, $ent{rva}, $ent{size});
    if (exists $resourcetypes{$path[0]}
        && exists $resourcetypes{$path[0]}{decoder}) {
        $ent{decoded}= $resourcetypes{$path[0]}{decoder}($ent{data}, @path);
    }
    else {
        printf("%08lx-%08lx: data %s\n", $ent{rva}, $ent{rva}+$ent{size}, join("/", @path));
        printf("unknown rsc type: %s\n", unpack("H1024", $ent{data}));
    }
    if ($savedir && exists $resourcetypes{$path[0]}) {
        if (exists $resourcetypes{$path[0]}{saver}) {
            printf("SAVER\n");
            $resourcetypes{$path[0]}{saver}($savedir, $fn, $ent{data}, @path);
        }
        elsif ($path[0] eq '23' || exists $resourcetypes{$path[0]}{ext}) {
            printf("DATASAVER\n");
            datasaver($savedir, $fn, $ent{data}, @path);
        }
    }

    return \%ent;
}

# don't know where this struct is used.
sub parseResourceHeader {
    my ($ofs)= @_;
    my %hdr;
    (
        $hdr{dataSize},
        $hdr{headerSize},
        $hdr{type},
        $hdr{name},
        $hdr{dataVersion},
        $hdr{flags},
        $hdr{language},
        $hdr{version},
        $hdr{characteristics},
    )= unpack("VVVVVvvVV", substr($resdata, $ofs, 32));
    return \%hdr;
}
sub cursordecoder {     # 1
    my ($data, @path)= @_;
    my ($x,$y)= unpack("vv", $data);
    printf("%5s: cursor hotspot=(%d,%d)\n", $path[1], $x,$y);
    icondecoder(substr($data, 4), @path);
}
sub bitmapdecoder {     # 2
    my ($data, @path)= @_;
    if (substr($data, 0, 4) eq "\x89PNG") {
        printf("%5s: PNG\n", $path[1]);
        # todo
        return;
    }
    my ($hdrsize, $w, $h, $planes, $bits, $comp, $imgsize, $xppm, $yppm, $cused, $cimp)= unpack("VVVvvV6", $data);
    # 0:hdrsize, 1:w, 2:h, 3:planes, 4:bits, 5:comp, 6:imgsize, 7:xppm, 8:yppm, 9:colorused, 10:colorimportant
    my $palettesize=0;
    if ($bits==24 || $bits==32) {
        $palettesize= 0;
    }
    elsif ($bits<=8) {
        if ($cused) {
            $palettesize= 4*$cused;
        }
        else {
            $palettesize= 4*(1<<$bits);
        }
    }
    elsif ($bits==16) {
        if ($comp==3) {
            $palettesize= 3*4;
        }
        else {
            warn "WARNING: unsupported bmp: bits=$bits, comp=$comp\n";
        }
    }
    else {
        warn "WARNING: unsupported bmp: bits=$bits, comp=$comp\n";
    }
    printf("%5s: %s h=%d (%d x %d) %d %2d  comp:%d s=%d  (%d,%d)/m %d %d\n", $path[1], $resourcetypes{$path[0]}{name}, $hdrsize, $w, $h, $planes, $bits, $comp, $imgsize, $xppm, $yppm, $cused, $cimp);

    my $bytespermaskline= 0;

    if ($comp==1) {
        printf("rle encoded bitmap\n");

        # <lengthbyte>:<colorbyte>
        # 00:00  : end of line
        # 00:01  : end of bitmap
        # 00:02 <deltaxbyte>, <deltaybyte> : delta: jump to pixel
        # 00:nn <n bitmap bytes>
        return;
    }

    my $bytesperline= int(($w*$bits+7)/8);
    if ($bytesperline&3) { 
        $bytesperline= ($bytesperline|3)+1;
    }
    my $calcedimgsize= ($bytesperline+$bytespermaskline)*$h;
    if ($imgsize*2==$calcedimgsize) {
        # !! some bitmaps specify h*2
        $h/=2;

        $bytespermaskline= int(($w+7)/8);
        if ($bytespermaskline&3) {
            $bytespermaskline = ($bytespermaskline|3)+1;
        }
        $calcedimgsize= ($bytesperline+$bytespermaskline)*$h;

    }

    if ($imgsize!=$calcedimgsize && $imgsize!=$bytesperline*$h && $imgsize!=$calcedimgsize+2) {
        if ($imgsize) {
            warn sprintf("WARNING: hdrimgsize(0x%x)!=calced(0x%x)\n", $imgsize,$calcedimgsize);
        }
        else {
            warn sprintf("WARNING: hdrimgsize=0\n");
        }
    }
    my $calcedtotalsize= $hdrsize+$calcedimgsize+$palettesize;
    if (length($data)!=$calcedtotalsize && length($data)!=$calcedtotalsize+2) {
        warn sprintf("WARNING: bitmap size mismatch: l(data)=0x%x, calced=0x%x\n", length($data), $calcedtotalsize);

        my @partname= qw(hdr pal bmp mask extra);
        my @partsize= ( $hdrsize, $palettesize, $bytesperline*$h, $bytespermaskline*$h );

        my @partdata;
        my $ofs= 0;
        for my $i (0..$#partname)
        {
            if ($ofs>=length($data)) {
                push @partdata, "";
            }
            elsif ($i>=@partsize) {
                push @partdata, substr($data, $ofs);
                $ofs= length($data);
            }
            else {
                push @partdata, substr($data, $ofs, $partsize[$i]);
                $ofs += $partsize[$i];
            }
        }

        printf("        hdrsize  width    height   bits pla comp     imgsize  xppm     yppm     used     imp\n");
        printf("   hdr: %s\n", join " ", map { sprintf("%08lx", $_) } unpack 'V*', $partdata[0]);
        printf("   pal: %s\n", join " ", map { sprintf("%08lx", $_) } unpack 'V*', $partdata[1]);
        printf("   bmp: %s\n", join " ", map { unpack 'H*',substr($partdata[2], $bytesperline*$_,$bytesperline) } 0..(length($partdata[2])/$bytesperline-1));
        printf("  mask: %s\n", join " ", map { unpack 'H*',substr($partdata[3], $bytespermaskline*$_,$bytespermaskline) } 0..(length($partdata[3])/$bytespermaskline-1)-1 ) if $bytespermaskline;
        printf(" extra: %s\n", unpack 'H*', $partdata[4]);

    }
}
sub icondecoder {	# 3
    my ($data, @path)= @_;
    bitmapdecoder($data, @path);
}
sub menudecoder {       # 4
    my ($data, @path)= @_;
    my @hdr= unpack("vv", $data);
    printf("menu %s  %d %d\n", join("/", @path), @hdr);
    my $ofs= 4;
    while ($ofs<length($data)) {
        my $flags= getUint16($data, $ofs);
        last if (!defined $flags);

        if ($flags&0x10) {
            my $txt= getUnicodeZString($data, $ofs);
            printf("  popup: %04x '%s'\n", $flags, $txt);
        }
        else {
            my $id= unpack("v", substr($data, $ofs, 2));
            $ofs+=2;
            my $txt= getUnicodeZString($data, $ofs);
            printf("  %04x %04x '%s'\n", $flags, $id, $txt);
        }
    }
}
sub getUint16 {
    return unless $_[1]+2 <= length($_[0]);
    my $w= unpack("v", substr($_[0], $_[1], 2));
    $_[1]+=2;
    return $w;
}
sub getUint32 {
    return unless $_[1]+4 <= length($_[0]);
    my $w= unpack("V", substr($_[0], $_[1], 4));
    $_[1]+=4;
    return $w;
}
sub getUnicodeZString {
    my $str= "";
    while (my $c=getUint16(@_)) {
        $str .= chr($c);
    }
    return $str;
}
sub getUnicodeString {
    my $str= "";
    my $len= $_[2];
    while ($len) {
        my $c= getUint16(@_);
        last if !defined $c;
        $str .= chr($c);
        $len--;
    }
    $str =~ s/\x00+$//;
    return $str;
}

sub align {
    my $x= $_[0] & ($_[1]-1);
    if ($x) {
        $_[0] += $_[1]-$x;
    }
}
sub getNameOrOrdinal {
    my $w1= getUint16(@_);
    return unless defined $w1;
    if ($w1==0xFFFF) {
        my $w2= getUint16(@_);
        return $w2;
    }
    elsif ($w1==0) {
        return "";
    }
    else {
        return chr($w1).getUnicodeZString(@_);
    }
}
sub dialogdecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    my $ofs=0;
    my $dlg= getdialog($data, $ofs);
    if ($ofs<=length($data)-4 || $ofs>length($data)) {
        warn sprintf("WARNING: ofs=%d len=%d\n", $ofs, length($data));
    }
    dumpdialog($dlg);
}
sub getstyle {
    my ($style, $type)= @_;
    my %types= (
        0x80=>'button',
        0x81=>'edit',
        0x82=>'static',
        0x83=>'listbox',
        0x84=>'scrollbar',
        0x85=>'combo',
    );
    my %styles= (
        0x80000000 => 'POPUP',
        0x40000000 => 'CHILD',
        0x20000000 => 'MINIMIZE',
        0x10000000 => 'VISIBLE',
        0x08000000 => 'DISABLED',
        0x04000000 => 'CLIPSIBLINGS',
        0x02000000 => 'CLIPCHILDREN',
        0x01000000 => 'MAXIMIZE',

        0x00C00000 => 'CAPTION',
        0x00800000 => 'BORDER',
        0x00400000 => 'DLGFRAME',

        0x00200000 => 'VSCROLL',
        0x00100000 => 'HSCROLL',
        0x00080000 => 'SYSMENU',
        0x00040000 => 'THICKFRAME',
        0x00020000 => 'GROUP',
        0x00010000 => 'TABSTOP',
        0x00020000 => 'MINIMIZEBOX',
        0x00010000 => 'MAXIMIZEBOX',
    );
    my %typestyles= (
        dialog=>{
            0x01=>'ABSALIGN',
            0x02=>'SYSMODAL',
            0x20=>'LOCALEDIT',   # /* Edit items get Local storage. */
            0x40=>'SETFONT',   # /* User specified font for Dlg controls */
            0x80=>'MODALFRAME',   # /* Can be combined with WS_CAPTION  */
            0x100=>'NOIDLEMSG',   # /* WM_ENTERIDLE message will not be sent */
            0x200=>'SETFOREGROUND',   # /* not in win3.1 */

            0x0004=>'3DLOOK',
            0x0008=>'FIXEDSYS',
            0x0010=>'NOFAILCREATE',
            0x0400=>'CONTROL',
            0x0800=>'CENTER',
            0x1000=>'CENTERMOUSE',
            0x2000=>'CONTEXTHELP',

#define DS_SHELLFONT        (DS_SETFONT | DS_FIXEDSYS)

            0x8000=>'USEPIXELS',

        },
        listbox=>{
            0x0001=>'NOTIFY',
            0x0002=>'SORT',
            0x0004=>'NOREDRAW',
            0x0008=>'MULTIPLESEL',
            0x0010=>'OWNERDRAWFIXED',
            0x0020=>'OWNERDRAWVARIABLE',
            0x0040=>'HASSTRINGS',
            0x0080=>'USETABSTOPS',
            0x0100=>'NOINTEGRALHEIGHT',
            0x0200=>'MULTICOLUMN',
            0x0400=>'WANTKEYBOARDINPUT',
            0x0800=>'EXTENDEDSEL',
            0x1000=>'DISABLENOSCROLL',
            0x2000=>'NODATA',

            0x4000=>'NOSEL',

            0x8000=>'COMBOBOX',

        },
        scrollbar=>{
            0x0000=>'HORZ',
            0x0001=>'VERT',
            0x0002=>'TOPALIGN',
            0x0002=>'LEFTALIGN',
            0x0004=>'BOTTOMALIGN',
            0x0004=>'RIGHTALIGN',
            0x0002=>'SIZEBOXTOPLEFTALIGN',
            0x0004=>'SIZEBOXBOTTOMRIGHTALIGN',
            0x0008=>'SIZEBOX',

            0x0010=>'SIZEGRIP',

        },
        edit=>{
            0x0000=>'LEFT',
            0x0001=>'CENTER',
            0x0002=>'RIGHT',
            0x0004=>'MULTILINE',
            0x0008=>'UPPERCASE',
            0x0010=>'LOWERCASE',
            0x0020=>'PASSWORD',
            0x0040=>'AUTOVSCROLL',
            0x0080=>'AUTOHSCROLL',
            0x0100=>'NOHIDESEL',
            0x0400=>'OEMCONVERT',
            0x0800=>'READONLY',
            0x1000=>'WANTRETURN',

            0x2000=>'NUMBER',

        },
        button=>{
            0x00000000=>'PUSHBUTTON',
            0x00000001=>'DEFPUSHBUTTON',
            0x00000002=>'CHECKBOX',
            0x00000003=>'AUTOCHECKBOX',
            0x00000004=>'RADIOBUTTON',
            0x00000005=>'3STATE',
            0x00000006=>'AUTO3STATE',
            0x00000007=>'GROUPBOX',
            0x00000008=>'USERBUTTON',
            0x00000009=>'AUTORADIOBUTTON',
            0x0000000A=>'PUSHBOX',
            0x0000000B=>'OWNERDRAW',
            0x0000000F=>'TYPEMASK',
            0x00000020=>'LEFTTEXT',

            0x00000000=>'TEXT',
            0x00000040=>'ICON',
            0x00000080=>'BITMAP',
            0x00000100=>'LEFT',
            0x00000200=>'RIGHT',
            0x00000300=>'CENTER',
            0x00000400=>'TOP',
            0x00000800=>'BOTTOM',
            0x00000C00=>'VCENTER',
            0x00001000=>'PUSHLIKE',
            0x00002000=>'MULTILINE',
            0x00004000=>'NOTIFY',
            0x00008000=>'FLAT',
#define BS_RIGHTBUTTON      BS_LEFTTEXT

        },
        class=>{
            0x0001=>'VREDRAW',
            0x0002=>'HREDRAW',
            0x0008=>'DBLCLKS',
            0x0020=>'OWNDC',
            0x0040=>'CLASSDC',
            0x0080=>'PARENTDC',
            0x0200=>'NOCLOSE',
            0x0800=>'SAVEBITS',
            0x1000=>'BYTEALIGNCLIENT',
            0x2000=>'BYTEALIGNWINDOW',
            0x4000=>'GLOBALCLASS',

            0x00010000=>'IME',

            0x00020000=>'DROPSHADOW',

        },
        static=>{

            0x00000040=>'REALSIZECONTROL',

            0x00000080=>'NOPREFIX',   # /* Don't do "&" character translation */

            0x00000100=>'NOTIFY',
            0x00000200=>'CENTERIMAGE',
            0x00000400=>'RIGHTJUST',
            0x00000800=>'REALSIZEIMAGE',
            0x00001000=>'SUNKEN',
            0x00002000=>'EDITCONTROL',
            0x00004000=>'ENDELLIPSIS',
            0x00008000=>'PATHELLIPSIS',
            0x0000C000=>'WORDELLIPSIS',
            0x0000C000=>'ELLIPSISMASK',

        },
        combo=>{
            0x0001=>'SIMPLE',
            0x0002=>'DROPDOWN',
            0x0003=>'DROPDOWNLIST',
            0x0010=>'OWNERDRAWFIXED',
            0x0020=>'OWNERDRAWVARIABLE',
            0x0040=>'AUTOHSCROLL',
            0x0080=>'OEMCONVERT',
            0x0100=>'SORT',
            0x0200=>'HASSTRINGS',
            0x0400=>'NOINTEGRALHEIGHT',
            0x0800=>'DISABLENOSCROLL',

            0x2000=>'UPPERCASE',
            0x4000=>'LOWERCASE',

        },
    );

    my @style;
    for my $s (keys %styles) {
        push @style, $styles{$s} if ($style & $s);
    }
    if ($type) {
        $type= $types{$type} if (exists $types{$type});
        push @style, "$type:";
        for my $s (keys %{$typestyles{$type}}) {
            push @style, $typestyles{$type}{$s} if ($style & $s);
        }
    }
    return join(",", @style);
}
sub getexstyle {
    my ($style)= @_;
    my %styles= (
        0x00000001 => 'DLGMODALFRAME',
        0x00000004 => 'NOPARENTNOTIFY',
        0x00000008 => 'TOPMOST',
        0x00000010 => 'ACCEPTFILES',
        0x00000020 => 'TRANSPARENT',

        0x00000040 => 'MDICHILD',
        0x00000080 => 'TOOLWINDOW',
        0x00000100 => 'WINDOWEDGE',
        0x00000200 => 'CLIENTEDGE',
        0x00000400 => 'CONTEXTHELP',

        0x00001000 => 'RIGHT',
        0x00000000 => 'LEFT',
        0x00002000 => 'RTLREADING',
        0x00000000 => 'LTRREADING',
        0x00004000 => 'LEFTSCROLLBAR',
        0x00000000 => 'RIGHTSCROLLBAR',

        0x00010000 => 'CONTROLPARENT',
        0x00020000 => 'STATICEDGE',
        0x00040000 => 'APPWINDOW',

        0x00080000 => 'LAYERED',
        0x00100000 => 'NOINHERITLAYOUT',
        0x00400000 => 'LAYOUTRTL',
        0x02000000 => 'COMPOSITED',
        0x08000000 => 'NOACTIVATE',
    );

    my @style;
    for my $s (keys %styles) {
        push @style, $styles{$s} if ($style & $s);
    }
    return join(",", @style);
}
sub dumpcontrol {
    my $ctl= shift;
    printf("   %5d: %-30s  (%d,%d) / (%d,%d) : %s  %s\n", $ctl->{id}, qescape($ctl->{text}, "'"), $ctl->{x}, $ctl->{y}, $ctl->{cx}, $ctl->{cy},
        getstyle($ctl->{lStyle}, $ctl->{class}),
        getexstyle($ctl->{lExtendedStyle}));
}
sub dumpdialog {
    my $dlg= shift;
    printf("dialog %-30s (%d,%d) / (%d,%d) : %s  %s\n", qescape($dlg->{caption},"'"), $dlg->{x}, $dlg->{y}, $dlg->{cx}, $dlg->{cy},
        getstyle($dlg->{lStyle}, "dialog"),
        getexstyle($dlg->{lExtendedStyle}));
    printf("  class: %s\n", $dlg->{class}) if $dlg->{class};
    printf("  menu: %s\n", $dlg->{menu}) if $dlg->{menu};
    for my $ctl (@{$dlg->{controls}}) {
        dumpcontrol($ctl);
    }
}
sub getdialog {
    my %dlg;
    if (substr($_[0], $_[1], 4) eq "\x01\x00\xff\xff")
    {
        $_[1]+=4;
        (
            $dlg{helpid},
            $dlg{lExtendedStyle},
            $dlg{lStyle},
            $dlg{NumberOfItems},
            $dlg{x},
            $dlg{y},
            $dlg{cx},
            $dlg{cy},
        )= unpack("VVVv5", substr($_[0], $_[1], 22));
        $_[1] += 22;
        $dlg{ex}=1;
    }
    else {
        # DLGTEMPLATE struct
        (
            $dlg{lStyle},
            $dlg{lExtendedStyle},
            $dlg{NumberOfItems},
            $dlg{x},
            $dlg{y},
            $dlg{cx},
            $dlg{cy},
        )= unpack("VVv5", substr($_[0], $_[1], 18));
        $_[1] += 18;
        $dlg{helpid}= 0;

    }


    $dlg{menu}= getNameOrOrdinal(@_);
    $dlg{class}= getNameOrOrdinal(@_);
    $dlg{caption}= getUnicodeZString(@_);
    if ($dlg{lStyle}&0x40) {
        $dlg{pointsize}= getUint16(@_);
        if ($dlg{ex}) {
            $dlg{weight}= getUint16(@_);
            $dlg{italic}= getUint16(@_);
        }
        $dlg{fontname}= getUnicodeZString(@_);
    }
    align($_[1], 4);
    for (my $i=0 ; $i<$dlg{NumberOfItems} ; $i++) {
        push @{$dlg{controls}}, getdialogcontrol($dlg{ex}, @_);
        align($_[1], 4);
    }
    printf("dlg: %s\n", join(", ", map { sprintf("%s=>%s", $_, $dlg{$_}) } keys %dlg));
    return \%dlg;
}
sub getdialogcontrol {
    my $ex= shift;
    my %ctl;
    if ($ex) {
        (
            $ctl{helpid},
            $ctl{lExtendedStyle},
            $ctl{lStyle},
            $ctl{x},
            $ctl{y},
            $ctl{cx},
            $ctl{cy},
            $ctl{id},
        )= unpack("VVVv4V", substr($_[0], $_[1], 24));
        $_[1] += 24;

    }
    else {
        # DLGITEMTEMPLATE struct
        (
            $ctl{lStyle},
            $ctl{lExtendedStyle},
            $ctl{x},
            $ctl{y},
            $ctl{cx},
            $ctl{cy},
            $ctl{id},
        )= unpack("VVv5", substr($_[0], $_[1], 18));
        $_[1] += 18;
        $ctl{helpid}=0;
    }
    $ctl{class}= getNameOrOrdinal(@_);
    $ctl{text}= getNameOrOrdinal(@_);
    if ($_[1]<length($_[0])) {
        $ctl{nextra}= getUint16(@_);
        printf("extra=%d\n", $ctl{nextra}) if $ctl{nextra};
        for (my $i=0 ; $i<$ctl{nextra} ; $i++)
        {
            push @{$ctl{extra}}, getUint16(@_);
        }
    }

    return \%ctl;
}

sub stringdecoder {
    my ($data, @path)= @_;
    my %strings;
    my $ofs= 0;
    my $id= 16*($path[1]-1);
    for my $i (0..15) {
        my $len= unpack("v", substr($data, $ofs, 2));
        $ofs+=2;
        next if $len==0;
        # todo: sometimes a list of strings is stored.
        $strings{$id+$i}= getUnicodeString($data, $ofs, $len);
        #unpack 'A*', pack('U*', unpack 'v*', substr($data, $ofs, $len*2));
#        $ofs+=$len*2;
        printf("string %6d :%04x  %s\n", $id+$i, $ofs-2-$len*2, qescape($strings{$id+$i}, "'"));
    }
    warn sprintf("WARNING: stringresource too large: %d : %s\n", length($data)-$ofs, unpack("H*",substr($data, $ofs))) if length($data)!=$ofs && unpack("H*",substr($data, $ofs)) !~/^\x00*$/;
    return \%strings;
}
sub fontdirdecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    printf("todo : %s\n", unpack("H1024", $data));
}
sub fontdecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    printf("todo : %s\n", unpack("H1024", $data));
}
sub acceleratordecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    for (my $i=0 ; $i<length($data)/8 ; $i++) {
        printf("%4d: %04x '%c' %5d\n", $i, unpack("vvv", substr($data, $i*8, 6)));
    }
}
sub rcdatadecoder {     # 10
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    printf("todo : %s\n", unpack("H1024", $data));

# 006f    -> menuid
# 0002
#
# fffe
# 9c4e  menuid-send
# 0004
# 0018
# 0069  str'Send'
# 0000
# 0000
#
# fffe
# 0068  menuid-cancel
# 0004
# 0010
# 006a  str'Cancel'
# 0000
# ffff

    # sometimes contains a menu
    # sometimes contains binary data
}
sub messagetabledecoder {       # 11
    my ($data, @path)= @_;
    my $nblocks= unpack("V", $data);
    my @blocks= map { {low=>$_->[0], high=>$_->[1], offset=>$_->[2]} } map { [ unpack("VVV", substr($data, 4+12*$_, 12)) ] } 0..$nblocks-1;

    printf("%5s: %s: %d blocks\n", $path[1], $resourcetypes{$path[0]}{name}, $nblocks);
    for (@blocks) {
        my $ofs= $_->{offset};
        printf("block  %d .. %d\n", $_->{low}, $_->{high});
        for (my $id =$_->{low} ; $id<=$_->{high} ; $id++) {
            my ($l, $f)= unpack("vv", substr($data, $ofs, 4));
            my $str= substr($data, $ofs+4, $l-4);
            if ($f) {
                $str= unpack 'Z*', pack 'U*', unpack 'v*', $str;
            }
            if ($id<-65535 || $id>65535) {
                printf("0x%08lx : '%s'\n", $id, $str);
            }
            else {
                printf("%5d : '%s'\n", $id, $str);
            }
            $ofs+=$l;
        }
    }
}
sub group_cursordecoder {       # 12
    my ($data, @path)= @_;
    my @hdr= unpack("v3", $data);
    printf("%5s: %s %d %d %d\n", $path[1], $resourcetypes{$path[0]}{name}, @hdr);
    my $ofs= 6;
    while ($ofs<length($data))
    {
        my @f= unpack("v4Vv", substr($data, $ofs, 14));
        $ofs += 14;
        printf("   %3d x %3d  %d  %d  %08lx  %04x\n", @f);
    }
}
sub group_icondecoder {         # 14
    my ($data, @path)= @_;

    my @hdr= unpack("v3", $data);
    printf("%5s: %s %d %d %d\n", $path[1], $resourcetypes{$path[0]}{name}, @hdr);
    my $ofs= 6;
    while ($ofs<length($data))
    {
        my @f= unpack("C4v2Vv", substr($data, $ofs, 14));
        $ofs += 14;
        printf("   %3d x %3d c=%d (%d) %d  %d  %08lx  %04x\n", @f);
    }
}
sub versiondecoder {    # 16
    my ($data, @path)= @_;
    my $rec= parseversionrec($data, 0, length($data), 0);
    dumpversionrec($rec, 0);
}
sub decodeversionbinary {
    my ($data)=@_;
    if (substr($data, 0, 4) eq "\xbd\x04\xef\xfe") {
        my @f= unpack("V*", $data);
        return sprintf("magic=%08lx, struct-v%d.%d  file-v%d.%d.%d.%d prod-v%d.%d.%d.%d flags=%08x:%s os=%s type=%s%s date=%08lx:%08lx\n",
            map { ($_>=1 && $_<=5)?($f[$_]>>16, $f[$_]&0xffff)
                :($_==7)?ver_flags($f[$_])
                :($_==8)?ver_os($f[$_])
                :($_==9)?ver_filetype($f[$_],$f[$_+1])
                :($_==10)?"": $f[$_] } 0..$#f);
    }
    else {
        return unpack 'H*', $data;
    }
}

sub ver_flags {
    return "-" if $_[0]==0;
    my @flags;
    push @flags, "DEBUG" if $_[0]&0x1;
    push @flags, "PRERELEASE" if $_[0]&0x2;
    push @flags, "PATCHED" if $_[0]&0x4;
    push @flags, "PRIVATEBUILD" if $_[0]&0x8;
    push @flags, "INFOINFERRED" if $_[0]&0x10;
    push @flags, "SPECIALBUILD" if $_[0]&0x20;

    if ($_[0]&~0x3f) {
        push @flags, sprintf("VS_FF_%x", $_[0]&~0x3f);
    }
    return join(",", @flags);
}

sub ver_os {
my %version_ostypes= (
    0x00000000 => 'UNKNOWN',
    0x00010000 => 'DOS',
    0x00020000 => 'OS216',
    0x00030000 => 'OS232',
    0x00040000 => 'NT',

    0x00000000 => '_BASE',
    0x00000001 => '_WINDOWS16',
    0x00000002 => '_PM16',
    0x00000003 => '_PM32',
    0x00000004 => '_WINDOWS32',

    0x00010001 => 'DOS_WINDOWS16',
    0x00010004 => 'DOS_WINDOWS32',
    0x00020002 => 'OS216_PM16',
    0x00030003 => 'OS232_PM32',
    0x00040004 => 'NT_WINDOWS32',
);
    return $version_ostypes{$_[0]} if (exists $version_ostypes{$_[0]});
    return sprintf("VOS_%08x", $_[0]);
}

sub ver_filetype {
    my ($ft, $subft)= @_;
my %versionfiletypes= (
    0x00000000 => { name=>'UNKNOWN' },
    0x00000001 => { name=>'APP' },
    0x00000002 => { name=>'DLL' },
    0x00000003 => { name=>'DRV',
        0x00000001 =>'PRINTER',
        0x00000002 =>'KEYBOARD',
        0x00000003 =>'LANGUAGE',
        0x00000004 =>'DISPLAY',
        0x00000005 =>'MOUSE',
        0x00000006 =>'NETWORK',
        0x00000007 =>'SYSTEM',
        0x00000008 =>'INSTALLABLE',
        0x00000009 =>'SOUND',
        0x0000000A =>'COMM',
        0x0000000B =>'INPUTMETHOD',
    },
    0x00000004 => { name=>'FONT',
        0x00000001 =>'RASTER',
        0x00000002 =>'VECTOR',
        0x00000003 =>'TRUETYPE',
    },
    0x00000005 => { name=>'VXD' },
    0x00000007 => { name=>'STATIC_LIB' },
);
    if (!exists $versionfiletypes{$ft}) {
        return sprintf("VFT_%x_%x", $ft, $subft);
    }
    if (!exists $versionfiletypes{$ft}{$subft}) {
        if ($subft) {
            return sprintf("VFT_%s_%x", $versionfiletypes{$ft}{name}, $subft);
        }
        else {
            return sprintf("VFT_%s", $versionfiletypes{$ft}{name});
        }
    }
    return return sprintf("VFT_%s_%s", $versionfiletypes{$ft}{name}, $versionfiletypes{$ft}{$subft});
}
sub dumpversionrec {
    my ($rec, $level)= @_;
    printf("%*s%s : %s\n", $level*2, "", $rec->{tag}, $rec->{valtype}?"\"".$rec->{value}."\"" : decodeversionbinary($rec->{value}));
    if ($rec->{children} && @{$rec->{children}}) {
        printf("%*s{\n", $level*2, "");
        dumpversionrec($_, $level+1) for @{$rec->{children}};
        printf("%*s}\n", $level*2, "");
    }
}
sub parseversionrec {
    my ($data, $beginofs, $endofs, $level)= @_;
    if ($beginofs>=$endofs) {
        return ;
    }

    my $ofs= $beginofs;
    #printf("%04x-%04x:%s%04x %04x %04x\n", $ofs, $endofs, "  " x $level, unpack("vvv", substr($data, $ofs, 6)));
    my %rec;
    (
        $rec{size},
        $rec{vallen},
        $rec{valtype},
    )= unpack("vvv", substr($data, $ofs, 6));
    $ofs += 6;
    $rec{tag}= getUnicodeZString($data, $ofs);
    if ($ofs&3) { $ofs += 4-($ofs&3); }
    #printf("%04x     =%s  valuedata\n", $ofs, "  " x $level) if ($rec{vallen});
    if ($rec{valtype}) {
        $rec{value}= unpack 'Z*', pack 'U*', unpack 'v*', substr($data, $ofs, $rec{vallen}*2);
        $ofs += $rec{vallen}*2;
    }
    else {
        $rec{value}= substr($data, $ofs, $rec{vallen});
        $ofs += $rec{vallen};
    }
    if ($ofs&3) { $ofs += 4-($ofs&3); }
    while ($ofs<($level==0 ? $endofs : $beginofs+$rec{size})) {
        push @{$rec{children}}, parseversionrec($data, $ofs, $beginofs+$rec{size}, $level+1);
        $ofs += $rec{children}[-1]{size};
        if ($ofs&3) { $ofs += 4-($ofs&3); }
    }
    return \%rec;
}

=cut
0248      WORD wLength;             /* Length of the version resource */ 
0034      WORD wValueLength;        /* Length of the value field for this block */ 
0000      WORD wType;               /* type of information:  1==string, 0==binary */ 
0056 0053 005f 0056 0045 0052 0053 0049 004f 004e 005f 0049 004e 0046 004f 0000 0000
{
    feef04bd   DWORD dwSignature;        /* signature - always 0xfeef04bd */ 
    00010000   DWORD dwStrucVersion;     /* structure version - currently 0 */ 
    00060000   DWORD dwFileVersionMS;    /* Most Significant file version dword */ 
    21ed0000   DWORD dwFileVersionLS;    /* Least Significant file version dword */ 
    00060000   DWORD dwProductVersionMS; /* Most Significant product version */ 
    00000000   DWORD dwProductVersionLS; /* Least Significant product version */ 
    00000000   DWORD dwFileFlagMask;     /* file flag mask */ 
    00000000   DWORD dwFileFlags;        /*  debug/retail/prerelease/... */ 
    00000000   DWORD dwFileOS;           /* OS type.  Will always be Windows32 value */ 
    00000000   DWORD dwFileType;         /* Type of file (dll/exe/drv/... )*/ 
    00000000   DWORD dwFileSubtype;      /* file subtype */ 
    00000000   DWORD dwFileDateMS;       /* Most Significant part of date */ 
    00000000   DWORD dwFileDateLS;       /* Least Significant part of date */ 
}
01a8 0000 0001 0053 0074 0072 0069 006e 0067 0046 0069 006c 0065 0049 006e 0066 006f 0000 
{
  0184 0000 0001 0030 0034 0030 0039 0030 0034 0045 0034 0000
  {
    004c 0016 0001 0043 006f 006d 0070 0061 006e 0079 004e 0061 006d 0065 0000 0000
                   004d 0069 0063 0072 006f 0073 006f 0066 0074 0020 0043 006f 0072 0070 006f 0072 0061 0074 0069 006f 006e 0000
    0076 0027 0001 0046 0069 006c 0065 0044 0065 0073 0063 0072 0069 0070 0074 0069 006f 006e 0000 0000
                   004d 0046 0043 0044 004c 004c 0020 0053 0068 0061 0072 0065 0064 0020 004c 0069 0062 0072 0061 0072 0079 0020 002d 0020 0052 0065 0074 0061 0069 006c 0020 0056 0065 0072 0073 0069 006f 006e 0000 0000
    0034 000a 0001 0046 0069 006c 0065 0056 0065 0072 0073 0069 006f 006e 0000 0000
                   0036 002e 0030 0030 002e 0038 0036 0038 0035 0000
    0074 0028 0001 004c 0065 0067 0061 006c 0043 006f 0070 0079 0072 0069 0067 0068 0074 0000
                   0043 006f 0070 0079 0072 0069 0067 0068 0074 0020 0028 0043 0029 0020 004d 0069 0063 0072 006f 0073 006f 0066 0074 0020 0043 006f 0072 0070 002e 0020 0031 0039 0039 0033 002d 0031 0039 0039 0039 0000
  }
}
0044 0000 0001 0056 0061 0072 0046 0069 006c 0065 0049 006e 0066 006f 0000 0000
{
  0024 0004 0000 0054 0072 0061 006e 0073 006c 0061 0074 0069 006f 006e 0000 0000
                 0409 04e4
}

=cut

sub dlgincludedecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path));
    printf("todo : %s\n", unpack("H1024", $data));
}
sub muidecoder {
    my ($data, @path)= @_;
    my $str= pack 'U*', unpack 'v*', $data;
    printf("%5s: %s: %s : '%s'\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path), $str);
}
sub unicodedecoder {
    my ($data, @path)= @_;
    my $str= pack 'U*', unpack 'v*', $data;
    printf("%5s: %s: %s : '%s'\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path), $str);
}
sub asciidecoder {
    my ($data, @path)= @_;
    printf("%5s: %s: %s : '%s'\n", $path[1], $resourcetypes{$path[0]}{name}, join("/", @path), $data);
}

sub getexeresptr {
    # check MZ magic
    return unless substr($_[0],0,2) eq "MZ";
    my $peofs= unpack("V", substr($_[0], 0x3c,4));
    return if $peofs > length($_[0])-0x40;

    # check PE magic
    return unless substr($_[0],$peofs,4) eq "PE\x00\x00";

    # check coff magic
    return unless substr($_[0],$peofs+0x18,2) eq "\x0b\x01";

    my $opthdrsize= unpack("v", substr($_[0], $peofs+0x14, 2));

    # get RES info item
    my ($resrva, $ressize)=unpack("VV", substr($_[0], $peofs+0x88, 8));

    # search section
    my $objcnt= unpack("v", substr($_[0], $peofs+0x6, 2));
    my $o32ofs= $opthdrsize+$peofs+0x18;
    for (my $i=0 ; $i<$objcnt ; $i++)
    {
        my ($rva, $size, $ptr)= unpack("VVV", substr($_[0], $o32ofs+0x28*$i+0xC, 0xC));
        if ($rva<=$resrva && $resrva+$ressize<=$rva+$size) {
            return ($ptr, $size, $resrva);
        }
    }
    return undef;
}
sub makeunique {
    my ($basefn)=@_;
    return $basefn if !-e $basefn;
    my ($base, $ext);
    if ($basefn =~ /^(.*?)(?:\.(\w+))?$/) {
        ($base, $ext)=($1,$2);
    }
    for (my $i=1 ; 1 ; $i++)
    {
        my $fn=sprintf("%s-%d.%s", $base, $i, $ext);
        return $fn if !-e $fn;
    }
}

sub datasaver {
    my ($savedir, $fnpart, $data, @path)= @_;
    my $fn= makeunique($savedir ."/". $fnpart . $path[1] .($path[0] eq '23' ? "" : ".". $resourcetypes{$path[0]}{ext}));
    my $fh= IO::File->new($fn, "w") or die "$fn: $!\n";
    binmode $fh;
    $fh->print($data);
    $fh->close();
} 

sub cursorsaver {
    my ($savedir, $fn, $data, @path)= @_;
    my @fields= unpack("VVVvvVVVVVV",$data);

#  0 biSize
#  1 biWidth 
#  2 biHeight 
#  3 biPlanes 
#  4 biBitCount 
#  5 biCompression 
#  6 biSizeImage 
#  7 biXPelsPerMeter 
#  8 biYPelsPerMeter 
#  9 biClrUsed 
# 10 biClrImportant 
    my $ofn= makeunique($savedir ."/". $fn . $path[1] .($path[0] eq '23' ? "" : ".". $resourcetypes{$path[0]}{ext}));
    my $oh= IO::File->new($ofn, "w") or die "$ofn: $!\n";
    binmode $oh;
    $oh->print(pack("vvv", 
            0,    # ICONDIR.idReserved            // Reserved (must be 0)
            2,    # ICONDIR.idType                // Resource Type (2 for cursors)
            1));  # ICONDIR.idCount               // How many images?
    $oh->print(pack("CCCCvvVV",
            $fields[1],     # ICONDIRENTRY.bWidth;          // Width, in pixels, of the image
            $fields[2]/2,     # ICONDIRENTRY.bHeight;         // Height, in pixels, of the image
            0,              # ICONDIRENTRY.bColorCount;     // Number of colors in image (0 if >=8bpp)
            0,              # ICONDIRENTRY.bReserved;       // Reserved ( must be 0)
            $fields[3],     # ICONDIRENTRY.wPlanes;         // Color Planes
            $fields[4],     # ICONDIRENTRY.wBitCount;       // Bits per pixel
            length($data)-4,  # ICONDIRENTRY.dwBytesInRes;    // How many bytes in this resource?
            0x16));         # ICONDIRENTRY.dwImageOffset;  

    $oh->print(substr($data,4));
    $oh->close();

}
sub bitmapsaver {
    my ($savedir, $fn, $data, @path)= @_;
    my @fields= unpack("VVVvvVVVVVV",$data);
#  0 biSize      - header size
#  1 biWidth 
#  2 biHeight 
#  3 biPlanes 
#  4 biBitCount 
#  5 biCompression 
#  6 biSizeImage 
#  7 biXPelsPerMeter 
#  8 biYPelsPerMeter 
#  9 biClrUsed 
# 10 biClrImportant 
    my $ofn= makeunique($savedir ."/". $fn  . $path[1] .($path[0] eq '23' ? "" : ".". $resourcetypes{$path[0]}{ext}));
    my $oh= IO::File->new($ofn, "w") or die "$ofn: $!\n";
    binmode $oh;
    $oh->print(pack("A2VVV", 
        "BM", 
        16+length($data),     # filesize
        0,
        14 + $fields[0]));      # offset to bmp data
    $oh->print($data);
    $oh->print(pack("v", 0));
    $oh->close();
 
}

sub iconsaver {
    my ($savedir, $fn, $data, @path)= @_;
    if (substr($data, 0, 4) eq "\x89PNG") {
        datasaver($savedir, $data, @path);
        return;
    }
    my @fields= unpack("VVVvvVVVVVV",$data);

#  0 biSize
#  1 biWidth 
#  2 biHeight 
#  3 biPlanes 
#  4 biBitCount 
#  5 biCompression 
#  6 biSizeImage 
#  7 biXPelsPerMeter 
#  8 biYPelsPerMeter 
#  9 biClrUsed 
# 10 biClrImportant 
    my $ofn= makeunique($savedir ."/". $fn . $path[1] .($path[0] eq '23' ? "" : ".". $resourcetypes{$path[0]}{ext}));
    my $oh= IO::File->new($ofn, "w") or die "$ofn: $!\n";
    binmode $oh;
    $oh->print(pack("vvv", 
            0,    # ICONDIR.idReserved            // Reserved (must be 0)
            1,    # ICONDIR.idType                // Resource Type (1 for icons)
            1));  # ICONDIR.idCount               // How many images?
    $oh->print(pack("CCCCvvVV",
            $fields[1],     # ICONDIRENTRY.bWidth;          // Width, in pixels, of the image
            $fields[2]/2,     # ICONDIRENTRY.bHeight;         // Height, in pixels, of the image
            0,              # ICONDIRENTRY.bColorCount;     // Number of colors in image (0 if >=8bpp)
            0,              # ICONDIRENTRY.bReserved;       // Reserved ( must be 0)
            $fields[3],     # ICONDIRENTRY.wPlanes;         // Color Planes
            $fields[4],     # ICONDIRENTRY.wBitCount;       // Bits per pixel
            length($data),  # ICONDIRENTRY.dwBytesInRes;    // How many bytes in this resource?
            0x16));         # ICONDIRENTRY.dwImageOffset;  

    $oh->print($data);
    $oh->close();

}

# quote string
sub qescape {
    my ($str, $q)= @_;
    my %escapes= (
        "\a"=>'a',  # 07 BEL
        "\f"=>'f',  # 0c FF
        "\n"=>'n',  # 0a LF
        "\r"=>'r',  # 0d CR
        "\t"=>'t',  # 09 TAB
        "\b"=>'b',  # 08 BS
        "\e"=>'e',  # 1b ESC
        "\0"=>'0',
        "\\"=>'\\',
        $q => $q,
    );
    $str =~ s/./exists $escapes{$&}?"\\$escapes{$&}": ord($&)<32 ? sprintf("\\x%02x", ord($&)) : $&/esg;
    return $q.$str.$q;
}