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