home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUILLET / EXTRACT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  2KB  |  74 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 53 of 62
  3. From : Art Weller                          1:381/85.0           29 Jun 93  06:30
  4. To   : Wayne Moses
  5. Subj : Procedure Search
  6. ────────────────────────────────────────────────────────────────────────────────
  7. I think you were the one looking for this.  I'm surprised others haven't posted
  8. better ones, so here it is.}
  9.  
  10. PROGRAM Extract;
  11. {$V-}
  12. uses dos, files, strings;
  13.  
  14. Var
  15.   Found      : boolean;
  16.   i          : byte;
  17.   Buf        : Word;
  18.   LineNumber : integer;
  19.   Instr      : String;
  20.   Str        : String[15];
  21.   FileName   : String[65];
  22.   InFile     : Text;
  23.  
  24. BEGIN {main}
  25.   if ParamCount = 0 then
  26.     writeln('Syntax:  EXTRACT filename<.PAS> <redirect>')
  27.   else
  28.   begin
  29.     LineNumber := 0;
  30.     Found := false;
  31.     FileName := ParamStr(1);
  32.     if pos('.',FileName) = 0 then FileName := FileName + '.PAS';
  33.     if OpenTextFile(InFile,FileName,'Input') then
  34.     begin
  35.       While not eof(InFile) do
  36.       begin
  37.         Readln(InFile,Instr);
  38.         Inc(LineNumber);                   {count the lines}
  39.         Str := copy(Instr,1,15);
  40.         ToLower(Str);
  41.         if (Pos('program',Str)<>0)
  42.           or (Pos('unit',Str)<>0)
  43.           or (Pos('function',Str)<>0)
  44.           or (Pos('procedure',Str)<>0) then
  45.         begin
  46.           Found := true;
  47.           Writeln(LineNumber:4,' ',Instr);
  48.         end
  49.         else
  50.         begin
  51.           if Found AND (Instr[1] = '{') then
  52.             Writeln(LineNumber:4,' ',Instr)
  53.           else Found := false;
  54.         end;
  55.         if (Pos('implementation', Str) = 1) then
  56.         begin
  57.           Close(InFile);
  58.           exit;
  59.         end;
  60.       end;
  61.       Close(InFile);
  62.     end;
  63.   end;
  64. END.
  65.  
  66. I scribbled this somewhat hastily some time ago as I wanted to index my units.
  67.  
  68. It gets nested Procedures and Function from programs but only the interface
  69. from units.  You can modify to suit your self.
  70.  
  71. Uses a few things from my Files and Strings units but I think you can figure
  72. them out from their names.  If not, I'll be happy to post them.
  73.  
  74. This is free, in the public domain; therefore comes with a money-back guarantee