src/lib/libjit/pedump/expdump.dpr

   1 // coded by Ketmar // Invisible Vector
   2 {.$DEFINE WRITE_RAW_SECTIONS}
   3 {$INCLUDE a_modes.inc}
   4 {$IFDEF MSWINDOWS}
   5   {$APPTYPE CONSOLE}
   6 {$ENDIF}
   7 program expdump;
   8
   9 uses
  10   SysUtils, Classes,
  11   pe32U in 'pe32U.pas';
  12
  13
  14 const
  15   secInfoFlags: array [0..9] of record flg: LongWord; name: string[8]; end = (
  16     (flg:$00000020; name:'code'),
  17     (flg:$00000040; name:'data'),
  18     (flg:$00000080; name:'bss'),
  19     (flg:$02000000; name:'disc'),
  20     (flg:$04000000; name:'no-cache'),
  21     (flg:$08000000; name:'no-page'),
  22     (flg:$10000000; name:'shr'),
  23     (flg:$20000000; name:'exe'),
  24     (flg:$40000000; name:'rd'),
  25     (flg:$80000000; name:'wr'));
  26
  27 type
  28   TExportNameRecord = record
  29     name: AnsiString;  // empty: by ordinal
  30     ordinal: Word;
  31   end;
  32
  33
  34 var
  35   inFile: AnsiString = '';
  36
  37   showSexInfo: Boolean = true;
  38   showExports: Boolean = true;
  39
  40   pe: Pointer = nil;
  41   peSize: Integer = 0;
  42   isDll: Boolean = false;
  43
  44   expDLLName: AnsiString = '';
  45   expOrdBase: LongWord = 0;
  46   expNames: array of TExportNameRecord = nil;
  47   expOrds: array of LongWord = nil; // rva's
  48   expFwds: array of AnsiString = nil;   // <> '': no fwd
  49   //expHasFwd: Boolean = false;
  50
  51
  52 // ////////////////////////////////////////////////////////////////////////// //
  53 function itoa (i: Integer): AnsiString; inline; begin str(i, result); end;
  54
  55
  56 function i2hex (i: LongWord; len: Integer): AnsiString;
  57 const
  58   hexD: packed array [0..15] of AnsiChar = '0123456789ABCDEF';
  59 var
  60   o: packed array [0..22] of AnsiChar;
  61   p: Integer;
  62 begin
  63   p := High(o);
  64   repeat
  65     o[p] := hexD[i and $0F]; Dec(p);
  66     i := (i shr 4) and $0FFFFFFF;
  67     if (len > 0) then Dec(len);
  68   until (i = 0);
  69   i := High(o)-p;
  70   Inc(p);
  71   if (len < 0) then len := 0;
  72   SetLength(result, len+Integer(i));
  73   i := 1;
  74   while (len > 0) do begin result[i] := '0'; Inc(i); Dec(len); end;
  75   while (p <= High(o)) do begin result[i] := o[p]; Inc(i); Inc(p); end;
  76 end;
  77
  78
  79 procedure fatal (const msg: AnsiString);
  80 begin
  81   writeln('***fatal: ', msg);
  82   Halt(1);
  83 end;
  84
  85
  86 function loadPE (const fileName: AnsiString): Boolean;
  87 var
  88   st: TStream = nil;
  89 begin
  90   result := false;
  91   try
  92     st := TFileStream.Create(fileName, fmOpenRead or fmShareDenyNone);
  93     peSize := st.size;
  94     if (peSize < 1024) then begin st.Free(); exit; end;
  95     ReallocMem(pe, peSize);
  96     st.ReadBuffer(pe^, peSize);
  97   except // sorry
  98     st.Free();
  99     exit;
 100   end;
 101   st.Free();
 102   result := true;
 103 end;
 104
 105
 106 procedure checkPE ();
 107 var
 108   h: PPEHeader;
 109   si: PPESectionInfo;
 110   f, c: Integer;
 111   s: ShortString;
 112   {pkl,} comma: Boolean;
 113 begin
 114   //pkl := false;
 115   h := getPEHeaderPtr(pe);
 116   isDll := ((h.flags and IMAGE_FILE_DLL) <> 0);
 117   //if (h.flags and IMAGE_FILE_DLL) <> 0 then Error('DLL: not yet');
 118   //!!if h.baseOfCode <> $1000 then Error('invalid base_of_code');
 119   c := h.numberOfSections;
 120   if (c = 0) then fatal('no sections');
 121   if (c > 127) then fatal('invalid number of sections');
 122   si := getPESectionsPtr(pe);
 123   if isDll then writeln('this PE is DLL');
 124   if showSexInfo then
 125   begin
 126     writeln(
 127       'image: base=$', i2hex(h.imageBase, 8),
 128       '; size=$', i2hex(h.imageSize, 8),
 129       '; entry=$', i2hex(h.entryRVA, 8));
 130     writeln('name     rva      ofs      size     vsize    flags');
 131   end;
 132   while (c > 0) do
 133   begin
 134     s[0] := #8;
 135     Move(si.name[0], s[1], 8);
 136     for f := 1 to 8 do if not (s[f] in [#32..#126]) then s[f] := ' ';
 137     if showSexInfo then
 138     begin
 139       write(s, ' ',
 140         '', i2hex(si.rva, 8),
 141         ' ', i2hex(si.physOffset, 8),
 142         ' ', i2hex(si.physSize, 8),
 143         ' ', i2hex(si.virtualSize, 8),
 144         ' ', i2hex(si.flags, 8));
 145       comma := false;
 146       for f := 0 to High(secInfoFlags) do
 147       begin
 148         if (si.flags and secInfoFlags[f].flg) <> 0 then
 149         begin
 150           if comma then write(', ') else write('; ');
 151           comma := true;
 152           write(secInfoFlags[f].name);
 153         end;
 154       end;
 155       writeln;
 156     end;
 157     //if s = '.pklstb ' then pkl := true;
 158     {
 159     if not doNotPack then
 160     begin
 161       if (si.rva <> 0) and (si.physSize <> 0) and (si.physOffset <> 0) and
 162          (((si.flags and IMAGE_SCN_MEM_DISCARDABLE) = 0) or
 163           ((si.flags and IMAGE_SCN_MEM_EXECUTE) <> 0)) and
 164          ((si.flags and IMAGE_SCN_MEM_WRITE) <> 0) then
 165       begin
 166         if (si.flags and IMAGE_SCN_MEM_SHARED) <> 0 then
 167           Error('writeable shared sections: not yet', true);
 168       end;
 169     end;
 170     }
 171     Dec(c); Inc(si);
 172   end;
 173   //if pkl then Error('probably PKLITEd file', true);
 174 end;
 175
 176
 177 procedure checkImports ();
 178 var
 179   h: PPEHeader;
 180   ir: PPEImportRec;
 181   th: LongWord;
 182   p: PLongWord;
 183 begin
 184   h := getPEHeaderPtr(pe);
 185   if (h.importTableRVA = 0) or (h.totalImportDataSize = 0) then exit;
 186   ir := rva2ptr(pe, h.importTableRVA);
 187   if (ir = nil) then fatal('invalid import_directory_entry');
 188   while (ir.nameRVA <> 0) do
 189   begin
 190     //!!if ir.nameRVA < h.baseOfCode then Error('invalid import directory');
 191     th := ir.origFirstThunkRVA;
 192     if (th = 0) then th := ir.firstThunkRVA;
 193     p := rva2ptr(pe, th);
 194     if (th <> 0) and (p <> nil) then
 195     begin
 196       while (p^ <> 0) do
 197       begin
 198         //if (p^ and $7FFFFFFF) < $1000 then Error('invalid import directory');
 199         if (p^ < $1000) then fatal('invalid import directory');
 200         Inc(p);
 201       end;
 202     end;
 203     Inc(ir);
 204   end;
 205 end;
 206
 207
 208 function getStrz (rva: LongWord): AnsiString;
 209 var
 210   len: Integer;
 211   p, pc: PAnsiChar;
 212 begin
 213   pc := rva2ptr(pe, rva);
 214   p := pc;
 215   len := 0;
 216   while (p^ <> #0) do begin Inc(len); Inc(p); end;
 217   SetString(result, pc, len);
 218 end;
 219
 220
 221 procedure extractExports ();
 222 var
 223   h: PPEHeader;
 224   p: PtrUInt;
 225   f, nof, non, frva, nrva, norva: LongWord;
 226 begin
 227   expOrdBase := expOrdBase; // shut up, fpc!
 228   h := getPEHeaderPtr(pe);
 229   if (h.exportTableRVA = 0) or (h.totalExportDataSize = 0) then exit;
 230   p := PtrUInt(rva2ptr(pe, h.exportTableRVA))+3*4;
 231   expDLLName := getStrz(PLongWord(p)^);
 232   Inc(p, 4);
 233   if (expDLLName = '') then fatal('invalid DLL name');
 234   expOrdBase := PLongWord(p)^; Inc(p, 4);
 235   nof := PLongWord(p)^; Inc(p, 4);
 236   non := PLongWord(p)^; Inc(p, 4);
 237   frva := PLongWord(p)^; Inc(p, 4);  // функции (nof)
 238   nrva := PLongWord(p)^; Inc(p, 4);  // имена (non)
 239   norva := PLongWord(p)^;{Inc(p, 4);}// оридналы имён (non)
 240   if (nof = 0) then fatal('invalid export section (0)');
 241   // rva для экспортов
 242   SetLength(expOrds, nof);
 243   SetLength(expFwds, nof);
 244   p := PtrUInt(rva2ptr(pe, frva));
 245   for f := 0 to nof-1 do
 246   begin
 247     expOrds[f] := PLongWord(p)^; Inc(p, 4);
 248     // проверим на форварды
 249     if (expOrds[f] <> 0) and
 250        (expOrds[f] >= h.exportTableRVA) and
 251        (expOrds[f] < h.exportTableRVA+h.totalExportDataSize) then
 252     begin
 253       expFwds[f] := getStrz(expOrds[f]);
 254       //expHasFwd := true;
 255     end
 256     else
 257     begin
 258       expFwds[f] := '';
 259     end;
 260   end;
 261   // экспорты по именам
 262   SetLength(expNames, non);
 263   if (non <> 0) then
 264   begin
 265     p := PtrUInt(rva2ptr(pe, nrva));
 266     for f := 0 to non-1 do begin expNames[f].name := getStrz(PLongWord(p)^); Inc(p, 4); end;
 267     p := PtrUInt(rva2ptr(pe, norva));
 268     for f := 0 to non-1 do begin expNames[f].ordinal := PWord(p)^; Inc(p, 2); end;
 269   end;
 270   // отладочный дамп
 271   if not showExports then exit;
 272   writeln(nof, ' ordinals, ', non, ' names');
 273   {
 274   writeln('ordinals:');
 275   for f := 0 to nof-1 do
 276   begin
 277     if expFwds[f] <> '' then writeln('  ', f+expOrdBase, ': "', expFwds[f], '"') else writeln('  ', f+expOrdBase);
 278   end;
 279   }
 280   writeln('index ordinal name');
 281   for f := 0 to non-1 do writeln(f:5, ' ', expNames[f].ordinal:7, ' ', expNames[f].name);
 282   writeln;
 283 end;
 284
 285
 286 // ////////////////////////////////////////////////////////////////////////// //
 287 begin
 288   if (ParamCount <> 1) then
 289   begin
 290     writeln('FILENAME!');
 291     Halt(1);
 292   end;
 293   inFile := ParamStr(1);
 294   //inFile := '../libjit-0.dll';
 295
 296   writeln('loading PE...');
 297   if not loadPE(inFile) then fatal('can''t load PE file');
 298   writeln('checking PE...');
 299   if not isValidPE(pe) then fatal('invalid PE file');
 300   checkPE();
 301   checkImports();
 302   extractExports();
 303 end.