2
0

import.pas 7.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Peter Vreman
  4. This unit implements an uniform import object
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************}
  17. unit import;
  18. {$i defines.inc}
  19. interface
  20. uses
  21. cutils,cclasses;
  22. type
  23. timported_item = class(tlinkedlistitem)
  24. ordnr : word;
  25. name,
  26. func : pstring;
  27. lab : pointer; { should be plabel, but this gaves problems with circular units }
  28. is_var : boolean;
  29. constructor Create(const n,s : string;o : word);
  30. constructor Create_var(const n,s : string);
  31. destructor Destroy;override;
  32. end;
  33. timportlist = class(tlinkedlistitem)
  34. dllname : pstring;
  35. imported_items : tlinkedlist;
  36. constructor Create(const n : string);
  37. destructor Destroy;Override;
  38. end;
  39. timportlib=class
  40. private
  41. notsupmsg : boolean;
  42. procedure NotSupported;
  43. public
  44. constructor Create;
  45. destructor Destroy;override;
  46. procedure preparelib(const s:string);virtual;
  47. procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
  48. procedure importvariable(const varname,module:string;const name:string);virtual;
  49. procedure generatelib;virtual;
  50. procedure generatesmartlib;virtual;
  51. end;
  52. TDLLScanner=class
  53. public
  54. f:file;
  55. impname:string;
  56. TheWord:array[0..1]of char;
  57. HeaderOffset:cardinal;
  58. loaded:integer;
  59. function isSuitableFileType(x:cardinal):longbool;virtual;abstract;
  60. function GetEdata(HeaderEntry:cardinal):longbool;virtual;abstract;
  61. function Scan(const binname:string):longbool;virtual;abstract;
  62. end;
  63. var
  64. importlib : timportlib;
  65. procedure InitImport;
  66. procedure DoneImport;
  67. implementation
  68. uses
  69. systems,verbose,globals
  70. {$ifdef i386}
  71. {$ifndef NOTARGETLINUX}
  72. ,t_linux
  73. {$endif}
  74. {$ifndef NOTARGETFREEBSD}
  75. ,t_fbsd
  76. {$endif}
  77. {$ifndef NOTARGETSUNOS}
  78. ,t_sunos
  79. {$endif}
  80. {$ifndef NOTARGETOS2}
  81. ,t_os2
  82. {$endif}
  83. {$ifndef NOTARGETWIN32}
  84. ,t_win32
  85. {$endif}
  86. {$ifndef NOTARGETNETWARE}
  87. ,t_nwm
  88. {$endif}
  89. {$ifndef NOTARGETGO32V2}
  90. ,t_go32v2
  91. {$endif}
  92. {$endif}
  93. {$ifdef m68k}
  94. {$ifndef NOTARGETLINUX}
  95. ,t_linux
  96. {$endif}
  97. {$endif}
  98. {$ifdef powerpc}
  99. {$ifndef NOTARGETLINUX}
  100. ,t_linux
  101. {$endif}
  102. {$endif}
  103. {$ifdef alpha}
  104. {$ifndef NOTARGETLINUX}
  105. ,t_linux
  106. {$endif}
  107. {$endif}
  108. ;
  109. {****************************************************************************
  110. Timported_item
  111. ****************************************************************************}
  112. constructor timported_item.Create(const n,s : string;o : word);
  113. begin
  114. inherited Create;
  115. func:=stringdup(n);
  116. name:=stringdup(s);
  117. ordnr:=o;
  118. lab:=nil;
  119. is_var:=false;
  120. end;
  121. constructor timported_item.create_var(const n,s : string);
  122. begin
  123. inherited Create;
  124. func:=stringdup(n);
  125. name:=stringdup(s);
  126. ordnr:=0;
  127. lab:=nil;
  128. is_var:=true;
  129. end;
  130. destructor timported_item.destroy;
  131. begin
  132. stringdispose(name);
  133. stringdispose(func);
  134. inherited destroy;
  135. end;
  136. {****************************************************************************
  137. TImportlist
  138. ****************************************************************************}
  139. constructor timportlist.Create(const n : string);
  140. begin
  141. inherited Create;
  142. dllname:=stringdup(n);
  143. imported_items:=Tlinkedlist.Create;
  144. end;
  145. destructor timportlist.destroy;
  146. begin
  147. imported_items.free;
  148. stringdispose(dllname);
  149. end;
  150. {****************************************************************************
  151. TImportLib
  152. ****************************************************************************}
  153. constructor timportlib.Create;
  154. begin
  155. notsupmsg:=false;
  156. end;
  157. destructor timportlib.Destroy;
  158. begin
  159. end;
  160. procedure timportlib.NotSupported;
  161. begin
  162. { show the message only once }
  163. if not notsupmsg then
  164. begin
  165. Message(exec_e_dll_not_supported);
  166. notsupmsg:=true;
  167. end;
  168. end;
  169. procedure timportlib.preparelib(const s:string);
  170. begin
  171. NotSupported;
  172. end;
  173. procedure timportlib.importprocedure(const func,module:string;index:longint;const name:string);
  174. begin
  175. NotSupported;
  176. end;
  177. procedure timportlib.importvariable(const varname,module:string;const name:string);
  178. begin
  179. NotSupported;
  180. end;
  181. procedure timportlib.generatelib;
  182. begin
  183. NotSupported;
  184. end;
  185. procedure timportlib.generatesmartlib;
  186. begin
  187. NotSupported;
  188. end;
  189. procedure DoneImport;
  190. begin
  191. if assigned(importlib) then
  192. importlib.free;
  193. end;
  194. procedure InitImport;
  195. begin
  196. case target_info.target of
  197. {$ifdef i386}
  198. {$ifndef NOTARGETLINUX}
  199. target_i386_Linux :
  200. importlib:=Timportliblinux.Create;
  201. {$endif}
  202. {$ifndef NOTARGETFREEBSD}
  203. target_i386_freebsd:
  204. importlib:=Timportlibfreebsd.Create;
  205. {$endif}
  206. {$ifndef NOTARGETSUNOS}
  207. target_i386_sunos:
  208. importlib:=Timportlibsunos.Create;
  209. {$endif}
  210. {$ifndef NOTARGETWIN32}
  211. target_i386_Win32 :
  212. importlib:=Timportlibwin32.Create;
  213. {$endif}
  214. {$ifndef NOTARGETOS2}
  215. target_i386_OS2 :
  216. importlib:=Timportlibos2.Create;
  217. {$endif}
  218. {$ifndef NOTARGETNETWARE}
  219. target_i386_netware :
  220. importlib:=Timportlibnetware.Create;
  221. {$endif}
  222. {$endif i386}
  223. {$ifdef m68k}
  224. target_m68k_Linux :
  225. importlib:=Timportliblinux.Create;
  226. {$endif m68k}
  227. {$ifdef alpha}
  228. target_alpha_Linux :
  229. importlib:=Timportliblinux.Create;
  230. {$endif alpha}
  231. {$ifdef powerpc}
  232. target_alpha_Linux :
  233. importlib:=Timportliblinux.Create;
  234. {$endif powerpc}
  235. else
  236. importlib:=Timportlib.Create;
  237. end;
  238. end;
  239. end.
  240. {
  241. $Log$
  242. Revision 1.11 2001-03-06 18:28:02 peter
  243. * patch from Pavel with a new and much faster DLL Scanner for
  244. automatic importing so $linklib works for DLLs. Thanks Pavel!
  245. Revision 1.10 2001/02/26 19:44:52 peter
  246. * merged generic m68k updates from fixes branch
  247. Revision 1.9 2001/02/03 00:09:02 peter
  248. * fixed netware typo in previous commit
  249. Revision 1.8 2001/02/02 22:43:39 peter
  250. * add notarget defines
  251. Revision 1.7 2000/12/25 00:07:26 peter
  252. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  253. tlinkedlist objects)
  254. Revision 1.6 2000/09/24 15:06:18 peter
  255. * use defines.inc
  256. Revision 1.5 2000/09/16 12:22:52 peter
  257. * freebsd support merged
  258. Revision 1.4 2000/09/11 17:00:23 florian
  259. + first implementation of Netware Module support, thanks to
  260. Armin Diehl ([email protected]) for providing the patches
  261. Revision 1.3 2000/08/27 16:11:51 peter
  262. * moved some util functions from globals,cobjects to cutils
  263. * splitted files into finput,fmodule
  264. Revision 1.2 2000/07/13 11:32:43 michael
  265. + removed logs
  266. }