#!perl -w

# A modified version of Max Maischein's (aka Corion) script found at 
# http://www.perlmonks.org/index.pl?node_id=15871 on Perl Monks.
# This one works for 16-bit and 32-bit fileversions, both .exe and .dll.

die "Specify a .exe/.dll-file to get information on.\n" unless @ARGV == 1;

my $filename = shift;
get_version($filename);

sub MakeUnicode { 
  my ($S) = @_; 
  $S =~ s/(.)/$1\x00/g; 
  return $S; 
}; 

sub MakeASCII { 
  my ($S) = @_; 
  $S =~ s/(.)\x00/$1/g; 
  return $S; 
}; 


sub dumpfile { 
  my $filename = shift;
  	my $exedata;
	my %Result;
	
	# Regex definitions
		# For files that are 32-bit
  	my $StringFileInfoU =
		"..\x00\x00[\x00\x01]\x00" . MakeUnicode("StringFileInfo") . "(?:\x00\x00)+" . # StringFileInfo header
     	"((..)\x00\x00[\x00\x01]\x00(?:[0-9A-Fa-f]\x00){8}(?:\x00\x00)+)" . # StringTable header
		"(.*)"; # Strings

		# For files that are 16-bit
  	my $StringFileInfoA =
		"..\x00\x00" . "StringFileInfo" . "(?:\x00)+" . # StringFileInfo header
     	"((..)\x00\x00(?:[0-9A-Fa-f]){8}(?:\x00)+)" . # StringTable header
		"(.*)"; # Strings

	open EXE, "<$filename" or die "Cannot open $filename\n";
  	binmode EXE;
  	local $/;
  	undef $/;
  	$exedata = <EXE>;                        # sluuuuurp
  	close EXE;

	# 32bit Windows Unicode format
	if ($exedata =~ /$StringFileInfoU/gms) {
    	my ($STHeader, $Len, $Info) = ($1,$2,$3);
    	undef $exedata;
		#print "[32bit] ";
		$Result{"FileType"} = "32-bit UNICODE";

    	$Len = unpack( "v", $Len );
    	$Len -= length( $STHeader );
    	$Info = substr( $Info, 0, $Len );

    	while ($Info) {
      		my $Sublen;
      		my ($Next, $Value, $Type) = unpack("vvv", substr( $Info, 0, 6 ));
      		$Sublen = $Next - 6;
      		while ($Next % 4) { $Next++ };
      			last unless $Next;
      			my $Item = substr($Info, 6, $Sublen);
      			my (@Info) = ();
      			# Extract the key :
      			$Item =~ s/^((?:..)+?)(\x00\x00)+//sm;
      			my ($Key) = MakeASCII( $1 );
      				while ($Item =~ s/^((?:..)+?)(\x00\x00)+//sm) {
        				push @Info, MakeASCII( $1 );
      				}
      			$Result{$Key} = $Info[0];
      			shift @Info;
      			if ($Next < length( $Info )) { # != ?
        			$Info = substr( $Info, $Next );
      			} else {
        			$Info = "";
      			}
    	}
    	
	# 16bit Windows ASCII format
  	} elsif ($exedata =~ /$StringFileInfoA/gms) {
    	my ($STHeader, $Len, $Info) = ($1,$2,$3);
    	undef $exedata;
		#print "[16bit] ";
    	$Len = unpack( "v", $Len );
    	$Len -= length( $STHeader );
    	$Info = substr( $Info, 0, $Len );
    	while ($Info) {
      		my $Sublen;
      		my ($Next, $Value) = unpack("vv", substr( $Info, 0, 4 ));
      		$Sublen = $Next - 4;
      		while ($Next % 4) { $Next++ };
      		last unless $Next;
      		my $Item = substr($Info, 4, $Sublen);
      		my (@Info) = ();
      		# Extract the key :
      		$Item =~ s/^((?:.)+?)(\x00)+//sm;
      		my ($Key) = ( $1 );
      		while ($Item =~ s/^((?:.)+?)(\x00)+//sm) {
        		push @Info, $1;
      		}
      		$Result{$Key} = $Info[0];
      		shift @Info;
      		if ($Next < length( $Info )) {  # != ?
        		$Info = substr( $Info, $Next );
      		} else {
        		$Info = "";
      		}
    	}
  	} else {
    	print "[StringFileInfo not found in $filename]\n";
  	}
	return \%Result;
}

sub get_version {
	my $data = dumpfile($_[0]); 
	while(my($key,$value) = each(%{$data})){ 
		print "$key=$value\n";
	}
}