chkrc: Delphi pre-compiler tool to touch any rc with modified included files

chkrc.dpr

program chkrc;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Classes;

const
  AppName='chkrc by Stijn Sanders <[email protected]> 2012';//version?

var
  Settings:record
    Quiet,ParseUses,SetExit,DoDelete:boolean;
    Test:integer;
    OutputFolder:string;
  end;
  FoundChanges,Updates:integer;

//TODO: replace SetCurrentDir with proper path combine

function GetFileSignature(Path:AnsiString):AnsiString;
var
  fh:THandle;
  fd:TWin32FindDataA;
begin
  fh:=FindFirstFileA(PAnsiChar(Path),fd);
  if fh=INVALID_HANDLE_VALUE then Result:='' else
   begin
    //assert(fd.nFileSizeHigh=0
    Result:=
      IntToHex(fd.ftLastWriteTime.dwHighDateTime,8)+
      IntToHex(fd.ftLastWriteTime.dwLowDateTime,8)+'_'+
      IntToStr(fd.nFileSizeLow);
    Windows.FindClose(fh);
   end;
end;

procedure ProcessRCFile(fnRes,fnRC:string);
var
  sl,slMF:TStringList;
  sl_i:integer;
  s,t,fnMF,fnRC1,fnRes1,fn1:string;
  i,j:integer;
  DoRC:boolean;
begin
  //TODO: are .rc files able to include other .rc files?
  DoRC:=false;
  sl:=TStringList.Create;
  slMF:=TStringList.Create;
  try
    sl.LoadFromFile(fnRC);
    if Settings.OutputFolder='' then
      fnMF:=ChangeFileExt(ExpandFileName(fnRC),'.~rc')
    else
      fnMF:=Settings.OutputFolder+ChangeFileExt(ExtractFileName(fnRC),'.~rc');
    try
      slMF.LoadFromFile(fnMF);
    except
      on EFOpenError do ;//ignore
    end;
    fnRC1:=ExpandFileName(fnRC);
    fnRes1:=ExpandFileName(fnRes);
    //dirty! rig relative paths using current folder
    SetCurrentDir(ExtractFilePath(ExpandFileName(fnRC)));
    for sl_i:=0 to sl.Count-1 do
     begin
      s:=sl[sl_i];
      //line ends in quoted parameter?
      j:=Length(s);
      while (j>1) and (s[j]<>'"') do dec(j);
      dec(j);
      i:=j;
      while (i>0) and (s[i]<>'"') do dec(i);
      fn1:=Copy(s,i+1,j-i);
      //TODO: fn1 decode backslash escapes
      if fn1<>'' then
       begin
        t:=GetFileSignature(fn1);
        if slMF.Values[fn1]<>t then
         begin
          if not Settings.Quiet then
           begin
            if FoundChanges=0 then Writeln(AppName);
            Writeln(fnRC+' '+fn1);
           end;
          DoRC:=true;
          inc(FoundChanges);
          slMF.Values[fn1]:=t;
         end;
       end;
     end;
    if DoRC then
     begin
      inc(Updates);
      if Settings.Test<1 then
        if Settings.DoDelete then
         begin
          if not DeleteFile(fnRes1) then raise Exception.Create(
            'Delete "'+fnRes+'" failed: '+SysErrorMessage(GetLastError));
         end
        else
          FileSetDate(fnRC1,DateTimeToFileDate(Now));
      if Settings.Test<2 then
       begin
        slMF.SaveToFile(fnMF);
        SetFileAttributes(PChar(fnMF),FILE_ATTRIBUTE_HIDDEN);
       end;
     end;
  except
    on e:Exception do Writeln(fnRC+':'+e.Message);
  end;
  sl.Free;
  slMF.Free;
end;

procedure ProcessPascalFile(fn:string);
var
  sl:TStringList;
  sl_i:integer;
  s,t:string;
  i,j,l:integer;
