This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
adjust change#6299
[perl5.git] / win32 / bin / exetype.pl
CommitLineData
1065c7ba
GS
1#!perl -w
2use strict;
c4bbdec3
GS
3
4# All the IMAGE_* structures are defined in the WINNT.H file
5# of the Microsoft Platform SDK.
6
7my %subsys = (NATIVE => 1,
8 WINDOWS => 2,
9 CONSOLE => 3,
10 POSIX => 7,
11 WINDOWSCE => 9);
12
13unless (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];
19unless (@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
25my ($record,$magic,$signature,$offset,$size);
26open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
1065c7ba 27binmode EXE;
c4bbdec3
GS
28
29# read IMAGE_DOS_HEADER structure
30read EXE, $record, 64;
1065c7ba 31($magic,$offset) = unpack "Sx58L", $record;
c4bbdec3
GS
32
33die "$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 37seek EXE, $offset, 0;
c4bbdec3
GS
38read EXE, $record, 4+20+2;
39($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
40
41die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
42
43die "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
48seek EXE, $offset+4+20+68, 0;
49if (@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}
55else {
56 print EXE pack "S", $subsys{$ARGV[1]};
57}
1065c7ba
GS
58close EXE;
59__END__
60
61=head1 NAME
62
63exetype - 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
72This program edits an executable file to indicate which subsystem the
73operating system must invoke for execution.
74
75You can specify any of the following subsystems:
76
77=over
78
79=item CONSOLE
80
81The CONSOLE subsystem handles a Win32 character-mode application that
82use a console supplied by the operating system.
83
84=item WINDOWS
85
86The WINDOWS subsystem handles an application that does not require a
87console and creates its own windows, if required.
88
c4bbdec3
GS
89=item NATIVE
90
91The NATIVE subsystem handles a Windows NT device driver.
92
93=item WINDOWSCE
94
95The WINDOWSCE subsystem handles Windows CE consumer electronics
96applications.
97
98=item POSIX
99
100The POSIX subsystem handles a POSIX application in Windows NT.
101
1065c7ba
GS
102=back
103
104=head1 AUTHOR
105
106Jan Dubois <jand@activestate.com>
107
108=cut