123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279 |
- {
- FPCRes - Free Pascal Resource Converter
- Part of the Free Pascal distribution
- Copyright (C) 2008 by Giulio Bernardi
- Copyright (C) 2011 by Jonas Maebe
- See the file COPYING, included in this distribution,
- for details about the copyright.
- 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.
- }
- {
- Java's internal resource file handling system is based on simply loading
- files from withing the package name space. We reserve the namespace
- org.freepascal.rawresources for this purpose.
- This program creates a jar file (= zip file) containing all specified files.
- }
- program fpcjres;
- {$MODE OBJFPC} {$H+}
- uses
- SysUtils, Classes, paramparser, msghandler, jarsourcehandler,
- zipper
- ;
- const
- halt_no_err = 0;
- halt_param_err = 1;
- halt_read_err = 2;
- halt_write_err = 3;
- progname = 'fpcjres';
- progversion = '1.0'; //to distinguish from the old fpcres
- fpcversion = {$INCLUDE %FPCVERSION%};
- host_arch = {$INCLUDE %FPCTARGETCPU%};
- host_os = {$INCLUDE %FPCTARGETOS%};
- build_date = {$INCLUDE %DATE%};
- var
- params : TParameters = nil;
- resources : TZipper = nil;
- sourcefiles : TJarSourceFiles = nil;
- procedure ShowVersion;
- begin
- writeln(progname+' - resource file converter, version '+progversion+' ['+build_date+'], FPC '+fpcversion);
- writeln('Host platform: '+host_os+' - '+host_arch);
- writeln('Copyright (c) 2008 by Giulio Bernardi.');
- writeln('Copyright (c) 2011 by Jonas Maebe.');
- end;
- procedure ShowHelp;
- begin
- ShowVersion;
- writeln('Syntax: '+progname+' [options] <inputfile> [<inputfile>...] [-o <outputfile>]');
- writeln;
- writeln('Options:');
- writeln(' --help, -h, -? Show this screen.');
- writeln(' --version, -V Show program version.');
- writeln(' --verbose, -v Be verbose.');
- writeln(' --input, -i <x> Ignored for compatibility.');
- writeln(' --output, -o <x> Set the output file name.');
- writeln(' @<file> Read more options from file <file>');
- end;
- const
- SOutputFileAlreadySet = 'Output file name already set.';
- SUnknownParameter = 'Unknown parameter ''%s''';
- SArgumentMissing = 'Argument missing for option ''%s''';
- SUnknownObjFormat = 'Unknown file format ''%s''';
- SUnknownMachine = 'Unknown architecture ''%s''';
- SFormatArchMismatch = 'Architecture %s is not available for %s format';
- SNoInputFiles = 'No input files';
- SNoOutputFile = 'No output file name specified';
- SCannotReadConfFile ='Can''t read config file ''%s''';
-
- SCantOpenFile = 'Can''t open file ''%s''';
- SUnknownInputFormat = 'No known file format detected for file ''%s''';
-
- SCantCreateDirHier = 'Can''t create directory hierarchy ''%s''';
- SCantCreateFile = 'Can''t create file ''%s''';
- function GetCurrentTimeMsec : longint;
- var h,m,s,ms : word;
- begin
- DecodeTime(Time,h,m,s,ms);
- Result:=h*3600*1000 + m*60*1000 + s*1000 + ms;
- end;
- procedure CheckInputFiles;
- begin
- if params.InputFiles.Count=0 then
- begin
- Messages.DoError(SNoInputFiles);
- halt(halt_param_err);
- end;
- end;
- procedure CheckOutputFile;
- var tmp : string;
- begin
- if params.OutputFile<>'' then exit;
- if params.InputFiles.Count>1 then
- begin
- Messages.DoError(SNoOutputFile);
- halt(halt_param_err);
- end;
- tmp:=ChangeFileExt(ExtractFileName(params.InputFiles[0]),
- '.jar');
- if sametext(tmp,params.InputFiles[0]) then
- tmp:=tmp+'.jar';
- params.OutputFile:=tmp;
- end;
- procedure ParseParams;
- var msg : string;
- begin
- Messages.DoVerbose('parsing command line parameters');
- msg:='';
- if ParamCount = 0 then
- begin
- ShowHelp;
- halt(halt_no_err);
- end;
- params:=TParameters.Create;
- try
- params.Parse;
- except
- on e : EOutputFileAlreadySetException do msg:=SOutputFileAlreadySet;
- on e : EUnknownParameterException do msg:=Format(SUnknownParameter,[e.Message]);
- on e : EArgumentMissingException do msg:=Format(SArgumentMissing,[e.Message]);
- on e : EUnknownObjFormatException do msg:=Format(SUnknownObjFormat,[e.Message]);
- on e : EUnknownMachineException do msg:=Format(SUnknownMachine,[e.Message]);
- on e : ECannotReadConfFile do msg:=Format(SCannotReadConfFile,[e.Message]);
- end;
- Messages.Verbose:=params.Verbose;
- if msg<>'' then
- begin
- Messages.DoError(msg);
- halt(halt_param_err);
- end;
- if params.Version then
- begin
- ShowVersion;
- halt(halt_no_err);
- end;
- if params.Help then
- begin
- ShowHelp;
- halt(halt_no_err);
- end;
- CheckInputFiles;
- CheckOutputFile;
- Messages.DoVerbose('finished parsing command line parameters');
- end;
- procedure LoadSourceFiles;
- var msg : string;
- begin
- msg:='';
- resources:=TZipper.Create;
- sourcefiles:=TJarSourceFiles.Create;
- sourcefiles.FileList.AddStrings(params.InputFiles);
- try
- sourcefiles.Load(resources);
- except
- on e : ECantOpenFileException do msg:=Format(SCantOpenFile,[e.Message]);
- on e : EUnknownInputFormatException do msg:=Format(SUnknownInputFormat,[e.Message]);
- on e : Exception do
- begin
- if e.Message='' then msg:=e.ClassName
- else msg:=e.Message;
- end;
- end;
- if msg<>'' then
- begin
- Messages.DoError(msg);
- halt(halt_read_err);
- end;
- end;
- procedure WriteOutputFile;
- var
- msg : string;
- outfile: THandle;
- removedirlevel: longint;
- begin
- { create the "resbasedir" hierarchy, since that directory has to exist for
- TZipper to be able to add it. If it already exists, make sure we don't
- remove it }
- if DirectoryExists('org') then
- if DirectoryExists('org'+DirectorySeparator+'freepascal') then
- if DirectoryExists(resbasedir) then
- removedirlevel:=0
- else
- removedirlevel:=1
- else
- removedirlevel:=2
- else
- removedirlevel:=3;
- try
- ForceDirectories(resbasedir);
- except
- Messages.DoError(Format(SCantCreateDirHier,[resbasedir]));
- halt(halt_write_err);
- end;
- try
- Messages.DoVerbose(Format('Trying to write output file %s...',[params.OutputFile]));
- try
- { will be overwritten by the tzipper }
- outfile:=FileCreate(params.OutputFile,fmCreate or fmShareDenyWrite,438);
- FileClose(outfile);
- except
- Messages.DoError(Format(SCantCreateFile,[params.OutputFile]));
- halt(halt_write_err);
- end;
- try
- Messages.DoVerbose(Format('Writing output file %s...',[params.OutputFile]));
- resources.FileName:=params.OutputFile;
- resources.ZipAllFiles;
- except
- on e : Exception do
- begin
- if e.Message='' then msg:=e.ClassName
- else msg:=e.Message;
- Messages.DoError(msg);
- halt(halt_write_err);
- end;
- end;
- Messages.DoVerbose(Format('Output file %s written',[params.OutputFile]));
- finally
- if removedirlevel>0 then
- begin
- if removedirlevel>1 then
- begin
- if removedirlevel>2 then
- RemoveDir(resbasedir);
- RemoveDir('org'+DirectorySeparator+'freepascal');
- end;
- RemoveDir('org');
- end;
- end;
- end;
- procedure Cleanup;
- begin
- Messages.DoVerbose('Cleaning up');
- if Resources<>nil then Resources.Free;
- if SourceFiles<>nil then SourceFiles.Free;
- if Params<>nil then Params.Free;
- end;
- var before, elapsed : longint;
- begin
- try
- before:=GetCurrentTimeMsec;
- ParseParams;
- LoadSourceFiles;
- WriteOutputFile;
- elapsed:=GetCurrentTimeMsec-before;
- if elapsed<0 then elapsed:=24*3600*1000 + elapsed;
- Messages.DoVerbose(Format('Time elapsed: %d.%d seconds',[elapsed div 1000,(elapsed mod 1000) div 10]));
- finally
- Cleanup;
- end;
- end.
|