home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / explorer / makecls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  3.1 KB  |  137 lines
  1. unit MakeCls;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: EXPLORER }
  5.  
  6. interface
  7.  
  8. uses
  9.   Classes,
  10.   SysUtils,
  11.   Forms,
  12.   StrUtils,
  13.   Status,
  14.   Dialogs;
  15.  
  16. procedure MakeList(SubDirList: TStringList; OutFile: String);
  17.  
  18. implementation
  19.  
  20. uses
  21.   WinTypes,
  22.   WinProcs,
  23.   Messages;
  24.  
  25. function IsUnique(ClassName: String; SList: TStringList): Boolean;
  26. var
  27.   Dup: Boolean;
  28.   i: Integer;
  29. begin
  30.   Dup := False;
  31.   for i := 0 to SList.Count - 1 do begin
  32.     if ClassName = GetFirstWord(SList.Strings[i]) then begin
  33.       Dup := True;
  34.       break;
  35.     end;
  36.   end;
  37.   IsUnique := Dup;
  38. end;
  39.  
  40. function Parse(var OutList: TextFile; S, FName: String;
  41.                SList: TStringList) : String;
  42. var
  43.   Temp, Answer, ClassName, Parent: String;
  44.   Len, OffSet: Integer;
  45.   T: Boolean;
  46.   Position: Integer;
  47.   AddMe : Integer;
  48. begin
  49.   Temp := '';
  50.   S := StripSpaces(S);
  51.   OffSet := Pos('=class(', S);
  52.   Addme := Length('=class(');
  53.  
  54.   if OffSet = 0 then
  55.   begin
  56.     OffSet := Pos('=object(', S);
  57.     AddMe := Length('=object(');
  58.   end;
  59.  
  60.   if OffSet > 0 then begin
  61.     Temp := S;
  62.     ClassName := Copy(Temp, 1, (Pos('=', S) - 1));
  63.     Parent := Copy(Temp, (Offset + AddMe), Length(S));
  64.     Position := Pos(')', Parent);
  65.     if Position <> 0 then Parent[0] := Chr(Position - 1);
  66.     Answer := LeftSet(ClassName, 25, T) + LeftSet(Parent, 25, T) + FName;
  67.     if not IsUnique(ClassName, SList) then
  68.       SList.Add(Answer);
  69.   end;
  70.   Parse := Temp;
  71. end;
  72.  
  73.  
  74. procedure ProcessList(var OutList: TextFile; SubDir, FName: String;
  75.                       SList: TStringList);
  76. var
  77.   F: TextFile;
  78.   Temp, S: String;
  79. begin
  80.   AssignFile(F, AddBackSlash(SubDir) + FName);
  81.   Reset(F);
  82.   while not EOF(F) do begin
  83.     ReadLn(F, S);
  84.     Temp := Parse(OutList, S, FName, SList);
  85.   end;
  86.   CloseFile(F);
  87. end;
  88.  
  89. procedure FindDir(var OutList: TextFile; SubDir: String;
  90.                   var TotalFiles: Integer; SList: TStringList);
  91. var
  92.   SR: TSearchRec;
  93.   StTotalFiles : String;
  94.   FindError: Integer;
  95. begin
  96.   FindError := FindFirst(AddBackSlash(SubDir) + '*.pas', faArchive, SR);
  97.   while FindError = 0 do begin
  98.     Application.ProcessMessages;
  99.     Inc(TotalFiles);
  100.     UpStatus.Label3.Caption := SR.Name;
  101.     Str(TotalFiles, StTotalFiles);
  102.     UpStatus.Label5.Caption := StTotalFiles;
  103.     ProcessList(OutList, SubDir, SR.Name, SList);
  104.     FindError := FindNext(SR);
  105.   end;
  106. end;
  107.  
  108. var
  109.   OutList: TextFile;
  110.   TotalFiles: Integer;
  111.   SList: TStringList;
  112.  
  113. procedure MakeList(SubDirList: TStringList; OutFile: String);
  114. {
  115.   This procedure creates the list that is used by the Object Explorer.
  116.   It takes a TStringList that contains a list of subdirs to parse and
  117.   a string that contains the path and name of the Output file.
  118. }
  119. var
  120.   i : integer;
  121.   p : integer;
  122. begin
  123.   TotalFiles := 0;
  124.   SList := TStringList.Create;
  125.   AssignFile(OutList, OutFile);
  126.   Rewrite(OutList);
  127.   UpStatus.Show;
  128.   for i := 1 to SubDirList.Count do
  129.     FindDir(OutList, SubDirList.Strings[i-1], TotalFiles, SList);
  130.   UpStatus.Close;
  131.   CloseFile(OutList);
  132.   SList.SaveToFile(OutFile);
  133.   SList.Free;
  134. end;
  135.  
  136. end.
  137.