home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / explorer / makecls.dpr < prev    next >
Encoding:
Text File  |  1995-03-21  |  2.8 KB  |  114 lines
  1. program MakeCls;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: EXPLORER }
  5.  
  6. uses
  7.   Classes,
  8.   WinCrt,
  9.   WinDos,
  10.   StrBox,
  11.   Strings;
  12.  
  13.  
  14. function IsUnique(ClassName: String; var SList: TStringList): Boolean;
  15. var
  16.   Dup: Boolean;
  17.   i: Integer;
  18. begin
  19.   Dup := False;
  20.   for i := 0 to SList.Count - 1 do begin
  21.     if ClassName = GetFirstWord(SList.Strings[i]) then begin
  22.       Dup := True;
  23.       break;
  24.     end;
  25.   end;
  26.   IsUnique := Dup;
  27. end;
  28.  
  29. function Parse(var OutList: Text; S, FName: String; var SList: TStringList) : String;
  30. var
  31.   Temp, Answer, ClassName, Parent: String;
  32.   Len, OffSet: Integer;
  33.   T: Boolean;
  34.   Position: Integer;
  35. begin
  36.   Temp := '';
  37.   OffSet := Pos('= class(', S);
  38.   if OffSet > 0 then begin
  39.     Temp := CleanString(S);
  40.     ClassName := GetFirstWord(Temp);
  41.     Len := Length(Temp) - (OffSet + 6);
  42.     Move(Temp[OffSet + 6], Parent[1], Len);
  43.     Parent[0] := Chr(Len);
  44.     Position := Pos(')', Parent);
  45.     if Position <> 0 then Parent[0] := Chr(Position);
  46.     If Parent[Length(Parent)] = ')' then
  47.       Dec(Parent[0]);
  48.     {WriteLn(OutList, '"', ClassName, '", ', '"', Parent, '"', ', "', FName, '"');}
  49.     {WriteLn(OutList, LeftSet(ClassName, 25, T), LeftSet(Parent, 25, T), FName);}
  50.     Answer := LeftSet(ClassName, 25, T) + LeftSet(Parent, 25, T) + FName;
  51.     if not IsUnique(ClassName, SList) then
  52.       SList.Add(Answer);
  53.   end;
  54.   Parse := Temp;
  55. end;
  56.  
  57. procedure ProcessList(var OutList: Text; SubDir, FName: String; var SList: TStringList);
  58. var
  59.   F: Text;
  60.   Temp, S: String;
  61. begin
  62.   Assign(F, SubDir + FName);
  63.   Reset(F);
  64.   while not EOF(F) do begin
  65.     ReadLn(F, S);
  66.     Temp := Parse(OutList, S, FName, SList);
  67.   end;
  68.   Close(F);
  69. end;
  70.  
  71. procedure FindDir(var OutList: Text;
  72.                   SubDir: String;
  73.                   var TotalFiles: Integer;
  74.                   var SList: TStringList);
  75. var
  76.   SR: TSearchRec;
  77.   SDir: array[0..100] of Char;
  78. begin
  79.   StrPCopy(SDir, SubDir);
  80.   StrCat(SDir, '*.pas');
  81.   FindFirst(SDir, faArchive, SR);
  82.   while DosError = 0 do begin
  83.     Inc(TotalFiles);
  84.     FindNext(SR);
  85.     GotoXY(1,1);
  86.     WriteLn('Processing: ', SR.Name, '         ');
  87.     GotoXY(1,2);
  88.     WriteLn('Files Parsed: ', TotalFiles, '          ');
  89.     ProcessList(OutList, SubDir, StrPas(SR.Name), SList);
  90.   end;
  91. end;
  92.  
  93. const
  94.   SubDir1 = 'c:\appbuild\rtl\vcl\';
  95.   SubDir2 = 'c:\appbuild\rtl\sys\';
  96.  
  97. var
  98.   OutList: Text;
  99.   TotalFiles: Integer;
  100.   SList: TStringList;
  101.  
  102. begin
  103.   ClrScr;
  104.   TotalFiles := 0;
  105.   SList := TStringList.Create;
  106.   Assign(OutList, 'e:\delphi\getclass\class1.lst');
  107.   ReWrite(OutList);
  108.   FindDir(OutList, SubDir1, TotalFiles, SList);
  109.   FindDir(OutList, SubDir2, TotalFiles, SList);
  110.   Close(OutList);
  111.   SList.SaveToFile('e:\delphi\getclass\class1.lst');
  112.   SList.Free;
  113. end.
  114.