pechecker.dpr

delphi开发语言下的源代码分析

// COPY/Y C:\ext\ls\Apps\PEChecker\PEChecker.exe c:\dos\pec.exe
program PEChecker;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Classes;

const
  FT_ANY = 0;
  FT_DLL = IMAGE_FILE_DLL;
  FT_ROM = IMAGE_ROM_OPTIONAL_HDR_MAGIC;
  FT_EXE = IMAGE_FILE_EXECUTABLE_IMAGE;

  rpNextPosition = -1;

type
  TCheckCallback = procedure (FN : String);

function ReadPString(F:TFileStream; FromPosition, ReturnPosition : Int64) : String;
var
  StrBuf : array [0..$10] of char;
begin
  Result := '';
  StrBuf[$10] := #0;

  F.Position := FromPosition;
  while true do
  begin
    F.Read(StrBuf[0], $10);  // 16 bytes
    Result := Result + String(pChar(@StrBuf));
    if Length(Result) mod $10 <> 0 then
      Break;
  end;

  if ReturnPosition <> rpNextPosition then
    F.Position := ReturnPosition;
end;

function isPE(F:TFileStream; FType:WORD) : Boolean;
var
  Size : DWORD;
  Tag : WORD;
  NTHead : DWORD;
  Characteristics : Word;
begin
  Result := False;
  Size := F.Size;
  if Size <= SizeOf(TImageDosHeader) + 4 + SizeOf(TImageFileHeader) then
    Exit;

  F.Seek(0,soFromBeginning);
  F.Read(Tag, 2);
  F.Seek(2, soFromCurrent);
  if Tag <> IMAGE_DOS_SIGNATURE then
    Exit;

  F.Seek(SizeOf(TImageDosHeader)-8, soFromCurrent);
  F.Read(NTHead, 4); // _lfanew
  if Size <= NTHead + 4 + SizeOf(TImageFileHeader) then
    Exit;

  F.Seek(NTHead, soFromBeginning);
  F.Read(NTHead, 4);
  if NTHead <> IMAGE_NT_SIGNATURE then
    Exit;

  if FType = FT_ANY then
    Result := True
  else
  begin
    F.Seek(SizeOf(TImageFileHeader)-2, soFromCurrent);
    F.Read(Characteristics, 2);
    case FType of
      FT_ROM :
        begin
          F.Read(Characteristics, 2);
          Result := Characteristics = FT_ROM;
          F.Seek(-2, soFromCurrent)
        end;
      FT_EXE :
        Result := ((Characteristics and FType) <> 0) and
                  ((Characteristics and FT_DLL) = 0);
    else
      Result := (Characteristics and FType) <> 0;
    end;
    F.Seek(-SizeOf(TImageFileHeader), soFromCurrent)
  end;
end;

const
  IMAGE_SIZEOF_OPTIONAL_HEADER_NONEDIRECTOR = 96;

function PosToSectionEntry(F: TFileStream; Section: SmallInt; out VABase, VASize, RawAddr: DWORD): Boolean;
var
  tempPos : Int64;
  tempSize : DWORD;
  NumberOfRvaAndSizes : DWORD;
  i : Integer;
  SectionHeader : TImageSectionHeader;
  SizeOfOptionalHeader : DWORD;
begin
  Result := False;
  if (F.Position <> 0) or isPE(F, FT_ANY) then
  begin
    tempSize := 0;
    F.Seek(2, soFromCurrent);      // 跳2个字节: TImageFileHeader.Machine
    F.Read(tempSize, 2);           // 取TImageFileHeader.NumberOfSections
    F.Seek(SizeOf(TImageFileHeader) - 4 - 4 , soFromCurrent);   // 定位到TImageFileHeader.SizeOfOptionalHeader
    F.Read(SizeOfOptionalHeader, 4);
    SizeOfOptionalHeader := SizeOfOptionalHeader and $0000FFFF; // 去除掉高位的TImageFileHeader.Characteristics
    tempPos := F.Position;         // 可选头部
    F.Seek(IMAGE_SIZEOF_OPTIONAL_HEADER_NONEDIRECTOR-4, soFromCurrent);  //定位到NumberOfRvaAndSizes
    F.Read(NumberOfRvaAndSizes, 4);
    if NumberOfRvaAndSizes > Section then
    begin
      F.Seek(Section * SizeOf(TImageDataDirectory), soFromCurrent);
      F.Read(VABase, 4);
      if VABase <> 0 then
      begin
        F.Read(VASize, 4);
        inc(tempPos, SizeOfOptionalHeader);
        F.Seek(tempPos, soFromBeginning);
        for i := 0 to tempSize - 1 do
        begin
          F.Read(SectionHeader, SizeOf(TImageSectionHeader));
          with SectionHeader do
            // 如果虚地址相等或者VABase落在节的内部
            if (VABase = VirtualAddress) or
               ((VABase > VirtualAddress) and (VABase < VirtualAddress + Misc.VirtualSize)) then
            begin
              RawAddr := PointerToRawData + (VABase - VirtualAddress);
              F.Seek(RawAddr, soFromBeginning);
              Result := True;
              Exit;
            end;
        end;
      end;
    end;

    // 如果返回False, 则定位到PE头
    F.Position := tempPos - SizeOf(TImageFileHeader);
  end;
end;

