[JVCL-Checkins] CVS: dev/JVCL3/devtools/DFMCleaner SkipListD5.txt,NONE,1.1 dc.dof,NONE,1.1 dc.dpr,NONE,1.1 dc.txt,NONE,1.1 dcUtils.pas,NONE,1.1

[Peter T. <pe...@us...>]

Update of /cvsroot/jvcl/dev/JVCL3/devtools/DFMCleaner
In directory sc8-pr-cvs1:/tmp/cvs-serv4702/JVCL3/devtools/DFMCleaner

Added Files:
	SkipListD5.txt dc.dof dc.dpr dc.txt dcUtils.pas 
Log Message:
- Copied jvcl/devtools and jvcl/examples dev/JVCL3
- Copied JVCLConvert *.dat files to dev/JVCL3/converter

--- NEW FILE: SkipListD5.txt ---
*.DesignSize
TPageControl.TabIndex
TJvPageControl.TabIndex
--- NEW FILE: dc.dof ---
[Directories]
OutputDir=..\bin
UnitOutputDir=..\dcu
SearchPath=..\common

--- NEW FILE: dc.dpr ---
program dc;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  dcUtils in 'dcUtils.pas';

begin
  Run;
end.
 
--- NEW FILE: dc.txt ---
DFMCleaner is a tool to remove unsupported properties from DFMs. If you save a dfm file in one version of Delphi and want to use it in an earlier version, chances are there are some unsupported properties in it, generating an error when the form is opened in Delphi. What's even worse, if the dfm is part of a design-time package, Delphi will install the package without errors but when you try to access the form at design-time (f ex if the form is used by a property editor), Delphi generates an AV instead.

Command-line:

dc.exe <options> <filemask> <filemask>

where <options> can be:
-i - replace in-line (output overwrites input). If not given, output uses input's filename but with a "txt" extension
-s - recurse into sub-folders
-f<filename> - read skiplist from <filename>, REQUIRED. Do not preceed filename with spaces!

<filemask> can be a filename or a filemask with wildcards. Also supports relative paths (like ..\source\*.dfm and source\*.dfm). Filemasks that contain spaces must be enclosed in single or double quotes

The output file is only written if it is different from the input. Input DFM's can be in either text or binary format but the output is always written in text format. 

The skiplist has the following format:
Each row contains the name of a property to remove, preceeded by it's classname or a "*". A "*" means "any class". 
Examples:
*.DesignSize - remove all DesignSize properties
TPageControl.TabIndex - remove TabIndex for TPageControl

Note that the tool cannot derive inheritance from the dfm, so all affected classes must be named explicitly, i.e if you want to remove TabIndex for TPageControl and all descendants, you must name them on one row each:
TPageControl.TabIndex
TJvPageControl.TabIndex
TPageControlEx.TabIndex
etc...

The skiplist file doesn't have to be sorted: it is sorted internally.






--- NEW FILE: dcUtils.pas ---
unit dcUtils;

interface

procedure Run;

implementation
uses
  SysUtils, Classes, JTools, TypInfo, RTLConsts;

{ format of skiplist file:
<classname>.<property>

example:
*.DesignSize // applies to DesignSize in all classes
TPageControl.TabIndex, // TabIndex for TPageControl only
}

function IsBinDFM(Stream: TStream): boolean;
var
  ASignature: byte;
begin
  Stream.Read(ASignature, sizeof(ASignature));
  Result := ASignature = $FF;
  Stream.Seek(-sizeof(ASignature), soFromCurrent);
end;

