1#!/usr/bin/perl -w 2# wince_rename 3# - when run in a directory containing files extracted from 4# a Windows CE installation cabinet, it will rename all files 5# to their "installed" filenames, including path 6# - the header file (*.000) will be renamed to header.bin 7# - the setup DLL (*.999) will be renamed to setup.dll 8# - a REGEDIT4 style file will be made, called setup.reg 9use strict; 10use File::Basename qw(dirname); 11use File::Copy qw(move); 12use File::Path qw(make_path); 13use File::Spec; 14use File::Spec::Win32; 15 16my @ce = ( 17 undef, 18 '\Program Files', 19 '\Windows', 20 '\Windows\Desktop', 21 '\Windows\StartUp', 22 '\My Documents', 23 '\Program Files\Accessories', 24 '\Program Files\Communications', 25 '\Program Files\Games', 26 '\Program Files\Pocket Outlook', 27 '\Program Files\Office', 28 '\Windows\Programs', 29 '\Windows\Programs\Accessories', 30 '\Windows\Programs\Communications', 31 '\Windows\Programs\Games', 32 '\Windows\Fonts', 33 '\Windows\Recent', 34 '\Windows\Favorites' 35); 36 37# expands a decimal number from 0-999 into a filename with a three digit 38# decimal number as a file extension, if one exists. Otherwise, undef is 39# is returned. 40sub get_fname { 41 my $pattern = sprintf '*.%03d', $_[0]; 42 my @files = glob $pattern; 43 if (@files > 1) { 44 warn "WARNING: more than one '$pattern' file, using '$files[0]'\n"; 45 } 46 return shift @files; 47} 48 49sub rename_file { 50 my ($src, $dest) = @_; 51 print "moving \"$src\" to \"$dest\"\n"; 52 make_path(dirname($dest)); 53 move($src, $dest) || warn "$src: $!\n"; 54} 55 56sub win32_path_to_local { 57 my ($volume, $dir, $file) = File::Spec::Win32->splitpath($_[0]) ; 58 my @dirs = File::Spec::Win32->splitdir($dir); 59 shift @dirs if @dirs > 0 && $dirs[0] eq ''; # remove leading slash 60 return File::Spec->catfile(@dirs, $file); 61} 62 63sub seek_to { 64 seek FH, $_[0], 0; 65} 66 67sub read_data { 68 my $buf; 69 read FH, $buf, $_[0]; 70 return $buf; 71} 72 73sub read_string { 74 my $str = read_data($_[0]); 75 $str =~ s/\000*$//; 76 return $str; 77} 78 79# get the *.000 file 80my $hdrfile = get_fname(0); 81if (not defined $hdrfile) { 82 print "no header (*.000) file found\n"; 83 exit; 84} 85 86# open the header file 87if (open FH, "<$hdrfile") { 88 # read the fixed header 89 # $hdr[0] = "MSCE" signature 90 # $hdr[2] = overall length of the header file 91 # $hdr[5] = target architecture ID 92 # @hdr[6..11] = minimal and maximal versions WinCE versions supported 93 # @hdr[12..17] = number of entries in {STRINGS,DIRS,FILES,HIVES,KEYS,LINKS} 94 # @hdr[18..23] = file offset of {STRINGS,DIRS,FILES,HIVES,KEYS,LINKS} 95 # @hdr[24..25] = {file offset, length} of APPNAME 96 # @hdr[26..27] = {file offset, length} of PROVIDER 97 # @hdr[28..29] = {file offset, length} of UNSUPPORTED 98 # other entries are unknown/undefined 99 my @hdr = unpack 'V12v6V6v8', read_data(100); 100 101 # does the file begin with "MSCE"? 102 if ($hdr[0] == 0x4543534D) { 103 # print appname and provider 104 seek_to($hdr[24]); printf "Appname: %s\n", read_string($hdr[25]); 105 seek_to($hdr[26]); printf "Provider: %s\n", read_string($hdr[27]); 106 107 # STRINGS section 108 my @strs; 109 seek_to($hdr[18]); 110 for (1 .. $hdr[12]) { 111 my ($id, $len) = unpack 'vv', read_data(4); 112 $strs[$id] = read_string($len); 113 } 114 115 # DIRS section 116 my @dirs; 117 seek_to($hdr[19]); 118 for (1 .. $hdr[13]) { 119 my ($id, $len) = unpack 'vv', read_data(4); 120 my @ids = unpack 'v*', read_data($len); pop @ids; 121 $dirs[$id] = join '\\', map {$strs[$_]} @ids; 122 $dirs[$id] =~ s/%CE(\d+)%/$ce[$1]/eg; 123 } 124 125 # FILES section 126 seek_to($hdr[20]); 127 for (1 .. $hdr[14]) { 128 # read a FILES entry 129 my ($id, $dirid, $unk, $flags, $len) = unpack 'vvvVv', read_data(12); 130 my $fname = read_string($len); 131 132 # get file with decimal extension, rename it to dir and 133 # filename given in FILES entry 134 rename_file(get_fname($id), win32_path_to_local("$dirs[$dirid]\\$fname")); 135 } 136 137 # CREATE REGISTRY KEYS LIST 138 139 # create "setup.reg" file in REGEDIT4 format, if any KEYS entries 140 if (($hdr[16] > 0) && open REGFH, '>setup.reg') { 141 print REGFH "REGEDIT4\r\n"; 142 143 my @hives; 144 my $lasthive = -1; 145 146 # seek to HIVES section and read all HIVES entries into @hives 147 seek_to($hdr[21]); 148 for (1 .. $hdr[15]) { 149 my ($id, $root, $unk, $len) = unpack 'vvvv', read_data(8); 150 my @ids = unpack 'v*', read_data($len); pop @ids; 151 $hives[$id] = join '\\',(('HKCR','HKCU','HKLM','HKEY_USERS')[$root-1], 152 (map{$strs[$_]} @ids)); 153 } 154 155 # seek to KEYS section and loop for all KEYS entries 156 seek_to($hdr[22]); 157 for (1 .. $hdr[16]) { 158 # read KEYS entry, split off name and data components 159 my ($id,$hive,$unk,$flags,$len) = unpack 'vvvVv', read_data(12); 160 my $entry = read_data($len); $entry =~ /^(.*?)\000(.*)/s; 161 my ($name, $data) = ($1, $2); 162 163 # print REGEDIT4 entry header for key, print hive header if a 164 # different hive has been entered 165 print REGFH "\r\n[$hives[$hive]]\r\n" unless $lasthive == $hive; 166 print REGFH ''.(($name eq '') ? '@' : "\"$name\"").'='; 167 $lasthive = $hive; 168 169 # print appropriate REGEDIT4 format for data 170 if (($flags & 0x10001) == 0x10001) { 171 print REGFH sprintf 'dword:%08x', unpack('V', $data); 172 } 173 elsif (($flags & 0x10001) == 0x00001) { 174 print REGFH 'hex:'.join ',',map{sprintf'%02x',$_}unpack 'c*',$data; 175 } 176 else { 177 chop $data; chop $data if (($flags & 0x10001) == 0x10000); 178 $data =~ s/\\/\\\\/g; $data =~ s/\000/\\0/g; $data =~ s/\"/\\\"/g; 179 print REGFH '"'.$data.'"'; 180 } 181 print REGFH "\r\n"; 182 } 183 close REGFH; 184 } 185 } 186 else { 187 print "$hdrfile: not a Windows CE install cabinet header\n"; 188 } 189 close FH; 190 191 # rename *.000 file to header.bin 192 rename_file($hdrfile, 'header.bin'); 193 194 # rename *.999 file to setup.dll, if it exists 195 rename_file(get_fname(999), 'setup.dll') if get_fname(999); 196} 197else { 198 print "$hdrfile: $!\n"; 199} 200