view release on metacpan or  search on metacpan

script/pl2exe.pl  view on Meta::CPAN

#!/usr/bin/perl
open IN, (my $name = shift) or die "Syntax: pl2exe file.pl\n";

$name =~ s/\.pl$//;
$name .= '.exe';
open (OUT, ">$name") or die "can\'t write to $name: $!\n";
binmode OUT;  # because we want to be in control

print OUT "MZ(<<'EXE_STUFF') # -*-Perl-*-\015\012";
print OUT "Here comes offset 60 .....\015\012";

# The DWORD at offset 60 holds the offset of the IMAGE_NT_HEADERS struct.
# This stuff is in winnt.h.
print OUT pack ("L", 64);

my $code_size = 512;	# actually the size of the entire
			# code section, which in this case contains
			# data as well; rounded up to a multiple of 512

# Construct the IMAGE_NT_HEADERS structure.
my $headers = "PE\0\0";		# Portable Executable signature
$headers .= pack ('SSLLLSS',	# the IMAGE_FILE_HEADER substructure
		  0x14c,	# for Intel I386
		  1,		# number of sections
		  874806772,	# time-date stamp (whatever)
		  0,0,		# uniteresting fields
		  224,		# size of the IMAGE_OPTIONAL_HEADER
		  0x010f	# random flags: 0xa18e(?) for a DLL
		  );
$headers .= pack ('SCCL9S6L4SSL6',	# IMAGE_OPTIONAL_HEADERS substruct
		  0x010b,	# 0x0107 would be a ROM image
		  1,0,		# linker version maj.min (I guess that's us)
		  $code_size,
		  0,0,		# size of initialized/un- data
		  0x1000,	# RVA of entry point
		  		# (the RVA is the address when loaded,
		  		# relative to the image base)
		  0x1000,	# RVA of start of code section
		  0,		# RVA of data section, if there were one
		  0x400000,	# image base
		  0x1000,	# section alignment
		  512,		# file alignment
		  4, 0,		# OS version maj.min
		  0, 0,		# user-defined fields (whatever)
		  4, 0,		# subsystem version (???)
		  0,		# reserved zero
		  0x2000,	# size of image
		  512,		# size of headers
		  0,		# checksum; ignored
		  3,		# 3=console app; 2=GUI app
		  0,		# obsolete field
		  0x1000,	# size of stack reserve
		  0x1000,	# size of stack commit
		  0x100000,	# size of heap reserve
		  0,		# size of heap commit
		  0,		# another obsolete field
		  16		# the number or RVA/size pairs to follow
		  );
$headers .= pack ('L32',	# 16 (RVA,size) pairs locating certain
		  		# important image structures; the ones
		  		# we don't have are left zero
		  0,0,
		  0x1100, 195,	# import directory
		  0,0,0,0,0,0,
		  0x10f8, 8,	# relocation table (empty, but needed)
		  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
		  );
print OUT $headers;

# We need to describe our one section.
my $section_header = pack ('a8L8',
			   '.perl',	# section name
			   464,		# raw data size
			   0x1000,	# section begin RVA
			   512,		# rounded-up data size
			   512,		# offset in file
			   0,0,0,	# whatever
			   0xe0000060,	# flags
			   );
print OUT $section_header;

print OUT "\015\012\015\012";
print OUT "-------------that was the IMAGE_NT_HEADERS struct-------------";
print OUT "\015\012------------------------\015\012";
print OUT "--------Now comes the code (at offset 512, if you please)-----";
print OUT "\015\012\015\012";

# Next comes the code.
# It performs fixups, prepends "perl -x " to the command line,
# launches perl, and returns perl's exit status.

print OUT pack ("H*", "b8cc114000833dcc1140000074168b1085d27d06");