function CleanDFM(Input, Output: TStream; SkipList: TStrings):boolean;
var
  NestingLevel: Integer;
  SaveSeparator: Char;
  Reader: TReader;
  Writer: TWriter;
  ClassName, ObjectName, PropName: string;
  tmpStream: TMemoryStream;

  procedure WriteIndent;
  const
    Blanks: array[0..1] of Char = '  ';
  var
    I: Integer;
  begin
    for I := 1 to NestingLevel do
      Writer.Write(Blanks, SizeOf(Blanks));
  end;

  procedure WriteStr(const S: string);
  begin
    Writer.Write(S[1], Length(S));
  end;

  procedure NewLine;
  begin
    WriteStr(sLineBreak);
    WriteIndent;
  end;

  procedure ConvertValue; forward;

  procedure ConvertHeader;
  var
    Flags: TFilerFlags;
    Position: Integer;
  begin
    Reader.ReadPrefix(Flags, Position);
    ClassName := Reader.ReadStr;
    ObjectName := Reader.ReadStr;
    WriteIndent;
    if ffInherited in Flags then
      WriteStr('inherited ')
    else if ffInline in Flags then
      WriteStr('inline ')
    else
      WriteStr('object ');
    if ObjectName <> '' then
    begin
      WriteStr(ObjectName);
      WriteStr(': ');
    end;
    WriteStr(ClassName);
    if ffChildPos in Flags then
    begin
      WriteStr(' [');
      WriteStr(IntToStr(Position));
      WriteStr(']');
    end;

    if ObjectName = '' then
      ObjectName := ClassName; // save for error reporting

    WriteStr(sLineBreak);
  end;

  procedure ConvertBinary;
  const
    BytesPerLine = 32;
  var
    MultiLine: Boolean;
    I: Integer;
    Count: Longint;
    Buffer: array[0..BytesPerLine - 1] of Char;
    Text: array[0..BytesPerLine * 2 - 1] of Char;
  begin
    Reader.ReadValue;
    WriteStr('{');
    Inc(NestingLevel);
    Reader.Read(Count, SizeOf(Count));
    MultiLine := Count >= BytesPerLine;
    while Count > 0 do
    begin
      if MultiLine then
        NewLine;
      if Count >= 32 then
        I := 32
      else
        I := Count;
      Reader.Read(Buffer, I);
      BinToHex(Buffer, Text, I);
      Writer.Write(Text, I * 2);
      Dec(Count, I);
    end;
    Dec(NestingLevel);
    WriteStr('}');
  end;

  procedure ConvertProperty; forward;

  procedure ConvertValue;
  const
    LineLength = 64;
  var
    I, J, K, L: Integer;
    S: string;
    W: WideString;
    LineBreak: Boolean;
  begin
    case Reader.NextValue of
      vaList:
        begin
          Reader.ReadValue;
          WriteStr('(');
          Inc(NestingLevel);
          while not Reader.EndOfList do
          begin
            NewLine;
            ConvertValue;
          end;
          Reader.ReadListEnd;
          Dec(NestingLevel);
          WriteStr(')');
        end;
      vaInt8, vaInt16, vaInt32:
        WriteStr(IntToStr(Reader.ReadInteger));
      vaExtended:
        WriteStr(FloatToStr(Reader.ReadFloat));
      vaSingle:
        WriteStr(FloatToStr(Reader.ReadSingle) + 's');
      vaCurrency:
        WriteStr(FloatToStr(Reader.ReadCurrency * 10000) + 'c');
      vaDate:
        WriteStr(FloatToStr(Reader.ReadDate) + 'd');
      vaWString, vaUTF8String:
        begin
          W := Reader.ReadWideString;
          L := Length(W);
          if L = 0 then
            WriteStr('''''')
          else
          begin
            I := 1;
            Inc(NestingLevel);
            try
              if L > LineLength then
                NewLine;
              K := I;
              repeat
                LineBreak := False;
                if (W[I] >= ' ') and (W[I] <> '''') and (Ord(W[i]) <= 127) then
                begin
                  J := I;
                  repeat
                    Inc(I)
                  until (I > L) or (W[I] < ' ') or (W[I] = '''') or
                    ((I - K) >= LineLength) or (Ord(W[i]) > 127);
                  if ((I - K) >= LineLength) then
                    LineBreak := True;
                  WriteStr('''');
                  while J < I do
                  begin
                    WriteStr(Char(W[J]));
                    Inc(J);
                  end;
                  WriteStr('''');
                end
                else
                begin
                  WriteStr('#');
                  WriteStr(IntToStr(Ord(W[I])));
                  Inc(I);
                  if ((I - K) >= LineLength) then
                    LineBreak := True;
                end;
                if LineBreak and (I <= L) then
                begin
                  WriteStr(' +');
                  NewLine;
                  K := I;
                end;
              until I > L;
            finally
              Dec(NestingLevel);
            end;
          end;
        end;
      vaString, vaLString:
        begin
          S := Reader.ReadString;
          L := Length(S);
          if L = 0 then
            WriteStr('''''')
          else
          begin
            I := 1;
            Inc(NestingLevel);
            try
              if L > LineLength then
                NewLine;
              K := I;
              repeat
                LineBreak := False;
                if (S[I] >= ' ') and (S[I] <> '''') then
                begin
                  J := I;
                  repeat
                    Inc(I)
                  until (I > L) or (S[I] < ' ') or (S[I] = '''') or
                    ((I - K) >= LineLength);
                  if ((I - K) >= LineLength) then
                  begin
                    LIneBreak := True;
                    if ByteType(S, I) = mbTrailByte then
                      Dec(I);
                  end;
                  WriteStr('''');
                  Writer.Write(S[J], I - J);
                  WriteStr('''');
                end
                else
                begin
                  WriteStr('#');
                  WriteStr(IntToStr(Ord(S[I])));
                  Inc(I);
                  if ((I - K) >= LineLength) then
                    LineBreak := True;
                end;
                if LineBreak and (I <= L) then
                begin
                  WriteStr(' +');
                  NewLine;
                  K := I;
                end;
              until I > L;
            finally
              Dec(NestingLevel);
            end;
          end;
        end;
      vaIdent, vaFalse, vaTrue, vaNil, vaNull:
        WriteStr(Reader.ReadIdent);
      vaBinary:
        ConvertBinary;
      vaSet:
        begin
          Reader.ReadValue;
          WriteStr('[');
          I := 0;
          while True do
          begin
            S := Reader.ReadStr;
            if S = '' then
              Break;
            if I > 0 then
              WriteStr(', ');
            WriteStr(S);
            Inc(I);
          end;
          WriteStr(']');
        end;
      vaCollection:
        begin
          Reader.ReadValue;
          WriteStr('<');
          Inc(NestingLevel);
          while not Reader.EndOfList do
          begin
            NewLine;
            WriteStr('item');
            if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
            begin
              WriteStr(' [');
              ConvertValue;
              WriteStr(']');
            end;
            WriteStr(sLineBreak);
            Reader.CheckValue(vaList);
            Inc(NestingLevel);
            while not Reader.EndOfList do
              ConvertProperty;
            Reader.ReadListEnd;
            Dec(NestingLevel);
            WriteIndent;
            WriteStr('end');
          end;
          Reader.ReadListEnd;
          Dec(NestingLevel);
          WriteStr('>');
        end;
      vaInt64:
        WriteStr(IntToStr(Reader.ReadInt64));
    else
      raise EReadError.CreateResFmt(@sPropertyException,
        [ObjectName, DotSep, PropName, IntToStr(Ord(Reader.NextValue))]);
    end;
  end;

  procedure ConvertProperty;
  var
    APos: integer;
  begin
    // sve current position
    APos := Writer.Position;
    WriteIndent;
    PropName := Reader.ReadStr; // save for error reporting
    WriteStr(PropName);
    WriteStr(' = ');
    ConvertValue;
    WriteStr(sLineBreak);
    // Check if the current property should be removed
    if (SkipList <> nil) and ((SkipList.IndexOf(ClassName + '.' + PropName) >= 0) or
      (SkipList.IndexOf('*.' + PropName) >= 0)) then
    begin
      Result := true;
      Writer.Position := APos; // go back to previous position
    end;
  end;

  procedure ConvertObject;
  begin
    ConvertHeader;
    Inc(NestingLevel);
    while not Reader.EndOfList do
      ConvertProperty;
    Reader.ReadListEnd;
    while not Reader.EndOfList do
      ConvertObject;
    Reader.ReadListEnd;
    Dec(NestingLevel);
    WriteIndent;
    WriteStr('end' + sLineBreak);
  end;
begin
  Result := false; // result is set to true in ConvertProperty if we skip anything
  tmpStream := TMemoryStream.Create;
  try
    // we don't want to rewrite everything in CleanDFM,
    // so convert text-> binary if necessary
    // (the other option is to convert Output to text after writing it...)
    if not IsBinDFM(Input) then
    begin
      ObjectTextToResource(Input, tmpStream);
      tmpStream.Seek(0, soFromBeginning);
      Input := tmpStream;
    end;

    Input.ReadResHeader;
    NestingLevel := 0;
    Reader := TReader.Create(Input, 4096);
    SaveSeparator := DecimalSeparator;
    DecimalSeparator := '.';
    try
      Writer := TWriter.Create(Output, 4096);
      try
        Reader.ReadSignature;
        ConvertObject;
      finally
        Writer.Free;
      end;
    finally
      DecimalSeparator := SaveSeparator;
      Reader.Free;
    end;
  finally
    tmpStream.Free;
  end;
end;

procedure ShowHeader;
begin
  writeln('');
  writeln('JEDI DFMCleaner 0.1: DFM property cleaner.');
  writeln('=========================================');
end;

procedure ShowHelp;
begin
  writeln('');
  writeln('Usage:');
  writeln('dc <options> <filemask> <filemask>...');
  writeln('');
  writeln('where <options> are');
  writeln('-i - replaces in-line (output overwrites input)');
  writeln('-s - recurse into subfolders');
  writeln('-f<filename> - where <filename> is a text file that contains the');
  writeln('names of properties to remove.');
  writeln('');
  writeln('<filemask> - a space-delimited list of filenames with optional wildcards.');
  writeln('');
  writeln('');
end;

function ParseDFM(const Filename: string; ASkipList: TStrings; ReplaceInline: boolean):boolean;
var
  F: TFileStream;
  F2:TMemoryStream;
begin
  Result := false;
  try
    F := TFileStream.Create(Filename, fmOpenReadWrite or fmShareExclusive);
    F2 := TMemoryStream.Create;
    try
      if CleanDFM(F, F2, ASkipList) then // only write if something changed
      begin
        Result := true;
        if ReplaceInline then
        begin
          F.Size := 0;
          F.CopyFrom(F2,0);
          writeln('Writing ',Filename,'...');
        end
        else
        begin
          F2.SaveToFile(ChangeFileExt(Filename, '.txt'));
          writeln('Writing ',ChangeFileExt(Filename, '.txt'),'...');
        end;
      end;
    finally
      F.Free;
      F2.Free;
    end;
  except
    on E: Exception do
      writeln('ERROR: ', E.Message, ' (', Filename, ')');
  end;
end;

function ParseFiles(const Filemask: string; ASkipList: TStrings; ReplaceInline, Recurse: boolean;var FilesFound:integer):integer;
var
  F: TSearchRec;
begin
  Result := 0;
  if FindFirst(Filemask, faAnyFile, F) = 0 then
  begin
    repeat
      Inc(FilesFound);
      if ParseDFM(ExtractFilePath(Filemask) + F.Name, ASkipList, ReplaceInline) then
        Inc(Result)
    until FindNext(F) <> 0;
    FindClose(F);
  end;
  if Recurse then
  begin
    if FindFirst(ExtractFilePath(Filemask) + '*.*', faDirectory, F) = 0 then
    begin
      repeat
        if (F.Attr and faDirectory = faDirectory) and (F.Name <> '.') and (F.Name <> '..') then
          Result := Result + ParseFiles(ExtractFilePath(Filemask) + F.Name + '\' + ExtractFileName(Filemask), ASkipList, ReplaceInline, Recurse,FilesFound);
      until FindNext(F) <> 0;
      FindClose(F);
    end;
  end;
end;

procedure Run;
var
  i,ACount,FilesFound: integer;
  CmdSwitch: string;
  ReplaceInline, Recurse: boolean;
  SkipList: TStringlist;
begin
  ShowHeader;
  if (ParamCount = 0) or GetCmdSwitchValue('h', ['-', '/'], CmdSwitch, true) or GetCmdSwitchValue('?', ['-', '/'], CmdSwitch, true) then
  begin
    ShowHelp;
    Exit;
  end;
  try
    ACount := 0;
    FilesFound := 0;
    Recurse := GetCmdSwitchValue('s', ['-', '/'], CmdSwitch, true);
    ReplaceInline := GetCmdSwitchValue('i', ['-', '/'], CmdSwitch, true);
    if not GetCmdSwitchValue('f', ['-', '/'], CmdSwitch, true) or not FileExists(ExpandUNCFileName(CmdSwitch)) then
      raise Exception.Create('Config file not found!');
    // done: add handling of skiplist and subfolders
    SkipList := TStringlist.Create;
    try
      SkipList.LoadFromFile(ExpandUNCFileName(CmdSwitch));
      SkipList.Sorted := true; // faster lookup
      for i := 1 to ParamCount do
        if not (ParamStr(i)[1] in ['-', '/']) then
          ACount := ACount + ParseFiles(ExpandUNCFileName(ParamStr(i)), SkipList, ReplaceInline, Recurse,FilesFound);
    finally
      SkipList.Free;
    end;
    writeln('Done: ',FilesFound,' files found, ', ACount,' files cleaned');
  except
    on E: Exception do
    begin
      writeln('ERROR: ',E.Message);
    end;
  end;
end;

end.