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