home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / tricks / pascal / header.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-09  |  1.8 KB  |  58 lines

  1. (* ------------------------------------------------------ *)
  2. (*                      HEADER.PAS                        *)
  3. (*            (c) 1992 Thomas Mai & DMV-Verlag            *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM Header;
  6.  
  7. USES Dos;
  8.  
  9. VAR
  10.   s1, s2 : STRING;
  11.   bN     : BYTE;
  12.   boGo   : BOOLEAN;
  13.   fIn    : TEXT;
  14.  
  15.   FUNCTION Trim(s : STRING) : STRING;
  16.   BEGIN
  17.     bN := 1;
  18.     WHILE (s[bN] IN [#32, #9]) DO Delete(s, 1, 1);
  19.     Trim := s;
  20.   END;
  21.  
  22. BEGIN
  23.   Assign(fIn, ParamStr(1)); Reset(fIn);
  24.     (* Man grĂ¼ble und staune !       *)
  25.     (* Standardausgabe trotz Crt ... *)
  26.   IF (IOResult = 0) AND (ParamCount = 1) THEN BEGIN
  27.     WHILE NOT(EoF(fIN))DO BEGIN
  28.       ReadLn(fIn, s1);
  29.       IF s1 <> '' THEN BEGIN
  30.         s1 := Trim(s1);
  31.         s2 := Copy(s1, 1, Pos(#32, s1)-1);
  32.         FOR bN := 1 TO 9 DO s2[bN] := UpCase(s2[bN]);
  33.         IF (s2 = 'PROCEDURE') OR
  34.            (s2 = 'FUNCTION') THEN BEGIN
  35.           WriteLn(s2, #9,
  36.                   Trim(Copy(s1, Ord(s2[0])+1, Ord(s1[0]))));
  37.           boGo := TRUE;
  38.           WHILE NOT (Eof(fIn)) AND boGo DO BEGIN
  39.             ReadLn(fIn, s1); s1 := Trim(s1); s2 := s1;
  40.             FOR bN := 1 TO 5 DO s1[bN] := UpCase(s1[bN]);
  41.             IF (Pos('BEGIN', s1) = 0) AND
  42.                (Pos('VAR',   s1) = 0) AND
  43.                (Pos('CONST', s1) = 0) AND
  44.                (s1[1]<>'{') AND (s1[1] <> '(') AND
  45.                (Pos('TYPE', s1) = 0) THEN
  46.               WriteLn(#9#9, s2)
  47.             ELSE
  48.               boGo := FALSE;
  49.           END;
  50.         END;
  51.       END;
  52.     END;
  53.     Close(fIn);
  54.   END ELSE WriteLn('Aufruf: HEADER <Dateiname>');
  55. END.
  56. (* ------------------------------------------------------ *)
  57. (*               Ende von HEADER.PAS                      *)
  58.