#!/usr/bin/perl
#
# PEct - PE Compilation Timestamp retriever
#
# 2014-12-06
#
# This is a simple script that shows the compilation timestamp
# for PE files; for Borland/Delphi/CodeGear/Embarcadero files
# it also shows the timestamp of resources' directory; it can
# be used as a point of reference instead of incorrect
# compilation timestamp as per bug #25402
#     http://qc.embarcadero.com/wc/qcmain.aspx?d=25402
# i.e. 1992-06-19 22:22:17 2A425E19, 708992537
#
# Usage:
#      perl PEct.pl <filename>
# Examples:
#      perl PEct.pl sample.exe

use strict;
use warnings;

$| = 1;

print STDERR  "
=====================================
 PEct v0.1, Hexacorn.com, 2014-12-06
=====================================
";

my $file = shift;
if (!defined($file))
{
  print STDERR "Gimme a file name!\n";
  exit;
}

if (!open    (FILE, '<'.$file))
{
  print STDERR "Can't open \"$file\"\n";
  exit;
}

binmode (FILE);

my $topdata;

if (!read (FILE, $topdata, 2))
{
  close FILE;
  print STDERR "Can't read \"$file\"\n";
  exit;
}

if ($topdata ne 'MZ')
{
  print STDERR "Not an MZ file\n";
  exit;
}

seek (FILE, 0x3C, 0);
read (FILE, my $o2PE,4);

$o2PE = unpack("I32",$o2PE);
if ($o2PE>16384)
{
  close FILE;
  print STDERR "Offset to PE header (=$o2PE) seems to be quite high - modify script if you think it's fine (some packers mess around with this value)\n";
  exit;
}

seek (FILE, $o2PE, 0); read (FILE, my $PEHeader,32); $PEHeader = substr($PEHeader,0,2);

if ($PEHeader ne 'PE')
{
  close FILE;
  print STDERR "Not a PE file\n";
  exit;
}

seek (FILE, $o2PE+4 ,0); read (FILE, my $MachineID,2); $MachineID = unpack("S16",$MachineID);

if ($MachineID != 0x14c && $MachineID != 0x8664)
{
  close FILE;
  print STDERR "PE file type (=$MachineID) not supported \n";
  exit;
}
seek (FILE, $o2PE+6 ,0); read (FILE, my $NumOfSections,2); $NumOfSections = unpack("S16",$NumOfSections);
seek (FILE, $o2PE+8 ,0); read (FILE, my $TimeStamp,4);     $TimeStamp     = unpack("I32",$TimeStamp);

$TimeStamp = gettime($TimeStamp);

my $rsrcTimeStamp=-1;

if ($NumOfSections==0)
{
  close FILE;
  print STDERR "PE file has no sections (could be a result of some PE tricks being applied to PE structure)\n";
  exit;
}

seek (FILE, $o2PE+20,0); read (FILE, my $OptHdrSize,2); $OptHdrSize = unpack("S16",$OptHdrSize);
seek (FILE, $o2PE + 24 + $OptHdrSize , 0); read (FILE, my $sections, $NumOfSections * 40);

for (my $k = 0;$k<$NumOfSections;$k++)
{
  seek (FILE, $o2PE + 24 + $OptHdrSize + $k*40, 0);
  read (FILE, my $sectionname,8);
  next if $sectionname ne ".rsrc\x00\x00\x00";

  read (FILE, my $vs,4);
  read (FILE, my $vo,4);
  read (FILE, my $fs,4); $fs = unpack("I32",$fs);
  read (FILE, my $fo,4); $fo = unpack("I32",$fo);
  seek (FILE, $o2PE + 24 + $OptHdrSize + $k*40+8+4*4+4+4+4, 0);
  seek (FILE, $fo , 0);
  if ($fs != 0)
  {
    my $sectiondata;
    read (FILE, $sectiondata, $fs);
    $rsrcTimeStamp = unpack("I32",substr($sectiondata,4,4));
  }

}
close FILE;

print "
File:        $file
PE Comp.:    $TimeStamp
";
if ($rsrcTimeStamp!=-1)
{
   print ".rsrc comp.: ".dostime($rsrcTimeStamp)."\n";
}

sub gettime
 {
    my $TimeStamp = shift;
    my ($y, $m, $d, $ss, $mm, $hh) = ( gmtime ( $TimeStamp ) )[5,4,3,0,1,2];

    if (defined($y))
    {
      $y += 1900;
      $m += 1;
      $TimeStamp = sprintf ("%d-%02d-%02d %02d:%02d:%02d %08lX, %d", $y, $m, $d, $hh, $mm, $ss, $TimeStamp, $TimeStamp);
    }
    else
    {
     $TimeStamp.= sprintf ("\t08lX",$TimeStamp);
    }
   return $TimeStamp;
 }


sub dostime
{
	my $timestamp = shift;
	return "0000-00-00 00:00:00" if ($timestamp==0);

	my $d = $timestamp>>16;
	my $t = $timestamp&0xFFFF;

	my $s=($t&0x1f)<<1;$s-- if ($s==60);
  return sprintf("%04d-%02d-%02d %02d:%02d:%02d %08lX, %d",(($d&0xfe00)>>9)+1980,($d&0x1e0)>>5,$d&0x1f,($t&0xF800)>>11,($t&0x7e0)>>5,$s,$timestamp,$timestamp);

}