Commit | Line | Data |
1065c7ba |
1 | #!perl -w |
2 | use strict; |
c4bbdec3 |
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; |
1065c7ba |
15 | exit; |
16 | } |
c4bbdec3 |
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"; |
1065c7ba |
22 | exit; |
23 | } |
c4bbdec3 |
24 | |
25 | my ($record,$magic,$signature,$offset,$size); |
26 | open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n"; |
1065c7ba |
27 | binmode EXE; |
c4bbdec3 |
28 | |
29 | # read IMAGE_DOS_HEADER structure |
30 | read EXE, $record, 64; |
1065c7ba |
31 | ($magic,$offset) = unpack "Sx58L", $record; |
c4bbdec3 |
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 |
1065c7ba |
37 | seek EXE, $offset, 0; |
c4bbdec3 |
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 | } |
1065c7ba |
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 | |
c4bbdec3 |
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 | |
1065c7ba |
102 | =back |
103 | |
104 | =head1 AUTHOR |
105 | |
106 | Jan Dubois <jand@activestate.com> |
107 | |
108 | =cut |