Merge the refactoring of Perl_do_openn() to blead.
[perl.git] / win32 / bin / exetype.pl
1 #!perl -w
2 use strict;
3
4 # All the IMAGE_* structures are defined in the WINNT.H file
5 # of the Microsoft Platform SDK.
6
7 my %subsys = (NATIVE    => 1,
8               WINDOWS   => 2,
9               CONSOLE   => 3,
10               POSIX     => 7,
11               WINDOWSCE => 9);
12
13 unless (0 < @ARGV && @ARGV < 3) {
14     printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys;
15     exit;
16 }
17
18 $ARGV[1] = uc $ARGV[1] if $ARGV[1];
19 unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) {
20     (my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/;
21     print "Invalid subsystem $ARGV[1], please use $subsys\n";
22     exit;
23 }
24
25 my ($record,$magic,$signature,$offset,$size);
26 open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
27 binmode EXE;
28
29 # read IMAGE_DOS_HEADER structure
30 read EXE, $record, 64;
31 ($magic,$offset) = unpack "Sx58L", $record;
32
33 die "$ARGV[0] is not an MSDOS executable file.\n"
34     unless $magic == 0x5a4d; # "MZ"
35
36 # read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
37 seek EXE, $offset, 0;
38 read EXE, $record, 4+20+2;
39 ($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
40
41 die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
42
43 die "Optional header is neither in NT32 nor in NT64 format"
44     unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
45            ($size == 240 && $magic == 0x20b);   # IMAGE_NT_OPTIONAL_HDR64_MAGIC
46
47 # Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
48 seek EXE, $offset+4+20+68, 0;
49 if (@ARGV == 1) {
50     read EXE, $record, 2;
51     my ($subsys) = unpack "S", $record;
52     $subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)";
53     print "$ARGV[0] uses the $subsys subsystem.\n";
54 }
55 else {
56     print EXE pack "S", $subsys{$ARGV[1]};
57 }
58 close EXE;
59 __END__
60
61 =head1 NAME
62
63 exetype - Change executable subsystem type between "Console" and "Windows"
64
65 =head1 SYNOPSIS
66
67         C:\perl\bin> copy perl.exe guiperl.exe
68         C:\perl\bin> exetype guiperl.exe windows
69
70 =head1 DESCRIPTION
71
72 This program edits an executable file to indicate which subsystem the
73 operating system must invoke for execution.
74
75 You can specify any of the following subsystems:
76
77 =over
78
79 =item CONSOLE
80
81 The CONSOLE subsystem handles a Win32 character-mode application that
82 use a console supplied by the operating system.
83
84 =item WINDOWS
85
86 The WINDOWS subsystem handles an application that does not require a
87 console and creates its own windows, if required.
88
89 =item NATIVE
90
91 The NATIVE subsystem handles a Windows NT device driver.
92
93 =item WINDOWSCE
94
95 The WINDOWSCE subsystem handles Windows CE consumer electronics
96 applications.
97
98 =item POSIX
99
100 The POSIX subsystem handles a POSIX application in Windows NT.
101
102 =back
103
104 =head1 AUTHOR
105
106 Jan Dubois <jand@activestate.com>
107
108 =cut