peimageinfo.dpr

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

program PEImageInfo;

{$APPTYPE CONSOLE}
{$WRITEABLECONST ON}

uses
//  LocalHeapMM,
  Windows, SysUtils,
  PEImageTools;

type
  PMemoryArea = ^TMemoryArea;
  TMemoryArea = record
    name : String;
    VA : DWORD;
    VSize : DWORD;
  end;

var
  StackArr,
  SectionArr,
  DirectoryArr : array of TMemoryArea;
  ProcessHeaps : array of DWORD;

const
  Strs_DirectoryList : array [0..14] of string
                     = ('Export Directory',
                        'Import Directory',
                        'Resource Directory',
                        'Exception Directory',
                        'Security Directory',
                        'Base Relocation Table',
                        'Debug Directory',
                        'Description String',
                        'Machine Value (MIPS GP)',
                        'TLS Directory',
                        'Load Configuration Directory',
                        'Bound Import Directory in headers',
                        'Import Address Table',
                        'Delay Load Import Descriptors',
                        'COM Runtime descriptor');

function ImageVaToRva(Base: Pointer; Va: Pointer): ULONG;
begin
  Result := DWORD(Va) - DWORD(Base);
end;

procedure InitHeapArr; // only process!
var
  p : DWORD;
begin
  SetLength(ProcessHeaps, 20);
  SetLength(ProcessHeaps, GetProcessHeaps(20, ProcessHeaps[0]));
end;

procedure InitDirectoryArr(Module: THandle);
var
  i : Integer;
  RVA, RVSize : DWORD;
begin
  DirectoryArr := nil;
  for i := low(Strs_DirectoryList) to high(Strs_DirectoryList) do
    if ImageGetSectionInfo(Module, i, RVA, RVSize) and (RVSize > 0) then
    begin
      SetLength(DirectoryArr, Length(DirectoryArr) + 1);
      with DirectoryArr[high(DirectoryArr)] do
      begin
        name := Strs_DirectoryList[i];
        VA := Module + RVA;
        VSize := RVSize;
      end;
    end;
end;

procedure InitSectionArr(Module: THandle);
var
  i : Integer;
begin
  i := 0;
  SetLength(SectionArr, i+1);
  while ImageGetSectionInfo(Module, i, SectionArr[i].Name, SectionArr[i].VA, SectionArr[i].VSize) do
  begin
    SectionArr[i].VA := Module + SectionArr[i].VA;
    inc(i);
    SetLength(SectionArr, i+1);
  end;

  while (Length(SectionArr) > 0) and (SectionArr[high(SectionArr)].VSize = 0) do
    SetLength(SectionArr, Length(SectionArr) - 1);
end;

function VarWhere(const V) : String;
var
  i,j : Integer;
  p : PMemoryArea;
  HiArr : Integer;
  HeapEntry : PROCESS_HEAP_ENTRY;
begin
  Result := 'UNKNOW';
  for i := 0 to 1 do
  begin
    case i of
      0 : begin
            HiArr := High(DirectoryArr);
            p := Pointer(DirectoryArr);
          end;
      1 : begin
            HiArr := High(SectionArr);
            p := Pointer(SectionArr);
          end;
    end;

    while HiArr >= 0 do
    begin
      with p^ do
        if (DWORD(@V) >= VA) and (DWORD(@V) < VA + VSize) then
        begin
          Result := name;
          Exit;
        end;
      inc(p);
      dec(HiArr);
    end;
  end;

  //列举堆 ???
  for i := low(ProcessHeaps) to high(ProcessHeaps) do
  begin
    HeapEntry.lpData := nil;
    while HeapWalk(ProcessHeaps[i], HeapEntry) do
      if HeapEntry.lpData = @V then
      begin
//        Result := format('Heap(%d)_%.8x', [i, ProcessHeaps[i]]);
        Exit;
      end;
  end;
end;

function MemoryWhere(const V) : String;
begin
  Result := VarWhere(Pointer(V)^);
