home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vgi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-08  |  3.1 KB  |  197 lines
  1. Program VGI;
  2.  
  3.  
  4. Uses
  5.  
  6.   DOS,
  7.   VTypesu,
  8.   VStringu,
  9.   VGenu,
  10.   VDoshu;
  11.  
  12.  
  13. Var
  14.   TotalFuncs : LONGINT;
  15.  
  16. Procedure GrabInterface(          IncPreFace  : BOOLEAN;
  17.                                   GetComments : BOOLEAN;
  18.                                   InFile      : STRING;
  19.                                   OutFile     : STRING     );
  20.  
  21. Var
  22.  
  23.   FI : TEXT;
  24.   FO : TEXT;
  25.  
  26.   T  : STRING;
  27.   T2 : STRING;
  28.  
  29.   FoundInterface : BOOLEAN;
  30.   FoundImp       : BOOLEAN;
  31.  
  32.   InComment      : BOOLEAN;
  33.   ThisFuncs      : LONGINT;
  34.  
  35. BEGIN
  36.  
  37.   Assign( FI, InFile );
  38.   Reset( FI );
  39.  
  40.   Assign( FO, OutFile );
  41.   Rewrite( FO );
  42.  
  43.   FoundInterface := FALSE;
  44.   FoundImp       := FALSE;
  45.  
  46.   ThisFuncs := 0;
  47.  
  48.   While (Not Eof( FI )) and (FoundImp=FALSE) Do
  49.   BEGIN
  50.  
  51.     ReadLn( FI, T );
  52.  
  53.     T2 := UpperString( TrimChar( T, onCenter, ' ' ));
  54.  
  55.     If T2 = 'IMPLEMENTATION' Then
  56.       FoundImp := TRUE
  57.     ELSE
  58.     BEGIN
  59.  
  60.       If T2 = 'INTERFACE' Then
  61.       BEGIN
  62.  
  63.         FoundInterface := TRUE;
  64.  
  65.       END
  66.       ELSE
  67.       BEGIN
  68.  
  69.         If (IncPreFace) or (FoundInterface) Then
  70.         BEGIN
  71.           WriteLn( FO, T );
  72.  
  73.         END;  { if incpreface or foundinterface }
  74.  
  75.       END; { if t2=interface / else }
  76.  
  77.     END; { if t2=implementation / else }
  78.  
  79.   END; { while not eof ... }
  80.  
  81.  
  82.  
  83.  
  84.   InComment := FALSE;
  85.  
  86.   If GetComments Then
  87.   While (Not Eof( FI )) Do
  88.   BEGIN
  89.  
  90.     ReadLn( FI, T );
  91.  
  92.     T2 := UpperString( TrimChar( T, onCenter, ' ' ));
  93.  
  94.  
  95.     If T2='[FUNCTION]' Then
  96.     BEGIN
  97.       Inc( ThisFuncs  );
  98.       Inc( TotalFuncs );
  99.  
  100.     END;
  101.  
  102.  
  103.     If Not InComment Then
  104.     BEGIN
  105.  
  106.       If Copy(T2, 1, 3)='(*-' Then
  107.       BEGIN
  108.         InComment := TRUE;
  109.  
  110.         WriteLn( FO, '' );
  111.         WriteLn( FO, RepeatString( '─', 78 ) );
  112.         WriteLn( FO, '' );
  113.  
  114.       END;
  115.  
  116.     END
  117.     ELSE
  118.     BEGIN
  119.  
  120.       If Copy(T2, 1, 3)='-*)' Then
  121.         InComment := FALSE
  122.       ELSE
  123.         WriteLn( FO, T );
  124.  
  125.     END;
  126.  
  127.   END;
  128.  
  129.  
  130.   Close( FI );
  131.   Close( FO );
  132.  
  133.   Write('  Functions/Procedures:',ThisFuncs );
  134.  
  135.  
  136. END; { procedure grabinterface }
  137.  
  138.  
  139. {----------------------------------------------------------------}
  140.  
  141.  
  142. Procedure SearchFiles( WildCard : STRING );
  143.  
  144.  
  145. Var
  146.  
  147.   DirInfo : SearchRec;
  148.  
  149.   DestFile : STRING;
  150.  
  151. BEGIN
  152.  
  153.   FindFirst( WildCard, Archive, DirInfo );
  154.  
  155.   While DosError = 0 Do
  156.   BEGIN
  157.  
  158.     DestFile := MaskWildCards( DirInfo.Name, '*.INT' );
  159.  
  160.     Write( DirInfo.Name+' -=> ', DestFile );
  161.  
  162.     GrabInterface( TRUE,
  163.                    TRUE,
  164.                    DirInfo.Name,
  165.                    DestFile      );
  166.  
  167.     WriteLn;
  168.  
  169.     FindNext(DirInfo);
  170.  
  171.   END;
  172.  
  173.   WriteLn;
  174.   WRiteLn;
  175.   WriteLn('Total functions/procedures:',TotalFuncs );
  176.  
  177. END;
  178.  
  179.  
  180. {----------------------------------------------------------------}
  181.  
  182. BEGIN
  183.  
  184.   WriteLn;
  185.   WriteLn('Visionix Grab Interface Program (VGI) 0.9');
  186.   WriteLN('Copyright 1993 Visionix');
  187.   WriteLn('ALL RIGHTS RESERVED');
  188.   WriteLn;
  189.  
  190.   If ParamCount=1 Then
  191.     SearchFiles( ParamStr( 1 ) )
  192.   ELSE
  193.     WriteLn('Usage:  VGI filespec');
  194.  
  195.   WriteLn;
  196.  
  197. END.