comprsrc.pas 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Handles the resource files handling
  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. }
  18. unit comprsrc;
  19. {$i fpcdefs.inc}
  20. interface
  21. type
  22. presourcefile=^tresourcefile;
  23. tresourcefile=object
  24. private
  25. fname : string;
  26. public
  27. constructor Init(const fn:string);
  28. destructor Done;
  29. procedure Compile;virtual;
  30. end;
  31. procedure CompileResourceFiles;
  32. implementation
  33. uses
  34. {$ifdef Delphi}
  35. dmisc,
  36. {$else Delphi}
  37. dos,
  38. {$endif Delphi}
  39. Systems,cutils,Globtype,Globals,Verbose,Fmodule,
  40. Script;
  41. {****************************************************************************
  42. TRESOURCEFILE
  43. ****************************************************************************}
  44. constructor tresourcefile.init(const fn:string);
  45. begin
  46. fname:=fn;
  47. end;
  48. destructor tresourcefile.done;
  49. begin
  50. end;
  51. procedure tresourcefile.compile;
  52. var
  53. respath,
  54. srcfilepath : dirstr;
  55. n : namestr;
  56. e : extstr;
  57. s,
  58. resobj,
  59. resbin : string;
  60. resfound,
  61. objused : boolean;
  62. begin
  63. resbin:='';
  64. resfound:=false;
  65. if utilsdirectory<>'' then
  66. resfound:=FindFile(target_res.resbin+source_info.exeext,utilsdirectory,resbin);
  67. if not resfound then
  68. resfound:=FindExe(target_res.resbin,resbin);
  69. { get also the path to be searched for the windres.h }
  70. fsplit(resbin,respath,n,e);
  71. if (not resfound) and not(cs_link_extern in aktglobalswitches) then
  72. begin
  73. Message(exec_e_res_not_found);
  74. aktglobalswitches:=aktglobalswitches+[cs_link_extern];
  75. end;
  76. fsplit(current_module.mainsource^,srcfilepath,n,e);
  77. if not path_absolute(fname) then
  78. fname:=srcfilepath+fname;
  79. resobj:=ForceExtension(fname,target_info.resobjext);
  80. s:=target_res.rescmd;
  81. ObjUsed:=(pos('$OBJ',s)>0);
  82. Replace(s,'$OBJ',resobj);
  83. Replace(s,'$RES',fname);
  84. Replace(s,'$INC',respath);
  85. if (target_info.system = system_i386_win32) and
  86. (srcfilepath<>'') then
  87. s:=s+' --include '+srcfilepath;
  88. { Exec the command }
  89. if not (cs_link_extern in aktglobalswitches) then
  90. begin
  91. Message1(exec_i_compilingresource,fname);
  92. swapvectors;
  93. exec(resbin,s);
  94. swapvectors;
  95. if (doserror<>0) then
  96. begin
  97. Message(exec_e_cant_call_linker);
  98. aktglobalswitches:=aktglobalswitches+[cs_link_extern];
  99. end
  100. else
  101. if (dosexitcode<>0) then
  102. begin
  103. Message(exec_e_error_while_linking);
  104. aktglobalswitches:=aktglobalswitches+[cs_link_extern];
  105. end;
  106. end;
  107. { Update asmres when externmode is set }
  108. if cs_link_extern in aktglobalswitches then
  109. AsmRes.AddLinkCommand(resbin,s,'');
  110. if ObjUsed then
  111. current_module.linkotherofiles.add(resobj,link_allways);
  112. end;
  113. procedure CompileResourceFiles;
  114. var
  115. hr : presourcefile;
  116. begin
  117. { OS/2 (EMX) must be processed elsewhere (in the linking/binding stage). }
  118. if not (target_info.system in [system_i386_os2,system_i386_emx]) then
  119. While not current_module.ResourceFiles.Empty do
  120. begin
  121. case target_info.system of
  122. system_m68k_palmos,
  123. system_i386_win32,
  124. system_i386_wdosx :
  125. hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst));
  126. else
  127. Message(scan_e_resourcefiles_not_supported);
  128. end;
  129. hr^.compile;
  130. dispose(hr,done);
  131. end;
  132. end;
  133. end.
  134. {
  135. $Log$
  136. Revision 1.19 2003-10-08 17:54:23 florian
  137. * fixed resource compiler search if no utilty directory was given
  138. Revision 1.18 2003/03/23 23:20:38 hajny
  139. + emx target added
  140. Revision 1.17 2003/01/30 21:45:40 peter
  141. * path fix (merged)
  142. Revision 1.16 2003/01/12 15:42:23 peter
  143. * m68k pathexist update from 1.0.x
  144. * palmos res update from 1.0.x
  145. Revision 1.15 2002/07/26 21:15:37 florian
  146. * rewrote the system handling
  147. Revision 1.14 2002/05/18 13:34:06 peter
  148. * readded missing revisions
  149. Revision 1.13 2002/05/16 19:46:35 carl
  150. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  151. + try to fix temp allocation (still in ifdef)
  152. + generic constructor calls
  153. + start of tassembler / tmodulebase class cleanup
  154. Revision 1.11 2002/04/04 18:32:37 carl
  155. + added wdosx support (patch from Pavel)
  156. }