mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 22:11:12 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			328 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			328 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     Copyright (c) 1998-2000 by Peter Vreman
 | |
| 
 | |
|     This unit implements an uniform import object
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or modify
 | |
|     it under the terms of the GNU General Public License as published by
 | |
|     the Free Software Foundation; either version 2 of the License, or
 | |
|     (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     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 import;
 | |
| 
 | |
| {$i defines.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
| uses
 | |
|   cutils,cclasses;
 | |
| 
 | |
| type
 | |
|    timported_item = class(tlinkedlistitem)
 | |
|       ordnr  : word;
 | |
|       name,
 | |
|       func   : pstring;
 | |
|       lab    : pointer; { should be plabel, but this gaves problems with circular units }
 | |
|       is_var : boolean;
 | |
|       constructor Create(const n,s : string;o : word);
 | |
|       constructor Create_var(const n,s : string);
 | |
|       destructor Destroy;override;
 | |
|    end;
 | |
| 
 | |
|    timportlist = class(tlinkedlistitem)
 | |
|       dllname : pstring;
 | |
|       imported_items : tlinkedlist;
 | |
|       constructor Create(const n : string);
 | |
|       destructor Destroy;Override;
 | |
|    end;
 | |
| 
 | |
|    timportlib=class
 | |
|    private
 | |
|       notsupmsg : boolean;
 | |
|       procedure NotSupported;
 | |
|    public
 | |
|       constructor Create;
 | |
|       destructor Destroy;override;
 | |
|       procedure preparelib(const s:string);virtual;
 | |
|       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
 | |
|       procedure importvariable(const varname,module:string;const name:string);virtual;
 | |
|       procedure generatelib;virtual;
 | |
|       procedure generatesmartlib;virtual;
 | |
|    end;
 | |
| 
 | |
|    TDLLScanner=class
 | |
|    public
 | |
|      f:file;
 | |
|      impname:string;
 | |
|      TheWord:array[0..1]of char;
 | |
|      HeaderOffset:cardinal;
 | |
|      loaded:integer;
 | |
|      function isSuitableFileType(x:cardinal):longbool;virtual;abstract;
 | |
|      function GetEdata(HeaderEntry:cardinal):longbool;virtual;abstract;
 | |
|      function Scan(const binname:string):longbool;virtual;abstract;
 | |
|    end;
 | |
| 
 | |
| 
 | |
| var
 | |
|   importlib : timportlib;
 | |
| 
 | |
| procedure InitImport;
 | |
| procedure DoneImport;
 | |
| 
 | |
| implementation
 | |
| 
 | |
| uses
 | |
|   systems,verbose,globals
 | |
| {$ifdef i386}
 | |
|   {$ifndef NOTARGETLINUX}
 | |
|     ,t_linux
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETFREEBSD}
 | |
|    ,t_fbsd
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETSUNOS}
 | |
|    ,t_sunos
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETOS2}
 | |
|     ,t_os2
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETWIN32}
 | |
|     ,t_win32
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETNETWARE}
 | |
|     ,t_nwm
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETGO32V2}
 | |
|     ,t_go32v2
 | |
|   {$endif}
 | |
| {$endif}
 | |
| {$ifdef m68k}
 | |
|   {$ifndef NOTARGETLINUX}
 | |
|     ,t_linux
 | |
|   {$endif}
 | |
| {$endif}
 | |
| {$ifdef powerpc}
 | |
|   {$ifndef NOTARGETLINUX}
 | |
|     ,t_linux
 | |
|   {$endif}
 | |
| {$endif}
 | |
| {$ifdef alpha}
 | |
|   {$ifndef NOTARGETLINUX}
 | |
|     ,t_linux
 | |
|   {$endif}
 | |
| {$endif}
 | |
|   ;
 | |
| 
 | |
| {****************************************************************************
 | |
|                            Timported_item
 | |
| ****************************************************************************}
 | |
| 
 | |
| constructor timported_item.Create(const n,s : string;o : word);
 | |
| begin
 | |
|   inherited Create;
 | |
|   func:=stringdup(n);
 | |
|   name:=stringdup(s);
 | |
|   ordnr:=o;
 | |
|   lab:=nil;
 | |
|   is_var:=false;
 | |
| end;
 | |
| 
 | |
| 
 | |
| constructor timported_item.create_var(const n,s : string);
 | |
| begin
 | |
|   inherited Create;
 | |
|   func:=stringdup(n);
 | |
|   name:=stringdup(s);
 | |
|   ordnr:=0;
 | |
|   lab:=nil;
 | |
|   is_var:=true;
 | |
| end;
 | |
| 
 | |
| 
 | |
| destructor timported_item.destroy;
 | |
| begin
 | |
|   stringdispose(name);
 | |
|   stringdispose(func);
 | |
|   inherited destroy;
 | |
| end;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                               TImportlist
 | |
| ****************************************************************************}
 | |