procedure DoCheck(callback:TCheckCallback; Dir : String = ''; FN : String = '*.*');
var
  Sr : TSearchRec;
begin
  if FindFirst(Dir+FN, faAnyFile-faVolumeID, Sr) = 0 then
    repeat
      if (Sr.Attr and faDirectory)=0 then //is File
        callback(Dir+Sr.Name)
      else //is Directory
        if Sr.Name[1] <> '.' then
          DoCheck(callback, Dir+Sr.name+'\', FN);
    until FindNext(Sr) <> 0;
end;

procedure CheckPE(FN : String);
var
  F : TFileStream;
begin
  F := TFileStream.Create(FN, fmOpenRead + fmShareDenyNone);
  if isPE(F, FT_ANY) then
    writeln(FN, ' --> True');
  F.Free;
end;

var
  CheckCount : Integer = 0;
  CheckedCount : Integer = 0;

procedure CheckExportTable(FN : String);
var
  VABase, VASize, RawAddr: DWORD;
  F : TFileStream;
  ExportDirectory : TImageExportDirectory;

  pOrdinal : PWord;
  Functions : array of DWORD;
  i : integer;
  iOrd : WORD;
  ForwardStr : String;
  ForwardStrBuf : array [0..$F] of char;
begin
  inc(CheckCount);
  try
    F := TFileStream.Create(FN, fmOpenRead + fmShareDenyNone);
  except
    exit;
  end;

  if PosToSectionEntry(F, IMAGE_DIRECTORY_ENTRY_EXPORT, VABase, VASize, RawAddr) then
  begin
    F.Read(ExportDirectory , SizeOf(TImageExportDirectory));

    // Number check
    if ExportDirectory.NumberOfFunctions <> ExportDirectory.NumberOfNames then
    begin
      writeln('Warning: --> ', FN);
      inc(CheckedCount);
    end;

    // forwarding check
    SetLength(Functions, ExportDirectory.NumberOfFunctions);
    F.Seek(RawAddr + (DWORD(ExportDirectory.AddressOfFunctions) - VABase), soFromBeginning);
    F.Read(Functions[0], ExportDirectory.NumberOfFunctions*SizeOf(DWORD));
    for i := 0 to ExportDirectory.NumberOfFunctions - 1 do
    begin
      if (Functions[i] > VABase) and
         (Functions[i] < VABase + VASize) then
        writeln(format('导出序号为[%.4x]的例程输出转交到: %S',
                       [i+ExportDirectory.Base,
                        ReadPString(F, RawAddr + (Functions[i] - VABase), rpNextPosition)]));
    end;

    // Orinals check
    F.Seek(RawAddr + (DWORD(ExportDirectory.AddressOfNameOrdinals) - VABase), soFromBeginning);
    for i := 0 to ExportDirectory.NumberOfNames - 1 do
    begin
      F.Read(iOrd, 2);
      Functions[iOrd] := $FFFFFFFF;
    end;
    for i := 0 to ExportDirectory.NumberOfFunctions - 1 do
    begin
      if Functions[i] = 0 then
        writeln(format('导出序号为[%.4x]的例程是无效的.', [i+ExportDirectory.Base]))
      else
        if Functions[i] <> $FFFFFFFF then
          writeln(format('序号为[%.4x]的例程没有可用名字.', [i+ExportDirectory.Base]));
    end;
  end;

  F.Free;
end;

procedure CheckExeExports(FN : String);
var
  VABase, VASize, RawAddr: DWORD;
  F : TFileStream;
  ExportDirectory : TImageExportDirectory;

begin
  inc(CheckCount);
  try
    F := TFileStream.Create(FN, fmOpenRead + fmShareDenyNone);
  except
    exit;
  end;

  if isPE(F, FT_EXE) and
     PosToSectionEntry(F, IMAGE_DIRECTORY_ENTRY_EXPORT, VABase, VASize, RawAddr) then
  begin
    F.Read(ExportDirectory , SizeOf(TImageExportDirectory));
    Writeln(format('文件[%s]拥有%d个输出例程!', [FN, ExportDirectory.NumberOfFunctions]));
    inc(CheckedCount);
  end;
end;

procedure CheckInitExeAddr(FN : String);
var
  BaseOfCode : DWORD;
  F : TFileStream;
  ExportDirectory : TImageExportDirectory;

begin
  inc(CheckCount);
  try
    F := TFileStream.Create(FN, fmOpenRead + fmShareDenyNone);
  except
    exit;
  end;

  if isPE(F, FT_ANY) then
  begin
    F.Seek(SizeOf(TImageFileHeader) + IMAGE_SIZEOF_STD_OPTIONAL_HEADER - 8, soFromCurrent);
    F.Read(BaseOfCode, 4);
    if BaseOfCode <> $1000 then
      Writeln(format('文件[%s]代码节起始地址异常!', [FN]));
    inc(CheckedCount);
  end;
end;

var
  F : TFileStream;

begin
//  DoCheck(CheckExportTable, 'c:\winnt\system32\drivers\', 'storport.sys');
//  DoCheck(CheckExportTable, 'c:\winnt\system32\', 'shell32.dll');

  if ParamCount > 0 then
    DoCheck(CheckInitExeAddr, ParamStr(1))
  else
    DoCheck(CheckInitExeAddr);

  writeln('Check: ', CheckCount, 'Checked: ':12, CheckedCount);
end.