Commit | Line | Data |
---|---|---|
1065c7ba GS |
1 | #!perl -w |
2 | use strict; | |
c4bbdec3 GS |
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 GS |
15 | exit; |
16 | } | |
c4bbdec3 GS |
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 GS |
22 | exit; |
23 | } | |
c4bbdec3 GS |
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 GS |
28 | |
29 | # read IMAGE_DOS_HEADER structure | |
30 | read EXE, $record, 64; | |
1065c7ba | 31 | ($magic,$offset) = unpack "Sx58L", $record; |
c4bbdec3 GS |
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 GS |
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 GS |
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 GS |
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 GS |
102 | =back |
103 | ||
104 | =head1 AUTHOR | |
105 | ||
106 | Jan Dubois <jand@activestate.com> | |
107 | ||
108 | =cut |