PageRenderTime 183ms CodeModel.GetById 100ms app.highlight 12ms RepoModel.GetById 69ms app.codeStats 0ms

/win32/bin/exetype.pl

http://github.com/mirrors/perl
Perl | 108 lines | 69 code | 33 blank | 6 comment | 19 complexity | d5c524981783d2848a38718284b5d920 MD5 | raw file
  1#!perl -w
  2use strict;
  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;
 15    exit;
 16}
 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";
 22    exit;
 23}
 24
 25my ($record,$magic,$signature,$offset,$size);
 26open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
 27binmode EXE;
 28
 29# read IMAGE_DOS_HEADER structure
 30read EXE, $record, 64;
 31($magic,$offset) = unpack "Sx58L", $record;
 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
 37seek EXE, $offset, 0;
 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}
 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
 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
102=back
103
104=head1 AUTHOR
105
106Jan Dubois <jand@activestate.com>
107
108=cut