On 07/17/11 05:50, Hans-Peter Diettrich wrote:
> Andrew Haines schrieb:
> 
>> The best way I know is described here:
>> http://wiki.lazarus.freepascal.org/Executing_External_Programs#How_to_redirect_output_with_TProcess
>>
> 
> Thanks for the link, I didn't know before that redirecting is such a big
> issue.
> 
> 
>> RunCommandAndDirectOutput('diff', '-r dir1 dir2', 'diff.txt');
> 
> Can I tell diff to only compare *.xml files?
> 
> I want to track modifications in the FPC/Lazarus docs files...
> 

I don't know if diff can be made to only match files against a pattern
but it can _ignore_ files matching a pattern. Anyway I made a program
that can do what you want mostly. It may be useful to you or not.

Also the TProcess example is slightly simpler.

Regards,

Andrew Haines
program diffpattern;
{$mode objfpc}{$H+}
uses
  Classes, Process, sysutils;


type

  TFilterProc = function (AName: String): Boolean;

  { TDiffDirs }

  TDiffDirs = class
    Dir1,
    Dir2: TStringList;
    Dir1Name,
    Dir2Name: String;
    OnFilter: TFilterProc;
    OutFile: TStream;
    constructor Create(ADir1, ADir2: String);
    destructor Destroy; override;
    procedure MakeLists;
    procedure Diff;
  end;

function CheckFilter(AName: String): Boolean;
begin
  Result := ExtractFileExt(AName) = '.xml';
end;

{ DiffDirs }

constructor TDiffDirs.Create(ADir1, ADir2: String);
begin
  Dir1 := TStringList.Create;
  Dir2 := TStringList.Create;
  Dir1Name := IncludeTrailingPathDelimiter(ADir1);
  Dir2Name := IncludeTrailingPathDelimiter(ADir2);
end;

destructor TDiffDirs.Destroy;
begin
  Dir1.Free;
  Dir2.Free;
  inherited Destroy;
end;

procedure TDiffDirs.MakeLists;
   procedure FindDirFiles(ADir, ASubDirs: String; const AList: TStrings);
   var
     s: TSearchRec;
   begin
     if FindFirst(ADir+ASubDirs+'*', faAnyFile or faDirectory, s) = 0 then
       repeat
         if (s.Attr and faDirectory = faDirectory) and (s.Name[1] <> '.') then
           FindDirFiles(ADir, ASubDirs + IncludeTrailingPathDelimiter(s.Name), 
AList)
         else
           if CheckFilter(s.Name) then
             AList.Add(ASubDirs+s.Name);
       until FindNext(s) <> 0;
   end;
begin
  FindDirFiles(Dir1Name, '', Dir1);
  FindDirFiles(Dir2Name, '', Dir2);
  Dir1.Sort;
  Dir2.Sort;
end;

procedure TDiffDirs.Diff;
  procedure DoDiff(F1, F2: String);
  var
    DiffC: String;
    p: TProcess;
  begin
    DiffC := 'diff -u -N '+ F1 + ' ' + F2; // -N is to treat missing files as 
empty
    p := TProcess.Create(nil);
    p.CommandLine := DiffC;
    p.Options := [poUsePipes];
    p.Execute;
    while p.Running or (p.Output.NumBytesAvailable > 0) do
      OutFile.CopyFrom(p.Output, p.Output.NumBytesAvailable);
    p.free;
  end;

var
  File1,
  File2: String;
  j: Integer;
begin

  while 0 < Dir1.Count do
  begin
    File1 := Dir1Name+Dir1[0];
    if Dir2.Find(File1, j) then // generally the first file in the list
    begin
      File2 := Dir2Name+Dir2[j];
      Dir2.Delete(j);
    end
    else
      File2 := Dir2Name+Dir1[0]; // <<-- a non existant file
    dir1.Delete(0);
    DoDiff(File1, File2);
  end;
  // now loop through Dir2 to see what doesn't exist in dir1
  while 0 < Dir2.Count do
  begin
    File1 := Dir1Name+Dir2[0];
    File2 := Dir2Name+Dir2[0];
    Dir2.Delete(0);
    DoDiff(File1, File2);
  end;
end;

begin
  if Paramcount < 2 then
  begin
    WriteLn ('Usage:');
    WriteLn ('    diffpattern <dir1> <dir2>');
    Writeln ('diff.txt is created in the current directory');
    Exit;
  end;
  with  TDiffDirs.Create(ParamStr(1), ParamStr(2)) do
  begin
    OutFile := TFileStream.Create('diff.txt', fmCreate or fmOpenWrite);
    OnFilter:=@CheckFilter;
    MakeLists;
    Diff;
    OutFile.Free;
    Free;
  end;
end.

_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel

Reply via email to