fpcjres.pas 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279
  1. {
  2. FPCRes - Free Pascal Resource Converter
  3. Part of the Free Pascal distribution
  4. Copyright (C) 2008 by Giulio Bernardi
  5. Copyright (C) 2011 by Jonas Maebe
  6. See the file COPYING, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. }
  12. {
  13. Java's internal resource file handling system is based on simply loading
  14. files from withing the package name space. We reserve the namespace
  15. org.freepascal.rawresources for this purpose.
  16. This program creates a jar file (= zip file) containing all specified files.
  17. }
  18. program fpcjres;
  19. {$MODE OBJFPC} {$H+}
  20. uses
  21. SysUtils, Classes, paramparser, msghandler, jarsourcehandler,
  22. zipper
  23. ;
  24. const
  25. halt_no_err = 0;
  26. halt_param_err = 1;
  27. halt_read_err = 2;
  28. halt_write_err = 3;
  29. progname = 'fpcjres';
  30. progversion = '1.0'; //to distinguish from the old fpcres
  31. fpcversion = {$INCLUDE %FPCVERSION%};
  32. host_arch = {$INCLUDE %FPCTARGETCPU%};
  33. host_os = {$INCLUDE %FPCTARGETOS%};
  34. build_date = {$INCLUDE %DATE%};
  35. var
  36. params : TParameters = nil;
  37. resources : TZipper = nil;
  38. sourcefiles : TJarSourceFiles = nil;
  39. procedure ShowVersion;
  40. begin
  41. writeln(progname+' - resource file converter, version '+progversion+' ['+build_date+'], FPC '+fpcversion);
  42. writeln('Host platform: '+host_os+' - '+host_arch);
  43. writeln('Copyright (c) 2008 by Giulio Bernardi.');
  44. writeln('Copyright (c) 2011 by Jonas Maebe.');
  45. end;
  46. procedure ShowHelp;
  47. begin
  48. ShowVersion;
  49. writeln('Syntax: '+progname+' [options] <inputfile> [<inputfile>...] [-o <outputfile>]');
  50. writeln;
  51. writeln('Options:');
  52. writeln(' --help, -h, -? Show this screen.');
  53. writeln(' --version, -V Show program version.');
  54. writeln(' --verbose, -v Be verbose.');
  55. writeln(' --input, -i <x> Ignored for compatibility.');
  56. writeln(' --output, -o <x> Set the output file name.');
  57. writeln(' @<file> Read more options from file <file>');
  58. end;
  59. const
  60. SOutputFileAlreadySet = 'Output file name already set.';
  61. SUnknownParameter = 'Unknown parameter ''%s''';
  62. SArgumentMissing = 'Argument missing for option ''%s''';
  63. SUnknownObjFormat = 'Unknown file format ''%s''';
  64. SUnknownMachine = 'Unknown architecture ''%s''';
  65. SFormatArchMismatch = 'Architecture %s is not available for %s format';
  66. SNoInputFiles = 'No input files';
  67. SNoOutputFile = 'No output file name specified';
  68. SCannotReadConfFile ='Can''t read config file ''%s''';
  69. SCantOpenFile = 'Can''t open file ''%s''';
  70. SUnknownInputFormat = 'No known file format detected for file ''%s''';
  71. SCantCreateDirHier = 'Can''t create directory hierarchy ''%s''';
  72. SCantCreateFile = 'Can''t create file ''%s''';
  73. function GetCurrentTimeMsec : longint;
  74. var h,m,s,ms : word;
  75. begin
  76. DecodeTime(Time,h,m,s,ms);
  77. Result:=h*3600*1000 + m*60*1000 + s*1000 + ms;
  78. end;
  79. procedure CheckInputFiles;
  80. begin
  81. if params.InputFiles.Count=0 then
  82. begin
  83. Messages.DoError(SNoInputFiles);
  84. halt(halt_param_err);
  85. end;
  86. end;
  87. procedure CheckOutputFile;
  88. var tmp : string;
  89. begin
  90. if params.OutputFile<>'' then exit;
  91. if params.InputFiles.Count>1 then
  92. begin
  93. Messages.DoError(SNoOutputFile);
  94. halt(halt_param_err);
  95. end;
  96. tmp:=ChangeFileExt(ExtractFileName(params.InputFiles[0]),
  97. '.jar');
  98. if sametext(tmp,params.InputFiles[0]) then
  99. tmp:=tmp+'.jar';
  100. params.OutputFile:=tmp;
  101. end;
  102. procedure ParseParams;
  103. var msg : string;
  104. begin
  105. Messages.DoVerbose('parsing command line parameters');
  106. msg:='';
  107. if ParamCount = 0 then
  108. begin
  109. ShowHelp;
  110. halt(halt_no_err);
  111. end;
  112. params:=TParameters.Create;
  113. try
  114. params.Parse;
  115. except
  116. on e : EOutputFileAlreadySetException do msg:=SOutputFileAlreadySet;
  117. on e : EUnknownParameterException do msg:=Format(SUnknownParameter,[e.Message]);
  118. on e : EArgumentMissingException do msg:=Format(SArgumentMissing,[e.Message]);
  119. on e : EUnknownObjFormatException do msg:=Format(SUnknownObjFormat,[e.Message]);
  120. on e : EUnknownMachineException do msg:=Format(SUnknownMachine,[e.Message]);
  121. on e : ECannotReadConfFile do msg:=Format(SCannotReadConfFile,[e.Message]);
  122. end;
  123. Messages.Verbose:=params.Verbose;
  124. if msg<>'' then
  125. begin
  126. Messages.DoError(msg);
  127. halt(halt_param_err);
  128. end;
  129. if params.Version then
  130. begin
  131. ShowVersion;
  132. halt(halt_no_err);
  133. end;
  134. if params.Help then
  135. begin
  136. ShowHelp;
  137. halt(halt_no_err);
  138. end;
  139. CheckInputFiles;
  140. CheckOutputFile;
  141. Messages.DoVerbose('finished parsing command line parameters');
  142. end;
  143. procedure LoadSourceFiles;
  144. var msg : string;
  145. begin
  146. msg:='';
  147. resources:=TZipper.Create;
  148. sourcefiles:=TJarSourceFiles.Create;
  149. sourcefiles.FileList.AddStrings(params.InputFiles);
  150. try
  151. sourcefiles.Load(resources);
  152. except
  153. on e : ECantOpenFileException do msg:=Format(SCantOpenFile,[e.Message]);
  154. on e : EUnknownInputFormatException do msg:=Format(SUnknownInputFormat,[e.Message]);
  155. on e : Exception do
  156. begin
  157. if e.Message='' then msg:=e.ClassName
  158. else msg:=e.Message;
  159. end;
  160. end;
  161. if msg<>'' then
  162. begin
  163. Messages.DoError(msg);
  164. halt(halt_read_err);
  165. end;
  166. end;
  167. procedure WriteOutputFile;
  168. var
  169. msg : string;
  170. outfile: THandle;
  171. removedirlevel: longint;
  172. begin
  173. { create the "resbasedir" hierarchy, since that directory has to exist for
  174. TZipper to be able to add it. If it already exists, make sure we don't
  175. remove it }
  176. if DirectoryExists('org') then
  177. if DirectoryExists('org'+DirectorySeparator+'freepascal') then
  178. if DirectoryExists(resbasedir) then
  179. removedirlevel:=0
  180. else
  181. removedirlevel:=1
  182. else
  183. removedirlevel:=2
  184. else
  185. removedirlevel:=3;
  186. try
  187. ForceDirectories(resbasedir);
  188. except
  189. Messages.DoError(Format(SCantCreateDirHier,[resbasedir]));
  190. halt(halt_write_err);
  191. end;
  192. try
  193. Messages.DoVerbose(Format('Trying to write output file %s...',[params.OutputFile]));
  194. try
  195. { will be overwritten by the tzipper }
  196. outfile:=FileCreate(params.OutputFile,fmCreate or fmShareDenyWrite,438);
  197. FileClose(outfile);
  198. except
  199. Messages.DoError(Format(SCantCreateFile,[params.OutputFile]));
  200. halt(halt_write_err);
  201. end;
  202. try
  203. Messages.DoVerbose(Format('Writing output file %s...',[params.OutputFile]));
  204. resources.FileName:=params.OutputFile;
  205. resources.ZipAllFiles;
  206. except
  207. on e : Exception do
  208. begin
  209. if e.Message='' then msg:=e.ClassName
  210. else msg:=e.Message;
  211. Messages.DoError(msg);
  212. halt(halt_write_err);
  213. end;
  214. end;
  215. Messages.DoVerbose(Format('Output file %s written',[params.OutputFile]));
  216. finally
  217. if removedirlevel>0 then
  218. begin
  219. if removedirlevel>1 then
  220. begin
  221. if removedirlevel>2 then
  222. RemoveDir(resbasedir);
  223. RemoveDir('org'+DirectorySeparator+'freepascal');
  224. end;
  225. RemoveDir('org');
  226. end;
  227. end;
  228. end;
  229. procedure Cleanup;
  230. begin
  231. Messages.DoVerbose('Cleaning up');
  232. if Resources<>nil then Resources.Free;
  233. if SourceFiles<>nil then SourceFiles.Free;
  234. if Params<>nil then Params.Free;
  235. end;
  236. var before, elapsed : longint;
  237. begin
  238. try
  239. before:=GetCurrentTimeMsec;
  240. ParseParams;
  241. LoadSourceFiles;
  242. WriteOutputFile;
  243. elapsed:=GetCurrentTimeMsec-before;
  244. if elapsed<0 then elapsed:=24*3600*1000 + elapsed;
  245. Messages.DoVerbose(Format('Time elapsed: %d.%d seconds',[elapsed div 1000,(elapsed mod 1000) div 10]));
  246. finally
  247. Cleanup;
  248. end;
  249. end.