home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / win32 / bin / exetype.pl next >
Perl Script  |  2000-02-14  |  3KB  |  109 lines
  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
  109.