program PrintMe;
function GetUnitFileName(sLine :
String; sPath :
String) :
String;
begin
Result := Copy(sLine,Pos('
''
',sLine) + 1, Length(sLine));
Result := Copy(Result,1,Pos('
''
',Result) - 1);
if Pos('
..',Result) > 0
then Result := sPath + Result
else if Pos('
:' ,Result) = 0
then Result := sPath + Result;
end;
function GetUnitInfo(sUnit :
String; sl : TStringList) : Boolean;
var
slUnit : TStringList;
i : Integer;
s :
String;
begin
Result := FileExists(sUnit);
if not Result
then exit;
slUnit := TStringList.Create;
slUnit.LoadFromFile(sUnit);
sl.Add(Format('
Unit: %s',[ExtractFileName(sUnit)]));
for i := 0
to slUnit.Count - 1
do begin
s := Trim(AnsiLowerCase(slUnit[i]));
if s = '
implementation'
then begin
sl.Add('
');
break;
end;
if (Pos('
procedure',s) = 1)
or (Pos('
function',s) = 1)
then begin
s := Trim(slUnit[i]);
while Pos('
',s) > 0
do s := AnsiReplaceStr(s,'
','
');
sl.Add(s);
end;
end;
slUnit.Free;
end;
var
i : Integer;
sl : TStringList;
slDPR : TStringList;
sDPR :
String;
sUnit :
String;
sPath :
String;
begin
sl := TStringList.Create;
slDPR := TStringList.Create;
sDPR := '
e:\Delphi\Projekt1\Projekt1.dpr';
sPath := ExtractFilePath(sDPR);
slDPR.LoadFromFile(sDPR);
for i := 0
to slDPR.Count - 1
do begin
if Pos('
in ', slDPR[i]) > 0
then begin
sUnit := GetUnitFileName(slDPR[i],sPath);
GetUnitInfo(sUnit,sl);
end;
end;
sl.SaveToFile(Format('
%s.PrintMe',[sDPR]));
slDPR.Free;
sl.Free;
end.