citrun

watch C/C++ source code execute
Log | Files | Refs | LICENSE

mem_win32.pm (1705B)


      1 package t::mem;
      2 
      3 use Modern::Perl;
      4 use POSIX;		# NULL
      5 use Win32::API;
      6 use autodie;
      7 
      8 our $os_allocsize = 64 * 1024;
      9 
     10 use constant GENERIC_READ => 0x80000000;
     11 use constant OPEN_EXISTING => 3;
     12 use constant INVALID_HANDLE_VALUE => -1;
     13 use constant PAGE_READONLY => 0x02;
     14 use constant FILE_MAP_READ => 0x0004;
     15 
     16 sub get_mem {
     17 	my ($self, $procfile) = @_;
     18 
     19 	# Roll our own Perl entry points into windows functions... wtf..
     20 	my $CreateFile = Win32::API::More->new(
     21 		'kernel32', 'HANDLE WINAPI CreateFile(
     22 				LPCTSTR path,
     23 				DWORD a,
     24 				DWORD b,
     25 				LPSECURITY_ATTRIBUTES c,
     26 				DWORD d,
     27 				DWORD e,
     28 				HANDLE f)'
     29 	);
     30 	my $GetFileSize = Win32::API::More->new(
     31 		'kernel32', 'HANDLE WINAPI GetFileSize(
     32 				HANDLE hFile,
     33 				LPWORD lpFileSizeHigh)'
     34 	);
     35 	my $CreateFileMapping = Win32::API::More->new(
     36 		'kernel32', 'HANDLE WINAPI CreateFileMapping(
     37 				HANDLE h,
     38 				LPSECURITY_ATTRIBUTES lpAttr,
     39 				DWORD prot,
     40 				DWORD max_hi,
     41 				DWORD max_lo,
     42 				LPCTSTR lp)'
     43 	);
     44 	my $MapViewOfFile = Win32::API::More->new(
     45 		'kernel32', 'UINT_PTR WINAPI MapViewOfFile(
     46 				HANDLE h,
     47 				DWORD acc,
     48 				DWORD off_hi,
     49 				DWORD off_lo,
     50 				SIZE_T len)'
     51 	);
     52 
     53 	my $handle = $CreateFile->Call($procfile, GENERIC_READ, 0, NULL, OPEN_EXISTING, 0, NULL);
     54 	die "CreateFile" if ($handle == INVALID_HANDLE_VALUE);
     55 
     56 	my $size = $GetFileSize->Call($handle, NULL);
     57 	#die "GetFileSize" if ($size == INVALID_FILE_SIZE);
     58 
     59 	my $fm = $CreateFileMapping->Call($handle, NULL, PAGE_READONLY, 0, 0, NULL);
     60 	die "CreateFileMapping" if ($fm == NULL);
     61 
     62 	my $mem = $MapViewOfFile->Call($fm, FILE_MAP_READ, 0, 0, $size);
     63 	die "MapViewOfFile" unless (defined $mem);
     64 
     65 	$self->{mem} = unpack "P$size", pack 'Q', $mem;
     66 	$self->{size} = $size;
     67 }
     68 
     69 1;