wrjpgcom.pas

DELPHI版的JPEG文件解码源程序

	write_marker(marker);
	copy_variable;
      end
      else
      begin
	skip_variable;
      end;

    else                { Anything else just gets copied }
      write_marker(marker);
      copy_variable;            { we assume it has a parameter count... }
    end;
  end; { end loop }
end;


{ Command line parsing code }

var
  progname : string;    { program name for error messages }


procedure usage;
{ complain about bad command line }
begin
  WriteLn('wrjpgcom inserts a textual comment in a JPEG file.');
  WriteLn('You can add to or replace any existing comment(s).');

  Write('Usage: ',progname,' [switches] ');
{$ifdef TWO_FILE_COMMANDLINE
  WriteLn('inputfile outputfile');
{$else}
  WriteLn('[inputfile]');
{$endif}

  WriteLn('Switches (names may be abbreviated):');
  WriteLn('  -replace         Delete any existing comments');
  WriteLn('  -comment "text"  Insert comment with given text');
  WriteLn('  -cfile name      Read comment from named file');
  WriteLn('Notice that you must put quotes around the comment text');
  WriteLn('when you use -comment.');
  WriteLn('If you do not give either -comment or -cfile on the command line,');
  WriteLn('then the comment text is read from standard input.');
  WriteLn('It can be multiple lines, up to ',
           uint(MAX_COM_LENGTH),' characters total.');
{$ifndef TWO_FILE_COMMANDLINE}
  WriteLn('You must specify an input JPEG file name when supplying');
  WriteLn('comment text from standard input.');
{$endif}

  Halt(EXIT_FAILURE);
end;


function keymatch (const arg : string;
                   const keyword : string;
                   minchars : int) : boolean;
{ Case-insensitive matching of (possibly abbreviated) keyword switches. }
{ keyword is the constant keyword (must be lower case already), }
{ minchars is length of minimum legal abbreviation. }
var
  {register} ca, ck : char;
  {register} nmatched : int;
  i, len : int;
begin
  nmatched := 0;
  keymatch := FALSE;
  len := Length(keyword);
  if len >= Length(arg) then
    len := Length(arg)
  else
    exit;
  for i := 1 to len do
  begin
    if (UpCase(arg[i]) <> UpCase(keyword[i])) then
      exit;
    Inc(nmatched);			{ count matched characters }
  end;
  { reached end of argument; fail if it's too short for unique abbrev }
  if (nmatched >= minchars) then
    keymatch := TRUE;			{ A-OK }
end;

{ The main program. }
var
  argc,
  argn : int;
  arg : string;
  keep_COM : boolean;
  comment_arg : string;
  comment_arg_0 : PChar;
  comment_file : TBufStream;
  comment_length : uint;
  marker : int;
var
  src_file : PBufStream;
  c : int;
begin
  keep_COM := TRUE;
  comment_arg := '';
  comment_length := 0;

  { On Mac, fetch a command line. }
  argc := ParamCount;

  progname := ParamStr(0);

  { Parse switches, if any }
  argn := 1;
  while (argn < argc) do
  begin
    arg := ParamStr(argn);
    if (arg[1] <> '-') then
      break;			{ not switch, must be file name }
    if (keymatch(arg, '-replace', 2)) then
    begin
      keep_COM := FALSE;
    end
    else
    if (keymatch(arg, '-cfile', 3)) then
    begin
      Inc(argn);
      if (argn >= argc) then
        usage;
      if not comment_file.Init(ParamStr(argn), stOpenRead, 2048) then
      begin
	WriteLn(progname, 'can''t open ', ParamStr(argn));
	Halt(EXIT_FAILURE);
      end;
    end
    else
    {$ifdef comment}
    if (keymatch(arg, '-comment', 2)) then
    begin
      Inc(argn);
      if (argn >= argc) then
        usage;
      comment_arg := ParamStr(argn);
      { If the comment text starts with '"', then we are probably running
        under MS-DOG and must parse out the quoted string ourselves.  Sigh. }
      if (comment_arg[1] = '"') then
      begin
        GetMem(comment_arg_0, size_t(MAX_COM_LENGTH) );
	if (comment_arg_0 = NIL) then
	  ERREXIT('Insufficient memory');
	strcopy(comment_arg_0, ParamStr(argn)+1);
	while TRUE do
        begin
	  comment_length := uint( strlen(comment_arg) );
	  if (comment_length > 0) and
             (comment_arg[comment_length-1] = '"') then
          begin
	    comment_arg[comment_length-1] := #0; { zap terminating quote }
	    break;
	  end;
          Inc(argn);
	  if (argn >= argc) then
	    ERREXIT('Missing ending quote mark');
	  strcat(comment_arg, ' ');
	  strcat(comment_arg, argv[argn]);
	end;
      end;
      comment_length := uint(strlen(comment_arg));
    end
    else
      usage;
    {$endif}
    Inc(argn);
  end;

  { Cannot use both -comment and -cfile. }
  if (comment_arg <> '') and (comment_file.status <> stOK) then
    usage;
  { If there is neither -comment nor -cfile, we will read the comment text
    from stdin; in this case there MUST be an input JPEG file name. }
  if (comment_arg = '') and (comment_file.status <> stOK) and (argn >= argc) then
    usage;

  { Open the input file. }
  if (argn < argc) then
  begin
    infile.Init(ParamStr(argn), stOpenRead, 2048);
    if (infile.Status <> stOK) then
    begin
      WriteLn(progname, ': can''t open ', ParamStr(argn));
      Halt(EXIT_FAILURE);
    end;
  end
  else
  begin
    { default input file is stdin }
{$ifdef USE_FDOPEN}      { need to re-open in binary mode? }
    infile := TBufStream.Init('', stOpenRead, 2048);
    if (infile.Status <> stOK) then
    begin
      WriteLn(progname, ': can''t open stdin');
      Halt(EXIT_FAILURE);
    end;
{$else}
    {infile := input;}
    RunError(255);
{$endif}
  end;

  { Open the output file. }
{$ifdef TWO_FILE_COMMANDLINE}
  { Must have explicit output file name }
  if (argn <> argc-2) then
  begin
    WriteLn(progname, ': must name one input and one output file');
    usage;
  end;
  outfile := TBufStream.Init(ParamStr(argn+1), stOpenWrite, 2048);
  if (outfile.Status <> stOK) then
  begin
    WriteLn(progname, ': can't open ', ParamStr(argn+1));
    Halt(EXIT_FAILURE);
  end;
{$else}
  { Unix style: expect zero or one file name }
  if (argn < argc-1) then
  begin
    WriteLn(progname, ': only one input file');
    usage;
  end;
  { default output file is stdout }
{$ifdef USE_FDOPEN}             { need to re-open in binary mode? }
  outfile := TBufStream.Init('', stOpenWrite, 2048);
  if (outfile.Status <> stOK) then
  begin
    WriteLn(progname, ': can''t open stdout');
    Halt(EXIT_FAILURE);
  end;
{$else}
  RunError(255);
  {outfile := stdout;}
{$endif}
{$endif} { TWO_FILE_COMMANDLINE }

  { Collect comment text from comment_file or stdin, if necessary }
  if (comment_arg_0 = NIL) then
  begin

    GetMem(comment_arg_0, size_t(MAX_COM_LENGTH) );
    if (comment_arg_0 = NIL) then
      ERREXIT('Insufficient memory');
    comment_length := 0;
    if comment_file.status = stOK then
      src_file := @comment_file
    else
      src_file := NIL;
    repeat
      c := getc(src_file);
      if (c <> EOF) do
      begin
        if (comment_length >= uint(MAX_COM_LENGTH)) then
        begin
	  WriteLn('Comment text may not exceed ',
                   uint(MAX_COM_LENGTH)),' bytes);
	  Halt(EXIT_FAILURE);
        end;
        comment_arg[comment_length] := char(c);
        Inc(comment_length);
      end;
    until (c = EOF);
    if (comment_file <> '') then
      fclose(comment_file);
  end;

  { Copy JPEG headers until SOFn marker;
    we will insert the new comment marker just before SOFn.
    This (a) causes the new comment to appear after, rather than before,
    existing comments; and (b) ensures that comments come after any JFIF
    or JFXX markers, as required by the JFIF specification. }
  marker := scan_JPEG_header(keep_COM);
  { Insert the new COM marker, but only if nonempty text has been supplied }
  if (comment_length > 0) then
  begin
    write_marker(M_COM);
    write_2_bytes(comment_length + 2);
    while (comment_length > 0) do
    begin
      write_1_byte(comment_arg^);
      Inc(comment_arg);
      Dec(comment_length);
    end;
  end;
  { Duplicate the remainder of the source file.
    Note that any COM markers occuring after SOF will not be touched. }
  write_marker(marker);
  copy_rest_of_file();

  { All done. }
  Halt(EXIT_SUCCESS);
end.