home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------ *)
- (* HEADER.PAS *)
- (* (c) 1992 Thomas Mai & DMV-Verlag *)
- (* ------------------------------------------------------ *)
- PROGRAM Header;
-
- USES Dos;
-
- VAR
- s1, s2 : STRING;
- bN : BYTE;
- boGo : BOOLEAN;
- fIn : TEXT;
-
- FUNCTION Trim(s : STRING) : STRING;
- BEGIN
- bN := 1;
- WHILE (s[bN] IN [#32, #9]) DO Delete(s, 1, 1);
- Trim := s;
- END;
-
- BEGIN
- Assign(fIn, ParamStr(1)); Reset(fIn);
- (* Man grĂ¼ble und staune ! *)
- (* Standardausgabe trotz Crt ... *)
- IF (IOResult = 0) AND (ParamCount = 1) THEN BEGIN
- WHILE NOT(EoF(fIN))DO BEGIN
- ReadLn(fIn, s1);
- IF s1 <> '' THEN BEGIN
- s1 := Trim(s1);
- s2 := Copy(s1, 1, Pos(#32, s1)-1);
- FOR bN := 1 TO 9 DO s2[bN] := UpCase(s2[bN]);
- IF (s2 = 'PROCEDURE') OR
- (s2 = 'FUNCTION') THEN BEGIN
- WriteLn(s2, #9,
- Trim(Copy(s1, Ord(s2[0])+1, Ord(s1[0]))));
- boGo := TRUE;
- WHILE NOT (Eof(fIn)) AND boGo DO BEGIN
- ReadLn(fIn, s1); s1 := Trim(s1); s2 := s1;
- FOR bN := 1 TO 5 DO s1[bN] := UpCase(s1[bN]);
- IF (Pos('BEGIN', s1) = 0) AND
- (Pos('VAR', s1) = 0) AND
- (Pos('CONST', s1) = 0) AND
- (s1[1]<>'{') AND (s1[1] <> '(') AND
- (Pos('TYPE', s1) = 0) THEN
- WriteLn(#9#9, s2)
- ELSE
- boGo := FALSE;
- END;
- END;
- END;
- END;
- Close(fIn);
- END ELSE WriteLn('Aufruf: HEADER <Dateiname>');
- END.
- (* ------------------------------------------------------ *)
- (* Ende von HEADER.PAS *)