home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _4cf61c9e62134b760ca3e1b56e6105ed < prev    next >
Encoding:
Text File  |  2000-03-24  |  3.2 KB  |  125 lines
  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 <jand@activestate.com>
  120.  
  121. =cut
  122.  
  123. __END__
  124. :endofperl
  125.