end;

(*
// WARNINGS!!!
function VarInSection(Const V) : String;
var
  NtHeader : PImageNtHeaders;
  pSection : PImageSectionHeader;
  RVA : DWORD;
begin
  Result := 'UNKNOW';
  if ImageIsPE(MainInstance, Pointer(NtHeader)) then
  begin
    RVA := ImageVaToRva(Pointer(MainInstance), @V);
    pSection := ImageRvaToSection(NtHeader, Pointer(MainInstance), RVA);
    if pSection <> nil then
    begin
      SetLength(Result, IMAGE_SIZEOF_SHORT_NAME);
      StrLCopy(@Result[1], @pSection^.Name, IMAGE_SIZEOF_SHORT_NAME);
    end;
  end;
end;

// WARNINGS!!!
function MemoryInSection(const V) : String;
begin
  Result := VarInSection(Pointer(V)^);
end;
*)

resourcestring
  ResStr = 'abcdef';

type
  TR = Record
    i, j, k : integer;
  end;

const
  icon : Integer = 5;
  C_Set256 = [#0..#255];
  C_Str1 : string = '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890';
  C_Str2 = '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' +
           '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' +
           '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890';
  C_Str3 = '123';
  C_Rec  : TR = (i:3; j:3; k:3);

  I_DWord : DWORD = 3;
  i64 = Int64(4);

var
  i : integer;
  p : pointer;
  V_Str1 : string = 'acdefadf';
  V_Str2 : String;
  HeapEntry : PROCESS_HEAP_ENTRY;
  v_r1, v_r2 : String;
  V_ResStr : string = ResStr;

begin
  InitHeapArr;
  InitSectionArr(MainInstance);
  InitDirectoryArr(MainInstance);

  writeln(' - 常量 -');
  writeln('大的集合(Mem)   : ', VarWhere(C_Set256));
  writeln('类型化常量(Mem) : ', VarWhere(icon));
  writeln('直接引用常量(Mem):', VarWhere('abcd'));

  writeln;
  writeln(' - 字符串常数、变量与字符串类型常量定义 -');
  writeln('普通常量(Mem)   : ', VarWhere(C_Str3));

  writeln('类型化常量(Addr): ', VarWhere(C_Str1));
  writeln('类型化常量(Mem) : ', MemoryWhere(C_Str1));
  C_Str1 := 'dcba';
  writeln('常量赋值(Addr)  : ', VarWhere(C_Str1));
  writeln('常量赋值(Mem)   : ', MemoryWhere(C_Str1));

  writeln('变量(Addr)      : ', VarWhere(V_Str1));
  writeln('变量(Mem)       : ', MemoryWhere(V_Str1));
  V_Str1 := 'abcd';
  writeln('变量赋值(Addr)  : ', VarWhere(V_Str1));
  writeln('变量赋值(Mem)   : ', MemoryWhere(V_Str1));

  writeln;
  writeln(' - 记录(类型)常量 -');
  writeln('记录常量(Mem)   : ', VarWhere(C_Rec));  //没有动态内存分配的数据类型

  writeln;
  writeln(' - 无初值的变量, 以及变量的内存占用 -');
  writeln('无初值变量(Addr): ', VarWhere(V_Str2));
  SetLength(V_Str2, 5000);
  writeln('内存占用(GetMem): ', MemoryWhere(V_Str2));

  writeln;
  writeln(' - 指针, 及其动态内存占用 -');
  writeln('无初值指针(Addr): ', VarWhere(p));
  getMem(p, 100);
  writeln('GetMem(p)       : ', MemoryWhere(p));

  v_r1 := ResStr;
  v_r2 := ResStr;
  writeln;
  writeln(' - 资源串 -');
  writeln('资源串(Addr)    : ', VarWhere(v_r1));
  writeln('资源串初值(Addr): ', VarWhere(V_ResStr));
  writeln('资源串初值(Mem) : ', MemoryWhere(V_ResStr));

readln;
end.