remove comments

How can I load a pas file into my application, and delete all of the comments. The faster the better. I could only get as far as loading the file into a stringlist.

Thanks in advance.
Rhett Dewey

p.s. The faster it is, the more points Ill give you.  
spatAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

MadshiCommented:
I could write you something quite fast, but you'd have to wait until Sunday. So I hope another expert will help.

Regards, Madshi.
0
edeyCommented:
would the source file include multiline comments? If not (just the // c++ style comments) try this:

procedure strip(src : TStringList);
var
   p : integer;
begin
     for ix := 0 to src.lines-1 do
     begin
          p := pos('//',src.lines[ix]);
          if p <> 0 then
             delete(src.lines[ix],p,length(src.lines[ix])-p);
     end;
end;

Note this code does have a few 'challenges':
-really shouldn't have to call length() for every line, should be able to insert a large const int there.
-may be faster to allocate a large string & fill it with non-commented chars, rather then delete them out of the source string(s).
-routine will poorly handle nested comments & multi line ones, well not at all.


GL
Mike
0
intheCommented:
try this too:

unit Decommenter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  STRIP_STATES = ( SS_NORMA, SS_BRACE, SS_PAREN, SS_LITER );

function SCFS( const S : string; var SS : STRIP_STATES ): string;
var
  I : integer;
begin
  Result := '';
  I := 1;
  while I <= Length( S ) do begin
    case SS of
      SS_NORMA :
        case S[ I ] of
          '{' : if ( I < Length( S ) ) and ( S[ I + 1 ] = '$' )
                  then Result := Result + S[ I ]
                  else SS := SS_BRACE;
          '(' : if ( I < Length( S ) ) and ( S[ I + 1 ] = '*' )
                  then begin
                    if ( I < Length( S ) - 1 ) and ( S[ I + 2 ] = '$' )
                      then Result := Result + S[ I ]
                      else begin SS := SS_PAREN; Inc( I ); end;
                  end else Result := Result + S[ I ];
          '/' : if ( I < Length( S ) ) and ( S[ I + 1 ] = '/' )
                  then Exit
                  else Result := Result + S[ I ];
          '''' : begin SS := SS_LITER; Result := Result + S[ I ]; end;
          else Result := Result + S[ I ];
        end;
      SS_BRACE :
        case S[ I ] of
          '}' : SS := SS_NORMA;
        end;
      SS_PAREN :
        case S[ I ] of
          '*' : if ( I < Length( S ) ) and ( S[ I + 1 ] = ')' )
                  then begin SS := SS_NORMA; Inc( I ); end;
        end;
      SS_LITER :
        case S[ I ] of
          '''' : begin SS := SS_NORMA; Result := Result + S[ I ]; end;
          else Result := Result + S[ I ];
        end;
    end;
    Inc( I );
  end;
begin
end;
end;

procedure STRIP_COMMENTS( slIN, slOUT : TStringList;EMPTY_LINES : boolean = false; LEFT_TRIM : boolean = false;
RIGHT_TRIM : boolean = true );
var
  I : integer;
  STRIP_STATE : STRIP_STATES;
  S : string;
begin
  STRIP_STATE := SS_NORMA;
  for I := 0 to slIN.Count - 1 do begin
    S := SCFS( slIN[ I ], STRIP_STATE );
    if LEFT_TRIM then S := TrimLeft( S );
    if RIGHT_TRIM then S := TrimRight( S );
    if EMPTY_LINES or ( Length( Trim( S )) > 0 ) then slOUT.Append( S );
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
str1,str2 : tstringlist;
begin
str2 := tstringlist.create;
str1 := tstringlist.create;
str1.LoadFromFile('c:\funcprocs.pas');
STRIP_COMMENTS(str1,str2,false,false,true);
str1.Free;
memo1.lines.AddStrings(str2);
str2.free;
memo1.lines.SaveToFile('c:\funcprocs.pas');
end;

end.


Regards Barry
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

intheCommented:
STRIP_COMMENTS(str1,str2,true,false,true);

to leave a blank line between procedures
0
spatAuthor Commented:
inthe, your code works, thank you.

Madshi, if you could write me someting, that would be great. I need it to be as fast as possible but still be bug free (or fixable). I would gladly wait until sunday for something like this.

Thanks for your help everybody.

Regards,
Rhett Dewey
0
MadshiCommented:
I think, the solutions yet are quite fast, but I think, it should be possible to find an even faster way. I'll see on Sunday...   :-)

Regards, Madshi.
0
spatAuthor Commented:
Thank you.
0
MadshiCommented:
Hi friends,

here comes my ultra-high-speed-version...   :-)

