win32/bin/exetype.pl

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