mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 20:29:32 +02:00
* made Pavel O. happy ;)
This commit is contained in:
peter
parent
00a1168246
commit
a13360ee96
@ -1,6 +1,6 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2000 by Florian Klaempfl
|
||||
Copyright (c) 1998-2000 by Pavel
|
||||
|
||||
This unit finds the export defs from PE files
|
||||
|
||||
@ -25,22 +25,53 @@
|
||||
}
|
||||
unit impdef;
|
||||
|
||||
{$i defines.inc}
|
||||
{$ifndef STANDALONE}
|
||||
{$i defines.inc}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
function makedef(const binname,textname:string):longbool;
|
||||
uses
|
||||
{$ifdef Delphi}
|
||||
SysUtils,
|
||||
Dmisc;
|
||||
{$else}
|
||||
Dos;
|
||||
{$endif}
|
||||
|
||||
var
|
||||
asw_name,
|
||||
arw_name : string;
|
||||
|
||||
function makedef(const binname,
|
||||
{$IFDEF STANDALONE}
|
||||
textname,
|
||||
{$ENDIF}
|
||||
libname:string):longbool;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF STANDALONE}
|
||||
var
|
||||
__textname : string;
|
||||
const
|
||||
kind : array[longbool] of pchar=('',' DATA');
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
f:file;
|
||||
{$IFDEF STANDALONE}
|
||||
t:text;
|
||||
FileCreated:longbool;
|
||||
{$ENDIF}
|
||||
lname:string;
|
||||
impname:string;
|
||||
TheWord:array[0..1]of char;
|
||||
PEoffset:cardinal;
|
||||
loaded:longint;
|
||||
FileCreated:longbool;
|
||||
loaded:{$ifdef fpc}longint{$else}integer{$endif};
|
||||
|
||||
function DOSstubOK(var x:cardinal):longbool;
|
||||
function DOSstubOK(var x:longint):longbool;
|
||||
begin
|
||||
blockread(f,TheWord,2,loaded);
|
||||
if loaded<>2 then
|
||||
@ -55,16 +86,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function isPE(x:cardinal):longbool;
|
||||
|
||||
function isPE(x:longint):longbool;
|
||||
begin
|
||||
seek(f,x);
|
||||
blockread(f,TheWord,2,loaded);
|
||||
isPE:=(loaded=2)and(TheWord='PE');
|
||||
end;
|
||||
|
||||
var
|
||||
cstring:array[0..127]of char;
|
||||
|
||||
var
|
||||
cstring : array[0..127]of char;
|
||||
function GetEdata(PE:cardinal):longbool;
|
||||
type
|
||||
TObjInfo=packed record
|
||||
@ -86,11 +118,234 @@ var
|
||||
APE_obj,APE_Optsize:word;
|
||||
ExportRVA:cardinal;
|
||||
delta:cardinal;
|
||||
|
||||
const
|
||||
IMAGE_SCN_CNT_CODE=$00000020;
|
||||
const
|
||||
{$ifdef unix}
|
||||
DirSep = '/';
|
||||
{$else}
|
||||
{$ifdef amiga}
|
||||
DirSep = '/';
|
||||
{$else}
|
||||
DirSep = '\';
|
||||
{$endif}
|
||||
{$endif}
|
||||
var
|
||||
path:string;
|
||||
_d:dirstr;
|
||||
_n:namestr;
|
||||
_e:extstr;
|
||||
common_created:longbool;
|
||||
procedure cleardir(const s,ext:string);
|
||||
var
|
||||
ff:file;
|
||||
dir:searchrec;
|
||||
attr:word;
|
||||
begin
|
||||
findfirst(s+dirsep+ext,anyfile,dir);
|
||||
while (doserror=0) do
|
||||
begin
|
||||
assign(ff,s+dirsep+dir.name);
|
||||
GetFattr(ff,attr);
|
||||
if not((DOSError<>0)or(Attr and Directory<>0))then
|
||||
Erase(ff);
|
||||
findnext(dir);
|
||||
end;
|
||||
findclose(dir);
|
||||
end;
|
||||
procedure CreateTempDir(const s:string);
|
||||
var
|
||||
attr:word;
|
||||
ff:file;
|
||||
begin
|
||||
assign(ff,s);
|
||||
GetFattr(ff,attr);
|
||||
if DosError=0 then
|
||||
begin
|
||||
cleardir(s,'*.sw');
|
||||
cleardir(s,'*.swo');
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$I-}
|
||||
mkdir(s);
|
||||
{$I+}
|
||||
if ioresult<>0 then;
|
||||
end;
|
||||
end;
|
||||
procedure call_asw(const name:string);
|
||||
begin
|
||||
writeln(name);
|
||||
exec(asw_name,'-o '+name+'o '+name);
|
||||
end;
|
||||
procedure call_arw;
|
||||
var
|
||||
f:file;
|
||||
attr:word;
|
||||
begin
|
||||
{$IFDEF STANDALONE}
|
||||
if impname='' then
|
||||
exit;
|
||||
{$ENDIF}
|
||||
assign(f,impname);
|
||||
GetFAttr(f,attr);
|
||||
If DOSError=0 then
|
||||
erase(f);
|
||||
exec(arw_name,'rs '+impname+' '+path+dirsep+'*.swo');
|
||||
cleardir(path,'*.sw');
|
||||
cleardir(path,'*.swo');
|
||||
{$i-}
|
||||
RmDir(path);
|
||||
{$i+}
|
||||
if ioresult<>0 then;
|
||||
end;
|
||||
procedure makeasm(index:cardinal;name:pchar;isData:longbool);
|
||||
type
|
||||
tt=array[1..1]of pchar;
|
||||
pt=^tt;
|
||||
const
|
||||
fn_template:array[1..24]of pchar=(
|
||||
'.section .idata$2',
|
||||
'.rva .L4',
|
||||
'.long 0,0',
|
||||
'.rva ',
|
||||
'.rva .L5',
|
||||
'.section .idata$4',
|
||||
'.L4:',
|
||||
'.rva .L6',
|
||||
'.long 0',
|
||||
'.section .idata$5',
|
||||
'.L5:',
|
||||
'.text',
|
||||
'.globl ',
|
||||
':',
|
||||
'jmp *.L7',
|
||||
'.balign 4,144',
|
||||
'.section .idata$5',
|
||||
'.L7:',
|
||||
'.rva .L6',
|
||||
'.long 0',
|
||||
'.section .idata$6',
|
||||
'.L6:',
|
||||
'.short 0',
|
||||
'.ascii "\000"'
|
||||
);
|
||||
var_template:array[1..19]of pchar=(
|
||||
'.section .idata$2',
|
||||
'.rva .L7',
|
||||
'.long 0,0',
|
||||
'.rva ',
|
||||
'.rva .L8',
|
||||
'.section .idata$4',
|
||||
'.L7:',
|
||||
'.rva .L9',
|
||||
'.long 0',
|
||||
'.section .idata$5',
|
||||
'.L8:',
|
||||
'.globl ',
|
||||
':',
|
||||
'.rva .L9',
|
||||
'.long 0',
|
||||
'.section .idata$6',
|
||||
'.L9:',
|
||||
'.short 0',
|
||||
'.ascii "\000"'
|
||||
);
|
||||
__template:array[longbool]of pointer=(@fn_template,@var_template);
|
||||
common_part:array[1..5]of pchar=(
|
||||
'.balign 2,0',
|
||||
'.section .idata$7',
|
||||
'.globl ',
|
||||
':',
|
||||
'.ascii "\000"'
|
||||
);
|
||||
posit:array[longbool,1..4]of longint=((4,13,14,24),(4,12,13,19));
|
||||
var
|
||||
template:array[longbool]of pt absolute __template;
|
||||
f:text;
|
||||
s:string;
|
||||
i:longint;
|
||||
n:string;
|
||||
common_name,asmout:string;
|
||||
__d:dirstr;
|
||||
__n:namestr;
|
||||
__x:extstr;
|
||||
begin
|
||||
if not common_created then
|
||||
begin
|
||||
common_name:='_$'+_n+'@common';
|
||||
asmout:=path+dirsep+'0.sw';
|
||||
assign(f,asmout);
|
||||
rewrite(f);
|
||||
for i:=1 to 5 do
|
||||
begin
|
||||
s:=StrPas(Common_part[i]);
|
||||
case i of
|
||||
3:
|
||||
s:=s+common_name;
|
||||
4:
|
||||
s:=common_name+s;
|
||||
5:
|
||||
begin
|
||||
fsplit(lname,__d,__n,__x);
|
||||
insert(__n+__x,s,9);
|
||||
end;
|
||||
end;
|
||||
writeln(f,s);
|
||||
end;
|
||||
close(f);
|
||||
call_asw(asmout);
|
||||
common_created:=true;
|
||||
end;
|
||||
n:=strpas(name);
|
||||
str(succ(index):0,s);
|
||||
asmout:=path+dirsep+s+'.sw';
|
||||
assign(f,asmout);
|
||||
rewrite(f);
|
||||
for i:=1 to posit[isData,4]do
|
||||
begin
|
||||
s:=StrPas(template[isData]^[i]);
|
||||
if i=posit[isData,1]then
|
||||
s:=s+common_name
|
||||
else if i=posit[isData,2]then
|
||||
s:=s+n
|
||||
else if i=posit[isData,3]then
|
||||
s:=n+s
|
||||
else if i=posit[isData,4]then
|
||||
insert(n,s,9);
|
||||
writeln(f,s);
|
||||
end;
|
||||
close(f);
|
||||
call_asw(asmout);
|
||||
end;
|
||||
procedure ProcessEdata;
|
||||
type
|
||||
a8=array[0..7]of char;
|
||||
function GetSectionName(rva:cardinal;var Flags:cardinal):a8;
|
||||
var
|
||||
i:cardinal;
|
||||
LocObjOfs:cardinal;
|
||||
LocObj:TObjInfo;
|
||||
begin
|
||||
GetSectionName:='';
|
||||
Flags:=0;
|
||||
LocObjOfs:=APE_OptSize+PEoffset+24;
|
||||
for i:=1 to APE_obj do
|
||||
begin
|
||||
seek(f,LocObjOfs);
|
||||
blockread(f,LocObj,sizeof(LocObj));
|
||||
if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then
|
||||
begin
|
||||
GetSectionName:=a8(LocObj.ObjName);
|
||||
Flags:=LocObj.flags;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
var
|
||||
j:cardinal;
|
||||
ulongval:cardinal;
|
||||
j,Fl:cardinal;
|
||||
ulongval,procEntry:cardinal;
|
||||
Ordinal:word;
|
||||
isData:longbool;
|
||||
ExpDir:packed record
|
||||
flag,
|
||||
stamp:cardinal;
|
||||
@ -109,28 +364,53 @@ procedure ProcessEdata;
|
||||
begin
|
||||
seek(f,RawOffset+delta);
|
||||
blockread(f,ExpDir,sizeof(ExpDir));
|
||||
seek(f,RawOffset-VirtAddr+ExpDir.Name);
|
||||
blockread(f,cstring,sizeof(cstring));
|
||||
fsplit(impname,_d,_n,_e);
|
||||
path:=_d+_n+'.ils';
|
||||
{$IFDEF STANDALONE}
|
||||
if impname<>'' then
|
||||
{$ENDIF}
|
||||
CreateTempDir(path);
|
||||
Common_created:=false;
|
||||
for j:=0 to pred(ExpDir.NumNames)do
|
||||
begin
|
||||
seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2);
|
||||
blockread(f,Ordinal,2);
|
||||
seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+Cardinal(Ordinal*4));
|
||||
blockread(f,ProcEntry,4);
|
||||
seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
|
||||
blockread(f,ulongval,4);
|
||||
seek(f,RawOffset-VirtAddr+ulongval);
|
||||
blockread(f,cstring,sizeof(cstring));
|
||||
{$IFDEF STANDALONE}
|
||||
if not FileCreated then
|
||||
begin
|
||||
FileCreated:=true;
|
||||
rewrite(t);
|
||||
writeln(t,'EXPORTS');
|
||||
if(__textname<>'')or(impname='')then
|
||||
begin
|
||||
rewrite(t);
|
||||
writeln(t,'EXPORTS');
|
||||
end;
|
||||
end;
|
||||
{ do not use the implicit '_' }
|
||||
writeln(t,cstring,'=',cstring);
|
||||
{$ENDIF}
|
||||
isData:=GetSectionName(procentry,Fl)='';
|
||||
if not isData then
|
||||
isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
|
||||
{$IFDEF STANDALONE}
|
||||
if(__textname<>'')or(impname='')then
|
||||
writeln(t,cstring,' @',succ(ordinal):0,' ',kind[isData]);
|
||||
if impname<>''then
|
||||
{$ENDIF}
|
||||
makeasm(j,cstring,isData);
|
||||
end;
|
||||
call_arw;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
GetEdata:=false;
|
||||
{$IFDEF STANDALONE}
|
||||
FileCreated:=false;
|
||||
{$ENDIF}
|
||||
seek(f,PE+120);
|
||||
blockread(f,ExportRVA,4);
|
||||
seek(f,PE+6);
|
||||
@ -154,17 +434,33 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function makedef(const binname,textname:string):longbool;
|
||||
function makedef(const binname,
|
||||
{$IFDEF STANDALONE}
|
||||
textname,
|
||||
{$ENDIF}
|
||||
libname:string):longbool;
|
||||
var
|
||||
OldFileMode:longint;
|
||||
begin
|
||||
FileCreated:=false;
|
||||
assign(f,binname);
|
||||
{$IFDEF STANDALONE}
|
||||
FileCreated:=false;
|
||||
assign(t,textname);
|
||||
__textname:=textname;
|
||||
{$ENDIF}
|
||||
impname:=libname;
|
||||
lname:=binname;
|
||||
OldFileMode:=filemode;
|
||||
filemode:=0;
|
||||
reset(f,1);
|
||||
filemode:=OldFileMode;
|
||||
{$I-}
|
||||
filemode:=0;
|
||||
reset(f,1);
|
||||
filemode:=OldFileMode;
|
||||
{$I+}
|
||||
if IOResult<>0 then
|
||||
begin
|
||||
makedef:=false;
|
||||
exit;
|
||||
end;
|
||||
if not DOSstubOK(PEoffset)then
|
||||
makedef:=false
|
||||
else if not IsPE(PEoffset)then
|
||||
@ -172,15 +468,21 @@ begin
|
||||
else
|
||||
makedef:=GetEdata(PEoffset);
|
||||
close(f);
|
||||
{$IFDEF STANDALONE}
|
||||
if FileCreated then
|
||||
close(t);
|
||||
if(textname<>'')or(impname='')then
|
||||
close(t);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-11-20 13:58:19 pierre
|
||||
Revision 1.5 2001-01-13 00:09:21 peter
|
||||
* made Pavel O. happy ;)
|
||||
|
||||
Revision 1.4 2000/11/20 13:58:19 pierre
|
||||
* missing end. added
|
||||
|
||||
Revision 1.3 2000/09/24 15:06:17 peter
|
||||
|
||||
@ -828,107 +828,60 @@ const
|
||||
Message(scan_e_resourcefiles_not_supported);
|
||||
end;
|
||||
|
||||
{$ifndef PAVEL_LINKLIB}
|
||||
|
||||
procedure dir_linklib(t:tdirectivetoken);
|
||||
type
|
||||
tLinkMode=(lm_shared,lm_static);
|
||||
var
|
||||
s : string;
|
||||
quote : char;
|
||||
libname,
|
||||
linkmodestr : string;
|
||||
p : longint;
|
||||
linkMode : tLinkMode;
|
||||
begin
|
||||
current_scanner^.skipspace;
|
||||
{ This way spaces are also allowed in library names
|
||||
if quoted PM }
|
||||
if (c='''') or (c='"') then
|
||||
begin
|
||||
quote:=c;
|
||||
current_scanner^.readchar;
|
||||
s:=current_scanner^.readcomment;
|
||||
if pos(quote,s)>0 then
|
||||
s:=copy(s,1,pos(quote,s)-1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
current_scanner^.readstring;
|
||||
s:=orgpattern;
|
||||
if c='.' then
|
||||
begin
|
||||
s:=s+'.';
|
||||
current_scanner^.readchar;
|
||||
current_scanner^.readstring;
|
||||
s:=s+orgpattern;
|
||||
end;
|
||||
end;
|
||||
current_module.linkOtherSharedLibs.add(s,link_allways);
|
||||
end;
|
||||
{$else PAVEL_LINKLIB}
|
||||
procedure dir_linklib(t:tdirectivetoken);
|
||||
var
|
||||
s:string;
|
||||
libname,linkmodeStr:string;
|
||||
p:longint;
|
||||
type
|
||||
tLinkMode=(lm_dynamic,lm_static);
|
||||
var
|
||||
linkMode:tLinkMode;
|
||||
function ExtractLinkMode:tLinkMode;
|
||||
var
|
||||
p:longint;
|
||||
begin
|
||||
p:=pos(',',linkmodeStr);
|
||||
if p>0 then
|
||||
linkmodeStr:=copy(linkmodeStr,1,pred(p));
|
||||
for p:=1 to length(linkmodeStr)do
|
||||
linkmodeStr[p]:=upcase(linkmodeStr[p]);
|
||||
if linkmodeStr='STATIC' then
|
||||
ExtractLinkMode:=lm_static
|
||||
else
|
||||
ExtractLinkMode:=lm_dynamic
|
||||
end;
|
||||
procedure MangleLibName(mode:tLinkMode);
|
||||
begin
|
||||
if (libname[1]='''')and(libname[length(libname)]='''')then
|
||||
s:=current_scanner^.readcomment;
|
||||
p:=pos(',',s);
|
||||
if p=0 then
|
||||
begin
|
||||
delete(libname,1,1);
|
||||
delete(libname,length(libname),1);
|
||||
libname:=TrimSpace(s);
|
||||
linkmodeStr:='';
|
||||
end
|
||||
else
|
||||
begin
|
||||
libname:=target_os.libprefix+libname;
|
||||
case mode of
|
||||
lm_static:
|
||||
libname:=AddExtension(FixFileName(libname),target_os.staticlibext);
|
||||
lm_dynamic:
|
||||
libname:=AddExtension(FixFileName(libname),target_os.sharedlibext);
|
||||
end;
|
||||
libname:=TrimSpace(copy(s,1,p-1));
|
||||
linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
|
||||
end;
|
||||
end;
|
||||
begin
|
||||
current_scanner^.skipspace;
|
||||
s:=current_scanner^.readcomment;
|
||||
p:=pos(',',s);
|
||||
if p=0 then
|
||||
begin
|
||||
libname:=s;
|
||||
linkmodeStr:=''
|
||||
end
|
||||
else
|
||||
begin
|
||||
libname:=copy(s,1,pred(p));
|
||||
linkmodeStr:=copy(s,succ(p),255);
|
||||
end;
|
||||
if(libname='')or(libname='''''')then
|
||||
exit;
|
||||
linkMode:=ExtractLinkMode;
|
||||
MangleLibName(linkMode);
|
||||
if linkMode=lm_static then
|
||||
current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
|
||||
else
|
||||
current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
|
||||
if (libname='') or (libname='''''') or (libname='""') then
|
||||
exit;
|
||||
{ get linkmode, default is shared linking }
|
||||
if linkModeStr='STATIC' then
|
||||
linkmode:=lm_static
|
||||
else if (LinkModeStr='SHARED') or (LinkModeStr='') then
|
||||
linkmode:=lm_shared
|
||||
else
|
||||
begin
|
||||
Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
|
||||
exit;
|
||||
end;
|
||||
{ create library name }
|
||||
if libname[1] in ['''','"'] then
|
||||
begin
|
||||
quote:=libname[1];
|
||||
Delete(libname,1,1);
|
||||
p:=pos(quote,libname);
|
||||
if p>0 then
|
||||
Delete(libname,p,1);
|
||||
end;
|
||||
{ add to the list of libraries to link }
|
||||
if linkMode=lm_static then
|
||||
current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
|
||||
else
|
||||
current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
|
||||
end;
|
||||
|
||||
|
||||
{$endif PAVEL_LINKLIB}
|
||||
|
||||
|
||||
procedure dir_outputformat(t:tdirectivetoken);
|
||||
begin
|
||||
if not current_module.in_global then
|
||||
@ -1437,7 +1390,10 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2000-12-25 00:07:28 peter
|
||||
Revision 1.16 2001-01-13 00:09:21 peter
|
||||
* made Pavel O. happy ;)
|
||||
|
||||
Revision 1.15 2000/12/25 00:07:28 peter
|
||||
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
||||
tlinkedlist objects)
|
||||
|
||||
|
||||
@ -18,7 +18,6 @@
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit t_win32;
|
||||
@ -66,17 +65,14 @@ interface
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef PAVEL_LINKLIB}
|
||||
{$ifdef Delphi}
|
||||
dmisc,
|
||||
dmisc,
|
||||
{$else Delphi}
|
||||
dos,
|
||||
dos,
|
||||
{$endif Delphi}
|
||||
impdef,
|
||||
{$endif PAVEL_LINKLIB}
|
||||
cutils,cclasses,
|
||||
aasm,fmodule,globtype,globals,systems,verbose,
|
||||
script,gendef,
|
||||
script,gendef,impdef,
|
||||
cpubase,cpuasm
|
||||
{$ifdef GDB}
|
||||
,gdb
|
||||
@ -94,6 +90,34 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function FindDLL(const s:string):string;
|
||||
var
|
||||
sysdir : string;
|
||||
FoundDll : string;
|
||||
Found : boolean;
|
||||
begin
|
||||
Found:=false;
|
||||
{ Look for DLL in:
|
||||
1. Current dir
|
||||
2. Library Path
|
||||
3. windir,windir/system,windir/system32 }
|
||||
FoundDll:=FindFile(s,'.'+DirSep,found)+s;
|
||||
if (not found) then
|
||||
FoundDll:=includesearchpath.FindFile(s,found)+s;
|
||||
if (not found) then
|
||||
begin
|
||||
sysdir:=FixPath(GetEnv('windir'),false);
|
||||
FoundDll:=FindFile(s,sysdir+';'+sysdir+'system'+DirSep+';'+sysdir+'system32'+DirSep,found)+s;
|
||||
end;
|
||||
if (not found) then
|
||||
begin
|
||||
message1(exec_w_libfile_not_found,s);
|
||||
FoundDll:=s;
|
||||
end;
|
||||
FindDll:=FoundDll;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TIMPORTLIBWIN32
|
||||
*****************************************************************************}
|
||||
@ -648,17 +672,67 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifndef PAVEL_LINKLIB}
|
||||
|
||||
|
||||
Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
|
||||
|
||||
function do_makedef(const DllName,LibName:string):boolean;
|
||||
var
|
||||
CmdLine : string;
|
||||
begin
|
||||
if (not do_build) and
|
||||
FileExists(LibName) then
|
||||
begin
|
||||
if GetNamedFileTime(LibName)>GetNamedFileTime(DllName) then
|
||||
begin
|
||||
do_makedef:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
asw_name:=FindUtil('asw');
|
||||
arw_name:=FindUtil('arw');
|
||||
if cs_link_extern in aktglobalswitches then
|
||||
begin
|
||||
CmdLine:='-l '+LibName+' -i '+DLLName;
|
||||
if asw_name<>'' then
|
||||
CmdLine:=CmdLine+' -a '+asw_name;
|
||||
if arw_name<>'' then
|
||||
CmdLine:=CmdLine+' -r '+arw_name;
|
||||
do_makedef:=DoExec(FindUtil('fpimpdef'),CmdLine,false,false);
|
||||
end
|
||||
else
|
||||
do_makedef:=makedef(DLLName,LIbName);
|
||||
end;
|
||||
|
||||
Var
|
||||
linkres : TLinkRes;
|
||||
i : longint;
|
||||
HPath : TStringListItem;
|
||||
s,s2 : string;
|
||||
found,linklibc : boolean;
|
||||
s,s2 : string;
|
||||
found,
|
||||
linklibc : boolean;
|
||||
begin
|
||||
WriteResponseFile:=False;
|
||||
|
||||
{ Create static import libraries for DLL that are
|
||||
included using the $linklib directive }
|
||||
While not SharedLibFiles.Empty do
|
||||
begin
|
||||
s:=SharedLibFiles.GetFirst;
|
||||
s2:=AddExtension(s,target_os.sharedlibext);
|
||||
s:=target_os.libprefix+SplitName(s)+target_os.staticlibext;
|
||||
if Do_makedef(FindDLL(s2),s) then
|
||||
begin
|
||||
if s<>''then
|
||||
StaticLibFiles.insert(s);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Message(exec_w_error_while_linking);
|
||||
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Open link.res file }
|
||||
LinkRes.Init(outputexedir+Info.ResName);
|
||||
|
||||
@ -750,183 +824,6 @@ begin
|
||||
|
||||
WriteResponseFile:=True;
|
||||
end;
|
||||
{$else PAVEL_LINKLIB}
|
||||
Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
|
||||
Var
|
||||
linkres : TLinkRes;
|
||||
HPath : PStringQueueItem;
|
||||
s,s2 : string;
|
||||
success : boolean;
|
||||
function ExpandName(const s:string):string;
|
||||
var
|
||||
sysdir:string;
|
||||
procedure GetSysDir;
|
||||
begin
|
||||
sysdir:=GetEnv('windir');
|
||||
if sysdir<>''then
|
||||
begin
|
||||
if not(sysdir[length(sysdir)]in['\','/'])then
|
||||
sysdir:=sysdir+dirsep;
|
||||
end;
|
||||
end;
|
||||
function IsFile(d:string;var PathToDll:string):longbool;
|
||||
var
|
||||
f:file;
|
||||
attr:word;
|
||||
begin
|
||||
PathToDll:='';
|
||||
if d<>''then
|
||||
if d[length(d)]<>dirsep then
|
||||
d:=d+dirsep;
|
||||
d:=d+s;
|
||||
assign(f,d);
|
||||
GetFattr(f,Attr);
|
||||
if DOSerror<>0 then
|
||||
IsFile:=false
|
||||
else
|
||||
begin
|
||||
if(attr and directory)=0 then
|
||||
begin
|
||||
IsFile:=true;
|
||||
PathToDll:=GetShortName(d);
|
||||
end
|
||||
else
|
||||
IsFile:=false;
|
||||
end;
|
||||
end;
|
||||
var
|
||||
PathToDll:string;
|
||||
begin
|
||||
if not isFile('',PathToDll)then
|
||||
begin
|
||||
HPath:=LibrarySearchPath.First;
|
||||
while assigned(HPath) do
|
||||
begin
|
||||
if isFile(GetShortName(HPath^.Data^),PathToDll)then
|
||||
break;
|
||||
HPath:=HPath^.Next;
|
||||
end;
|
||||
if PathToDll='' then
|
||||
begin
|
||||
GetSysDir;
|
||||
if not isFile(sysdir,PathToDll)then
|
||||
if not isFile(sysdir+'system32',PathToDll)then
|
||||
if not isFile(sysdir+'system',PathToDll)then
|
||||
begin
|
||||
message1(exec_w_libfile_not_found,S2);
|
||||
PathToDll:=S2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
ExpandName:=PathToDll;
|
||||
end;
|
||||
function DotPos(const s:string):longint;
|
||||
var
|
||||
i:longint;
|
||||
begin
|
||||
DotPos:=0;
|
||||
for i:=length(s)downto 1 do
|
||||
begin
|
||||
if s[i]in['/','\',':']then
|
||||
exit
|
||||
else if s[i]='.'then
|
||||
begin
|
||||
DotPos:=i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procedure strip(var s:string);
|
||||
var
|
||||
d:dirstr;
|
||||
n:namestr;
|
||||
e:extstr;
|
||||
begin
|
||||
fsplit(s,d,n,e);
|
||||
s:=n;
|
||||
end;
|
||||
function do_makedef(const s:string):longbool;
|
||||
begin
|
||||
if cs_link_extern in aktglobalswitches then
|
||||
do_makedef:=DoExec(FindUtil('fpimpdef'),'-o deffile.$$$ -i '+s,false,false)
|
||||
else
|
||||
do_makedef:=makedef(s,'deffile.$$$');
|
||||
end;
|
||||
begin
|
||||
WriteResponseFile:=False;
|
||||
While not SharedLibFiles.Empty do
|
||||
begin
|
||||
S:=SharedLibFiles.Get;
|
||||
if DotPos(s)=0 then
|
||||
s2:=s+target_os.sharedlibext
|
||||
else
|
||||
s2:=s;
|
||||
strip(s);
|
||||
if not do_makedef(ExpandName(s2))then
|
||||
begin
|
||||
Message(exec_w_error_while_linking);
|
||||
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
|
||||
end
|
||||
else
|
||||
begin
|
||||
s:=target_os.libprefix+s+target_os.staticlibext;
|
||||
success:=DoExec(FindUtil('dlltool'),'-l '+s+' -D '+s2+' -d deffile.$$$',false,false);
|
||||
ObjectFiles.insert(s);
|
||||
if not success then
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Open link.res file }
|
||||
LinkRes.Init(outputexedir+Info.ResName);
|
||||
|
||||
{ Write path to search libraries }
|
||||
HPath:=current_module.locallibrarysearchpath.First;
|
||||
while assigned(HPath) do
|
||||
begin
|
||||
LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
|
||||
HPath:=HPath^.Next;
|
||||
end;
|
||||
HPath:=LibrarySearchPath.First;
|
||||
while assigned(HPath) do
|
||||
begin
|
||||
LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
|
||||
HPath:=HPath^.Next;
|
||||
end;
|
||||
|
||||
{ add objectfiles, start with prt0 always }
|
||||
LinkRes.Add('INPUT(');
|
||||
if isdll then
|
||||
LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0')))
|
||||
else
|
||||
LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0')));
|
||||
while not ObjectFiles.Empty do
|
||||
begin
|
||||
s:=ObjectFiles.Get;
|
||||
if s<>'' then
|
||||
LinkRes.AddFileName(GetShortName(s));
|
||||
end;
|
||||
LinkRes.Add(')');
|
||||
|
||||
{ Write staticlibraries }
|
||||
if not StaticLibFiles.Empty then
|
||||
begin
|
||||
LinkRes.Add('GROUP(');
|
||||
While not StaticLibFiles.Empty do
|
||||
begin
|
||||
S:=StaticLibFiles.Get;
|
||||
LinkRes.AddFileName(GetShortName(s));
|
||||
end;
|
||||
LinkRes.Add(')');
|
||||
end;
|
||||
|
||||
{ Write and Close response }
|
||||
linkres.writetodisk;
|
||||
linkres.done;
|
||||
|
||||
WriteResponseFile:=True;
|
||||
end;
|
||||
{$endif PAVEL_LINKLIB}
|
||||
|
||||
|
||||
function TLinkerWin32.MakeExecutable:boolean;
|
||||
@ -1297,7 +1194,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2000-12-30 22:53:25 peter
|
||||
Revision 1.9 2001-01-13 00:09:22 peter
|
||||
* made Pavel O. happy ;)
|
||||
|
||||
Revision 1.8 2000/12/30 22:53:25 peter
|
||||
* export with the case provided in the exports section
|
||||
|
||||
Revision 1.7 2000/12/25 00:07:30 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user