I made some timing test. Both Barry's and my functions uncommented the following text 50000 times:

"test {(* test *)} test
  // blabla
test // test2
Ende {test}(*test*)// bla"

I left the loading/saving away, only the string manipulation itself was tested.

Barry's function: 10850 ms
My function: 70 ms

:-))   (Sorry, Barry...)

function KillComments(var str: string) : boolean;
var pfc, plc      : pchar;  // firstChar, lastChar
    pc1, pc2, pc3 : pchar;  // cursor 1 - 3

  function FindCommentBegin(pc1: pchar; var pc2: pchar) : boolean;
  begin
    pc2 := pc1;
    while (pc2 <= plc) and
          (pc2^ <> '{') and
          ((pc2^ <> '/') or ((pc2 + 1)^ <> '/')) and
          ((pc2^ <> '(') or ((pc2 + 1)^ <> '*')) do
      inc(pc2);
    result := pc2 <= plc;
    if result and (pc2^ = '/') then begin
      while (pc2 - 1 >= pfc) and ((pc2 - 1)^ = ' ') do
        dec(pc2);
      while (pc2 - 1 >= pfc) and (((pc2 - 1)^ = #$D) or ((pc2 - 1)^ = #$A)) do
        dec(pc2);
    end;
  end;

  function FindCommentEnd(pc1: pchar; var pc2: pchar) : boolean;
  begin
    pc2 := pc1;
    case pc1^ of
      '{' : begin
              while (pc2 <= plc) and (pc2^ <> '}') do
                inc(pc2);
              result := pc2 <= plc;
              if result then
                inc(pc2);
            end;
      '(' : begin
              while (pc2 <= plc) and ((pc2^ <> '*') or ((pc2 + 1)^ <> ')')) do
                inc(pc2);
              result := pc2 <= plc;
              if result then
                inc(pc2, 2);
            end;
      else  begin
              while (pc2^ <> '/') do
                inc(pc2);
              while (pc2 <= plc) and (pc2^ <> #$D) and (pc2^ <> #$A) do
                inc(pc2);
              result := pc2 <= plc;
            end;
    end;
  end;

begin
  UniqueString(str);
  pfc := pchar(str);
  plc := pfc + Length(str) - 1;
  result := FindCommentBegin(pfc, pc1);
  if result then begin
    pc3 := pc1;
    while true do
      if FindCommentEnd(pc3, pc2) then begin
        if FindCommentBegin(pc2, pc3) then begin
          Move(pc2^, pc1^, pc3 - pc2);
          pc1 := pc1 + (pc3 - pc2);
        end else begin
          Move(pc2^, pc1^, plc + 1 - pc2);
          SetLength(str, (pc1 - pfc) + (plc + 1 - pc2));
          break;
        end;
      end else begin
        SetLength(str, pc1 - pfc);
        break;
      end;
  end;
end;

procedure UncommentPasFile(pasFile: string);
var s1 : string;
begin
  with TFileStream.Create(pasFile, fmOpenRead or fmShareDenyNone) do
    try
      SetLength(s1, Size);
      Read(pchar(s1)^, Length(s1));
    finally Free end;
  if KillComments(s1) then
    with TFileStream.Create(pasFile, fmCreate) do
      try
        Write(pchar(s1)^, Length(s1));
      finally Free end;
end;

P.S: I've tested several strange comment situations, but maybe there are still bugs in it. If you find one, you can post the "bug-revealing" comment source here. Then I'll look at it again...

Regards, Madshi.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MadshiCommented:
Ehmm... Only wanted to mention that: This code costed me almost 2 hours, spat...   :-)
0
intheCommented:
EHmm.......Grrrrr ;-)
0
spatAuthor Commented:
WOW!, that is fast!

Thanks a lot, I really appreciate it. This will improve my applications speed tenfold.

Thanks, everyone for your help.
0
spatAuthor Commented:
Adjusted points to 1000
0
MadshiCommented:
Hey hey, 1000 points - thank you very much...   :-))
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.