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;