1 {
2     Copyright (c) 1998-2002 by Pavel
3 
4     This unit finds the export defs from PE files
5 
6     C source code of DEWIN Windows disassembler (written by A. Milukov) was
7     partially used
8 
9     This program is free software; you can redistribute it and/or modify
10     it under the terms of the GNU General Public License as published by
11     the Free Software Foundation; either version 2 of the License, or
12     (at your option) any later version.
13 
14     This program is distributed in the hope that it will be useful,
15     but WITHOUT ANY WARRANTY; without even the implied warranty of
16     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17     GNU General Public License for more details.
18 
19     You should have received a copy of the GNU General Public License
20     along with this program; if not, write to the Free Software
21     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22 
23  ****************************************************************************
24 }
25 unit impdef;
26 
27 {$ifndef STANDALONE}
28   {$i fpcdefs.inc}
29 {$endif}
30 
31 interface
32 
33    uses
34      SysUtils;
35 
36    var
37      as_name,
38      ar_name : string;
39 
makedefnull40     function makedef(const binname,
41 {$IFDEF STANDALONE}
42                            textname,
43 {$ENDIF}
44                            libname:string):longbool;
45 
46 
47 implementation
48 
49 uses
50   cfileutl;
51 
52 {$IFDEF STANDALONE}
53 var
54   __textname : string;
55 const
56   kind : array[longbool] of pchar=('',' DATA');
57 {$ENDIF}
58 
59 var
60   f:file;
61 {$IFDEF STANDALONE}
62   t:text;
63   FileCreated:longbool;
64 {$ENDIF}
65   lname:string;
66   impname:string;
67   TheWord:array[0..1]of char;
68   PEoffset:cardinal;
69   loaded:longint;
70 
DOSstubOKnull71 function DOSstubOK(var x:cardinal):longbool;
72 begin
73   blockread(f,TheWord,2,loaded);
74   if loaded<>2 then
75    DOSstubOK:=false
76   else
77    begin
78     DOSstubOK:=TheWord='MZ';
79     seek(f,$3C);
80     blockread(f,x,4,loaded);
81     if(loaded<>4)or(x>filesize(f))then
82      DOSstubOK:=false;
83    end;
84 end;
85 
86 
isPEnull87 function isPE(x:longint):longbool;
88 begin
89   seek(f,x);
90   blockread(f,TheWord,2,loaded);
91   isPE:=(loaded=2)and(TheWord='PE');
92 end;
93 
94 
95 var
96   cstring : array[0..127]of char;
GetEdatanull97 function GetEdata(PE:cardinal):longbool;
98 type
99   TObjInfo=packed record
100    ObjName:array[0..7]of char;
101    VirtSize,
102    VirtAddr,
103    RawSize,
104    RawOffset,
105    Reloc,
106    LineNum:cardinal;
107    RelCount,
108    LineCount:word;
109    flags:cardinal;
110   end;
111 var
112   i:cardinal;
113   ObjOfs:cardinal;
114   Obj:TObjInfo;
115   APE_obj,APE_Optsize:word;
116   ExportRVA:cardinal;
117   delta:cardinal;
118 const
119  IMAGE_SCN_CNT_CODE=$00000020;
120  const
121 {$ifdef unix}
122   DirSep = '/';
123 {$else}
124   {$ifdef hasamiga}
125   DirSep = '/';
126   {$else}
127   DirSep = '\';
128   {$endif}
129 {$endif}
130 var
131  path:string;
132  _d:dirstr;
133  _n:namestr;
134  _e:extstr;
135  common_created:longbool;
136 procedure cleardir(const s,ext:string);
137  var
138   ff:file;
139   dir:searchrec;
140   attr:word;
141  begin
142   findfirst(s+dirsep+ext,anyfile,dir);
143   while (doserror=0) do
144    begin
145      assign(ff,s+dirsep+dir.name);
146      GetFattr(ff,attr);
147      if not((DOSError<>0)or(Attr and Directory<>0))then
148       Erase(ff);
149      findnext(dir);
150    end;
151   findclose(dir);
152  end;
153 procedure CreateTempDir(const s:string);
154  var
155   attr:word;
156   ff:file;
157  begin
158   assign(ff,s);
159   GetFattr(ff,attr);
160   if DosError=0 then
161    begin
162     cleardir(s,'*.sw');
163     cleardir(s,'*.swo');
164    end
165  else
166   begin
167     {$push} {$I-}
168      mkdir(s);
169     {$pop}
170     if ioresult<>0 then;
171   end;
172  end;
173 procedure call_as(const name:string);
174  begin
175   FlushOutput;
176   RequotedExecuteProcess(as_name,'-o '+name+'o '+name);
177  end;
178 procedure call_ar;
179  var
180   f:file;
181   attr:word;
182  begin
183 {$IFDEF STANDALONE}
184   if impname='' then
185    exit;
186 {$ENDIF}
187   assign(f,impname);
188   GetFAttr(f,attr);
189   If DOSError=0 then
190    erase(f);
191   FlushOutput;
192   RequotedExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
193   cleardir(path,'*.sw');
194   cleardir(path,'*.swo');
195   {$push} {$I-}
196   RmDir(path);
197   {$pop}
198   if ioresult<>0 then;
199  end;
200 procedure makeasm(index:cardinal;name:pchar;isData:longbool);
201  type
202   tt=array[1..1]of pchar;
203   pt=^tt;
204  const
205   fn_template:array[1..24]of pchar=(
206    '.section .idata$2',
207    '.rva        .L4',
208    '.long       0,0',
209    '.rva        ',
210    '.rva        .L5',
211    '.section .idata$4',
212    '.L4:',
213    '.rva        .L6',
214    '.long       0',
215    '.section .idata$5',
216    '.L5:',
217    '.text',
218    '.globl      ',
219    ':',
220    'jmp *.L7',
221    '.balign 4,144',
222    '.section .idata$5',
223    '.L7:',
224    '.rva        .L6',
225    '.long       0',
226    '.section .idata$6',
227    '.L6:',
228    '.short      0',
229    '.ascii      "\000"'
230   );
231   var_template:array[1..19]of pchar=(
232    '.section .idata$2',
233    '.rva        .L7',
234    '.long       0,0',
235    '.rva        ',
236    '.rva        .L8',
237    '.section .idata$4',
238    '.L7:',
239    '.rva        .L9',
240    '.long       0',
241    '.section .idata$5',
242    '.L8:',
243    '.globl      ',
244    ':',
245    '.rva        .L9',
246    '.long       0',
247    '.section .idata$6',
248    '.L9:',
249    '.short      0',
250    '.ascii      "\000"'
251   );
252   __template:array[longbool]of pointer=(@fn_template,@var_template);
253   common_part:array[1..5]of pchar=(
254    '.balign 2,0',
255    '.section .idata$7',
256    '.globl      ',
257    ':',
258    '.ascii      "\000"'
259   );
260   posit:array[longbool,1..4]of longint=((4,13,14,24),(4,12,13,19));
261  var
262   template:array[longbool]of pt absolute __template;
263   f:text;
264   s:string;
265   i:longint;
266   n:string;
267   common_name,asmout:string;
268   __d:dirstr;
269   __n:namestr;
270   __x:extstr;
271  begin
272   if not common_created then
273    begin
274     common_name:='_$'+_n+'@common';
275     asmout:=path+dirsep+'0.sw';
276     assign(f,asmout);
277     rewrite(f);
278     for i:=1 to 5 do
279      begin
280       s:=StrPas(Common_part[i]);
281       case i of
282        3:
283         s:=s+common_name;
284        4:
285         s:=common_name+s;
286        5:
287         begin
288          fsplit(lname,__d,__n,__x);
289          insert(__n+__x,s,9);
290         end;
291       end;
292       writeln(f,s);
293      end;
294     close(f);
295     call_as(asmout);
296     common_created:=true;
297    end;
298   n:=strpas(name);
299   str(succ(index):0,s);
300   asmout:=path+dirsep+s+'.sw';
301   assign(f,asmout);
302   rewrite(f);
303   for i:=1 to posit[isData,4]do
304    begin
305     s:=StrPas(template[isData]^[i]);
306     if i=posit[isData,1]then
307      s:=s+common_name
308     else if i=posit[isData,2]then
309      s:=s+n
310     else if i=posit[isData,3]then
311      s:=n+s
312     else if i=posit[isData,4]then
313      insert(n,s,9);
314     writeln(f,s);
315    end;
316   close(f);
317   call_as(asmout);
318  end;
319 procedure ProcessEdata;
320   type
321    a8=array[0..7]of char;
GetSectionNamenull322   function GetSectionName(rva:cardinal;var Flags:cardinal):a8;
323    var
324     i:cardinal;
325     LocObjOfs:cardinal;
326     LocObj:TObjInfo;
327    begin
328     GetSectionName:='';
329     Flags:=0;
330     LocObjOfs:=APE_OptSize+PEoffset+24;
331     for i:=1 to APE_obj do
332      begin
333       seek(f,LocObjOfs);
334       blockread(f,LocObj,sizeof(LocObj));
335       if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then
336        begin
337         GetSectionName:=a8(LocObj.ObjName);
338         Flags:=LocObj.flags;
339        end;
340      end;
341    end;
342   var
343    j,Fl:cardinal;
344    ulongval,procEntry:cardinal;
345    Ordinal:word;
346    isData:longbool;
347    ExpDir:packed record
348     flag,
349     stamp:cardinal;
350     Major,
351     Minor:word;
352     Name,
353     Base,
354     NumFuncs,
355     NumNames,
356     AddrFuncs,
357     AddrNames,
358     AddrOrds:cardinal;
359    end;
360   begin
361    with Obj do
362     begin
363      seek(f,RawOffset+delta);
364      blockread(f,ExpDir,sizeof(ExpDir));
365      fsplit(impname,_d,_n,_e);
366      path:=_d+_n+'.ils';
367 {$IFDEF STANDALONE}
368      if impname<>'' then
369 {$ENDIF}
370      CreateTempDir(path);
371      Common_created:=false;
372      for j:=0 to pred(ExpDir.NumNames)do
373       begin
374        seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2);
375        blockread(f,Ordinal,2);
376        seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+Cardinal(Ordinal*4));
377        blockread(f,ProcEntry,4);
378        seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
379        blockread(f,ulongval,4);
380        seek(f,RawOffset-VirtAddr+ulongval);
381        blockread(f,cstring,sizeof(cstring));
382 {$IFDEF STANDALONE}
383        if not FileCreated then
384         begin
385          FileCreated:=true;
386          if(__textname<>'')or(impname='')then
387           begin
388            rewrite(t);
389            writeln(t,'EXPORTS');
390           end;
391         end;
392 {$ENDIF}
393        isData:=GetSectionName(procentry,Fl)='';
394        if not isData then
395         isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
396 {$IFDEF STANDALONE}
397        if(__textname<>'')or(impname='')then
398         writeln(t,cstring,' @',succ(ordinal):0,' ',kind[isData]);
399        if impname<>''then
400 {$ENDIF}
401        makeasm(j,cstring,isData);
402       end;
403      call_ar;
404    end;
405   end;
406 
407 begin
408   GetEdata:=false;
409 {$IFDEF STANDALONE}
410   FileCreated:=false;
411 {$ENDIF}
412   seek(f,PE+120);
413   blockread(f,ExportRVA,4);
414   seek(f,PE+6);
415   blockread(f,APE_Obj,2);
416   seek(f,PE+20);
417   blockread(f,APE_OptSize,2);
418   ObjOfs:=APE_OptSize+PEoffset+24;
419   for i:=1 to APE_obj do
420    begin
421     seek(f,ObjOfs);
422     blockread(f,Obj,sizeof(Obj));
423     inc(ObjOfs,sizeof(Obj));
424     with Obj do
425      if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then
426       begin
427        delta:=ExportRva-VirtAddr;
428        ProcessEdata;
429        GetEdata:=true;
430       end;
431    end;
432 end;
433 
434 
makedefnull435 function makedef(const binname,
436 {$IFDEF STANDALONE}
437                        textname,
438 {$ENDIF}
439                        libname:string):longbool;
440 var
441   OldFileMode:longint;
442 begin
443   assign(f,binname);
444 {$IFDEF STANDALONE}
445   FileCreated:=false;
446   assign(t,textname);
447   __textname:=textname;
448 {$ENDIF}
449   impname:=libname;
450   lname:=binname;
451   OldFileMode:=filemode;
452   {$push} {$I-}
453    filemode:=0;
454    reset(f,1);
455    filemode:=OldFileMode;
456   {$pop}
457   if IOResult<>0 then
458    begin
459      makedef:=false;
460      exit;
461    end;
462   if not DOSstubOK(PEoffset)then
463    makedef:=false
464   else if not IsPE(PEoffset)then
465    makedef:=false
466   else
467    makedef:=GetEdata(PEoffset);
468   close(f);
469 {$IFDEF STANDALONE}
470   if FileCreated then
471    if(textname<>'')or(impname='')then
472     close(t);
473 {$ENDIF}
474 end;
475 
476 end.
477