begin
  sl:=TStringList.Create;
  try
    sl.LoadFromFile(fn);
    for sl_i:=0 to sl.Count-1 do
     begin
      s:=sl[sl_i];
      if Copy(s,1,3)='{$R' then
       begin
        i:=4;
        l:=Length(s);
        while (i<=l) and (s[i]<>'''') do inc(i);
        inc(i);
        j:=i;
        while (j<=l) and (s[j]<>'''') do inc(j);
        t:=Copy(s,i,j-i);
        i:=j+1;
        while (i<=l) and (s[i]<>'''') do inc(i);
        inc(i);
        j:=i;
        while (j<=l) and (s[j]<>'''') do inc(j);
        if j>i then
         begin
          //dirty! rig relative paths using current folder
          SetCurrentDir(ExtractFilePath(ExpandFileName(fn)));
          ProcessRCFile(t,Copy(s,i,j-i));
         end;
       end
      else
        if Settings.ParseUses then
         begin
          i:=1;
          l:=Length(s);
          while (i<=l) and ((s[i]=' ') or (s[i]=#9)) do inc(i);
          while (i<=l) and (s[i]<>' ') do inc(i);
          if Copy(s,i,5)=' in ''' then
           begin
            inc(i,5);
            j:=i;
            while (j<=l) and (s[j]<>'''') do inc(j);
            //dirty! rig relative paths using current folder
            SetCurrentDir(ExtractFilePath(ExpandFileName(fn)));
            ProcessPascalFile(Copy(s,i,j-i));
           end;
         end;
     end;

  except
    on e:Exception do Writeln(fn+':'+e.Message);
  end;
  sl.Free;
end;

var
  i,j,k,l:integer;
  s:string;
begin
  if ParamCount=0 then
   begin
    Writeln(AppName);
    Writeln('Use command line option /h to display usage information');
   end
  else
   begin
    //Default settings
    Settings.Quiet:=false;
    Settings.ParseUses:=false;
    Settings.Test:=0;
    Settings.SetExit:=false;
    Settings.DoDelete:=false;
    Settings.OutputFolder:='';
    FoundChanges:=0;
    Updates:=0;

    for i:=1 to ParamCount do
     begin
      s:=ParamStr(i);//assert s<>''
      if s[1]='/' then
       begin
        //option(s)
        l:=Length(s);
        j:=2;
        while (j<=l) do
         begin
          case s[j] of
            'h'://help
             begin
              Writeln(AppName);
              Writeln('Usage:');
              Writeln('  chkrc [<options>] <file>...');
              Writeln('');
              Writeln('Task:');
              Writeln('Searches the file(s) (typically a .dpr Delphi project file)');
              Writeln('for lines like "{$R ''x.res'' ''x.rc''}"');
              Writeln('checks .rc file(s) for changes to the included files');
              Writeln('(by storing file meta-data in a .~rc file)');
              Writeln('if changes are found, updates the last modified date of the .rc file.');
              Writeln('');
              Writeln('Options:');
              Writeln('  /h  help: displays this message');
              Writeln('  /q  quiet: run without output');
              Writeln('  /p  pas: process files from lines like " x in ''x.pas'',"');
              Writeln('      (as in a uses clause of a .dpr file)');
              Writeln('  /d  delete the .res file instead of touching the .rc file');
              Writeln('  /o"folder"  output the .~rc file(s) to this folder');
              Writeln('  /x  set process exit code to 1 when a change is detected');
              Writeln('  /t  test: run checks only, don''t modify anything except .~rc files');
              Writeln('  /T  test: run checks only, don''t modify anything');
             end;
            'q':Settings.Quiet:=true;
            'p':Settings.ParseUses:=true;
            'd':Settings.DoDelete:=true;
            'o'://output folder
             begin
              if j=l then
                Settings.OutputFolder:='\\\\\' //pick up from next param, see below
              else
               begin
                inc(j);
                if s[j]='''' then
                 begin
                  //pickup up to next quote
                  inc(j);
                  k:=j;
                  while (j<=l) and (s[j]<>'''') do inc(j);
                  Settings.OutputFolder:=IncludeTrailingPathDelimiter(
                    ExpandFileName(Copy(s,k,j-k)));
                 end
                else
                 begin
                  //take rest of parameter
                  Settings.OutputFolder:=IncludeTrailingPathDelimiter(
                    ExpandFileName(Copy(s,j,l-j+1)));
                  j:=l;
                 end;
               end;
             end;
            'x':Settings.SetExit:=true;
            't':Settings.Test:=1;
            'T':Settings.Test:=2;
            else
              if not Settings.Quiet then
                Writeln('Ignoring unknown option "'+s[j]+'"');
          end;
          inc(j);
         end;
       end
      else
        if Settings.OutputFolder='\\\\\' then
          Settings.OutputFolder:=IncludeTrailingPathDelimiter(ExpandFileName(s))
        else
          ProcessPascalFile(s);
     end;
   end;
  if FoundChanges<>0 then
   begin
    if not Settings.Quiet then Writeln(IntToStr(FoundChanges)+
      ' changed file(s) found. '+IntToStr(Updates)+' res/rc update(s).');
    if Settings.SetExit then ExitCode:=1;
   end
  else
    if not Settings.Quiet then
     begin
      Writeln(AppName);
      Writeln('No changed files found.');
     end;
end.