| 
 | |
| constructor timportlist.Create(const n : string);
 | |
| begin
 | |
|   inherited Create;
 | |
|   dllname:=stringdup(n);
 | |
|   imported_items:=Tlinkedlist.Create;
 | |
| end;
 | |
| 
 | |
| 
 | |
| destructor timportlist.destroy;
 | |
| begin
 | |
|   imported_items.free;
 | |
|   stringdispose(dllname);
 | |
| end;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                               TImportLib
 | |
| ****************************************************************************}
 | |
| 
 | |
| constructor timportlib.Create;
 | |
| begin
 | |
|   notsupmsg:=false;
 | |
| end;
 | |
| 
 | |
| 
 | |
| destructor timportlib.Destroy;
 | |
| begin
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.NotSupported;
 | |
| begin
 | |
|   { show the message only once }
 | |
|   if not notsupmsg then
 | |
|    begin
 | |
|      Message(exec_e_dll_not_supported);
 | |
|      notsupmsg:=true;
 | |
|    end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.preparelib(const s:string);
 | |
| begin
 | |
|   NotSupported;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.importprocedure(const func,module:string;index:longint;const name:string);
 | |
| begin
 | |
|   NotSupported;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.importvariable(const varname,module:string;const name:string);
 | |
| begin
 | |
|   NotSupported;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.generatelib;
 | |
| begin
 | |
|   NotSupported;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure timportlib.generatesmartlib;
 | |
| begin
 | |
|   NotSupported;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure DoneImport;
 | |
| begin
 | |
|   if assigned(importlib) then
 | |
|     importlib.free;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure InitImport;
 | |
| begin
 | |
|   case target_info.target of
 | |
| {$ifdef i386}
 | |
|   {$ifndef NOTARGETLINUX}
 | |
|     target_i386_Linux :
 | |
|       importlib:=Timportliblinux.Create;
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETFREEBSD}
 | |
|     target_i386_freebsd:
 | |
|       importlib:=Timportlibfreebsd.Create;
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETSUNOS}
 | |
|     target_i386_sunos:
 | |
|       importlib:=Timportlibsunos.Create;
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETWIN32}
 | |
|     target_i386_Win32 :
 | |
|       importlib:=Timportlibwin32.Create;
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETOS2}
 | |
|     target_i386_OS2 :
 | |
|       importlib:=Timportlibos2.Create;
 | |
|   {$endif}
 | |
|   {$ifndef NOTARGETNETWARE}
 | |
|     target_i386_netware :
 | |
|       importlib:=Timportlibnetware.Create;
 | |
|   {$endif}
 | |
| {$endif i386}
 | |
| {$ifdef m68k}
 | |
|     target_m68k_Linux :
 | |
|       importlib:=Timportliblinux.Create;
 | |
| {$endif m68k}
 | |
| {$ifdef alpha}
 | |
|     target_alpha_Linux :
 | |
|       importlib:=Timportliblinux.Create;
 | |
| {$endif alpha}
 | |
| {$ifdef powerpc}
 | |
|     target_alpha_Linux :
 | |
|       importlib:=Timportliblinux.Create;
 | |
| {$endif powerpc}
 | |
|     else
 | |
|       importlib:=Timportlib.Create;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| end.
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.11  2001-03-06 18:28:02  peter
 | |
|     * patch from Pavel with a new and much faster DLL Scanner for
 | |
|       automatic importing so $linklib works for DLLs. Thanks Pavel!
 | |
| 
 | |
|   Revision 1.10  2001/02/26 19:44:52  peter
 | |
|     * merged generic m68k updates from fixes branch
 | |
| 
 | |
|   Revision 1.9  2001/02/03 00:09:02  peter
 | |
|     * fixed netware typo in previous commit
 | |
| 
 | |
|   Revision 1.8  2001/02/02 22:43:39  peter
 | |
|     * add notarget defines
 | |
| 
 | |
|   Revision 1.7  2000/12/25 00:07:26  peter
 | |
|     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
 | |
|       tlinkedlist objects)
 | |
| 
 | |
|   Revision 1.6  2000/09/24 15:06:18  peter
 | |
|     * use defines.inc
 | |
| 
 | |
|   Revision 1.5  2000/09/16 12:22:52  peter
 | |
|     * freebsd support merged
 | |
| 
 | |
|   Revision 1.4  2000/09/11 17:00:23  florian
 | |
|     + first implementation of Netware Module support, thanks to
 | |
|       Armin Diehl (diehl@nordrhein.de) for providing the patches
 | |
| 
 | |
|   Revision 1.3  2000/08/27 16:11:51  peter
 | |
|     * moved some util functions from globals,cobjects to cutils
 | |
|     * splitted files into finput,fmodule
 | |
| 
 | |
|   Revision 1.2  2000/07/13 11:32:43  michael
 | |
|   + removed logs
 | |
| 
 | |
| }
 | 
