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