Pascal Interface Extract
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,991 @@
|
||||
program ExtractPascalInterfaces;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.IOUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
System.Generics.Defaults,
|
||||
System.StrUtils,
|
||||
System.Types,
|
||||
System.Character,
|
||||
Winapi.Windows; // For clipboard access
|
||||
|
||||
type
|
||||
{ Forward declaration for TUnitInfoList needed in TUnitInfo }
|
||||
TUnitInfo = class;
|
||||
TUnitInfoList = TList<TUnitInfo>;
|
||||
|
||||
{ TUnitInfo holds information about a single Pascal unit }
|
||||
TUnitInfo = class
|
||||
private
|
||||
FOriginalLines: TStringList;
|
||||
procedure ExtractUsesFromClause(const Clause: string);
|
||||
function StripCommentsFromUsesBlock(const Block: string): string;
|
||||
function FindTerminatingSemicolon(const Block: string): Integer;
|
||||
function CheckAndExtractKeywordContent(
|
||||
const LineInput: string;
|
||||
const KeywordUpperCase: string;
|
||||
out ContentAfterKeyword: string
|
||||
): Boolean;
|
||||
public
|
||||
Name: string;
|
||||
NormalizedName: string;
|
||||
FilePath: string;
|
||||
InterfaceSection: TStringList;
|
||||
InterfaceUses: TStringList;
|
||||
|
||||
AdjacencyList: TUnitInfoList;
|
||||
InDegree: Integer;
|
||||
Processed: Boolean;
|
||||
|
||||
constructor Create(const AFilePath: string);
|
||||
destructor Destroy; override;
|
||||
function ParseUnit: Boolean;
|
||||
end;
|
||||
|
||||
const
|
||||
DefaultExcludedDirNames: array[0..6] of string = ('.svn', '.git', '.hg', '__history', '__recovery', '.vs', '.vscode');
|
||||
|
||||
// Helper procedure to set clipboard text using WinAPI
|
||||
procedure SetClipboardText(const Text: string);
|
||||
var
|
||||
hGlobal: THandle;
|
||||
pGlobal: Pointer;
|
||||
begin
|
||||
if not OpenClipboard(0) then
|
||||
RaiseLastOSError;
|
||||
try
|
||||
EmptyClipboard;
|
||||
hGlobal := GlobalAlloc(GMEM_MOVEABLE, (Length(Text) + 1) * SizeOf(Char));
|
||||
if hGlobal = 0 then
|
||||
RaiseLastOSError;
|
||||
|
||||
pGlobal := GlobalLock(hGlobal);
|
||||
if pGlobal = nil then
|
||||
begin
|
||||
GlobalFree(hGlobal);
|
||||
RaiseLastOSError;
|
||||
end;
|
||||
|
||||
try
|
||||
Move(PChar(Text)^, pGlobal^, (Length(Text) + 1) * SizeOf(Char));
|
||||
finally
|
||||
GlobalUnlock(hGlobal);
|
||||
end;
|
||||
|
||||
if SetClipboardData(CF_UNICODETEXT, hGlobal) = 0 then
|
||||
begin
|
||||
GlobalFree(hGlobal); // We must free it if SetClipboardData fails
|
||||
RaiseLastOSError;
|
||||
end;
|
||||
// On success, the system owns the memory handle.
|
||||
finally
|
||||
CloseClipboard;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TUnitInfo implementation }
|
||||
constructor TUnitInfo.Create(const AFilePath: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FilePath := AFilePath;
|
||||
Name := '';
|
||||
NormalizedName := '';
|
||||
InterfaceSection := TStringList.Create;
|
||||
InterfaceUses := TStringList.Create;
|
||||
FOriginalLines := TStringList.Create;
|
||||
AdjacencyList := TUnitInfoList.Create;
|
||||
InDegree := 0;
|
||||
Processed := False;
|
||||
end;
|
||||
|
||||
destructor TUnitInfo.Destroy;
|
||||
begin
|
||||
InterfaceSection.Free;
|
||||
InterfaceUses.Free;
|
||||
FOriginalLines.Free;
|
||||
AdjacencyList.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TUnitInfo.StripCommentsFromUsesBlock(const Block: string): string;
|
||||
var
|
||||
Builder: TStringBuilder;
|
||||
i: Integer;
|
||||
L: Integer;
|
||||
inLineComment: Boolean;
|
||||
inBlockCommentParen: Boolean;
|
||||
inBlockCommentBrace: Boolean;
|
||||
currentChar, nextChar: Char;
|
||||
tempResult: string;
|
||||
begin
|
||||
Builder := TStringBuilder.Create;
|
||||
L := Length(Block);
|
||||
i := 1;
|
||||
inLineComment := False;
|
||||
inBlockCommentParen := False;
|
||||
inBlockCommentBrace := False;
|
||||
while i <= L do
|
||||
begin
|
||||
currentChar := Block[i];
|
||||
if i < L then
|
||||
nextChar := Block[i + 1]
|
||||
else
|
||||
nextChar := #0;
|
||||
if inLineComment then
|
||||
begin
|
||||
if (currentChar = #13) or (currentChar = #10) then
|
||||
begin
|
||||
inLineComment := False;
|
||||
if (Builder.Length > 0) and (Builder[Builder.Length-1] <> ' ') and (Builder[Builder.Length-1] <> ',') then
|
||||
Builder.Append(' ');
|
||||
end;
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if inBlockCommentParen then
|
||||
begin
|
||||
if (currentChar = '*') and (nextChar = ')') then
|
||||
begin
|
||||
inBlockCommentParen := False;
|
||||
Inc(i, 2);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if inBlockCommentBrace then
|
||||
begin
|
||||
if currentChar = '}' then
|
||||
begin
|
||||
inBlockCommentBrace := False;
|
||||
Inc(i);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if (currentChar = '/') and (nextChar = '/') then
|
||||
begin
|
||||
inLineComment := True;
|
||||
Inc(i, 2);
|
||||
Continue;
|
||||
end;
|
||||
if (currentChar = '(') and (nextChar = '*') then
|
||||
begin
|
||||
inBlockCommentParen := True;
|
||||
Inc(i, 2);
|
||||
Continue;
|
||||
end;
|
||||
if currentChar = '{' then
|
||||
begin
|
||||
inBlockCommentBrace := True;
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if (currentChar = #13) or (currentChar = #10) or (currentChar = #9) then
|
||||
begin
|
||||
if (Builder.Length = 0) or ((Builder.Length > 0) and (Builder[Builder.Length-1] <> ' ')) then
|
||||
Builder.Append(' ');
|
||||
Inc(i);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Builder.Append(currentChar);
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
tempResult := Trim(Builder.ToString);
|
||||
Builder.Free;
|
||||
while Pos(' ', tempResult) > 0 do
|
||||
tempResult := StringReplace(tempResult, ' ', ' ', [rfReplaceAll]);
|
||||
tempResult := StringReplace(tempResult, ' ,', ',', [rfReplaceAll]);
|
||||
tempResult := StringReplace(tempResult, ', ', ',', [rfReplaceAll]);
|
||||
Result := tempResult;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.ExtractUsesFromClause(const Clause: string);
|
||||
var
|
||||
parts: TArray<string>;
|
||||
partName: string;
|
||||
begin
|
||||
if Trim(Clause) = '' then
|
||||
Exit;
|
||||
parts := Clause.Split([','], TStringSplitOptions.ExcludeEmpty);
|
||||
for partName in parts do
|
||||
begin
|
||||
var pn := Trim(partName);
|
||||
if pn <> '' then
|
||||
InterfaceUses.Add(System.SysUtils.LowerCase(pn));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUnitInfo.FindTerminatingSemicolon(const Block: string): Integer;
|
||||
var
|
||||
i: Integer;
|
||||
L: Integer;
|
||||
inLineComment: Boolean;
|
||||
inBlockCommentParen: Boolean;
|
||||
inBlockCommentBrace: Boolean;
|
||||
currentChar: Char;
|
||||
nextChar: Char;
|
||||
begin
|
||||
Result := 0;
|
||||
L := Length(Block);
|
||||
i := 1;
|
||||
inLineComment := False;
|
||||
inBlockCommentParen := False;
|
||||
inBlockCommentBrace := False;
|
||||
while i <= L do
|
||||
begin
|
||||
currentChar := Block[i];
|
||||
if i < L then
|
||||
nextChar := Block[i + 1]
|
||||
else
|
||||
nextChar := #0;
|
||||
if inLineComment then
|
||||
begin
|
||||
if (currentChar = #13) or (currentChar = #10) then
|
||||
inLineComment := False;
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if inBlockCommentParen then
|
||||
begin
|
||||
if (currentChar = '*') and (nextChar = ')') then
|
||||
begin
|
||||
inBlockCommentParen := False;
|
||||
Inc(i, 2);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if inBlockCommentBrace then
|
||||
begin
|
||||
if currentChar = '}' then
|
||||
begin
|
||||
inBlockCommentBrace := False;
|
||||
Inc(i);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if (currentChar = '/') and (nextChar = '/') then
|
||||
begin
|
||||
inLineComment := True;
|
||||
Inc(i, 2);
|
||||
Continue;
|
||||
end;
|
||||
if (currentChar = '(') and (nextChar = '*') then
|
||||
begin
|
||||
inBlockCommentParen := True;
|
||||
Inc(i, 2);
|
||||
Continue;
|
||||
end;
|
||||
if currentChar = '{' then
|
||||
begin
|
||||
inBlockCommentBrace := True;
|
||||
Inc(i);
|
||||
Continue;
|
||||
end;
|
||||
if currentChar = ';' then
|
||||
begin
|
||||
Result := i;
|
||||
Exit;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUnitInfo.CheckAndExtractKeywordContent(
|
||||
const LineInput: string;
|
||||
const KeywordUpperCase: string;
|
||||
out ContentAfterKeyword: string
|
||||
): Boolean;
|
||||
var
|
||||
trimmedLine: string;
|
||||
keywordLen: Integer;
|
||||
charAfterKeyword: Char;
|
||||
begin
|
||||
Result := False;
|
||||
ContentAfterKeyword := '';
|
||||
trimmedLine := Trim(LineInput);
|
||||
keywordLen := Length(KeywordUpperCase);
|
||||
if Length(trimmedLine) >= keywordLen then
|
||||
begin
|
||||
if System.SysUtils.UpperCase(Copy(trimmedLine, 1, keywordLen)) = KeywordUpperCase then
|
||||
begin
|
||||
if Length(trimmedLine) = keywordLen then
|
||||
begin
|
||||
Result := True;
|
||||
ContentAfterKeyword := '';
|
||||
end
|
||||
else
|
||||
begin
|
||||
charAfterKeyword := trimmedLine[keywordLen + 1];
|
||||
if not charAfterKeyword.IsLetterOrDigit then
|
||||
begin
|
||||
Result := True;
|
||||
ContentAfterKeyword := Trim(Copy(trimmedLine, keywordLen + 1, MaxInt));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUnitInfo.ParseUnit: Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
LineValue: string;
|
||||
upperLine: string;
|
||||
inInterface: Boolean;
|
||||
inUsesBlock: Boolean;
|
||||
usesBuilder: TStringBuilder;
|
||||
potentialUnitNameLine: string;
|
||||
nameExtracted: Boolean;
|
||||
contentAfterKeyword: string;
|
||||
accumulatedContent: string;
|
||||
trueEndOfUsesPos: Integer;
|
||||
contentToClean: string;
|
||||
cleanedContent: string;
|
||||
begin
|
||||
Result := False;
|
||||
if not TFile.Exists(FilePath) then
|
||||
exit;
|
||||
FOriginalLines.LoadFromFile(FilePath);
|
||||
inInterface := False;
|
||||
inUsesBlock := False;
|
||||
nameExtracted := False;
|
||||
usesBuilder := TStringBuilder.Create;
|
||||
try
|
||||
for i := 0 to FOriginalLines.Count - 1 do
|
||||
begin
|
||||
LineValue := FOriginalLines[i];
|
||||
upperLine := System.SysUtils.UpperCase(Trim(LineValue));
|
||||
|
||||
if not nameExtracted and CheckAndExtractKeywordContent(LineValue, 'UNIT', contentAfterKeyword) then
|
||||
begin
|
||||
potentialUnitNameLine := contentAfterKeyword;
|
||||
if Pos(';', potentialUnitNameLine) > 0 then
|
||||
Name := Trim(Copy(potentialUnitNameLine, 1, Pos(';', potentialUnitNameLine) - 1))
|
||||
else
|
||||
Name := Trim(potentialUnitNameLine);
|
||||
if Name <> '' then
|
||||
begin
|
||||
NormalizedName := System.SysUtils.LowerCase(Name);
|
||||
nameExtracted := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteLn('Warning: Could not parse unit name from: ' + LineValue + ' in file ' + FilePath);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not inInterface and upperLine.StartsWith('INTERFACE') then
|
||||
begin
|
||||
inInterface := True;
|
||||
end;
|
||||
|
||||
if inInterface then
|
||||
begin
|
||||
if upperLine.StartsWith('IMPLEMENTATION') or upperLine.StartsWith('END.') then
|
||||
begin
|
||||
if inUsesBlock and (usesBuilder.Length > 0) then
|
||||
begin
|
||||
accumulatedContent := usesBuilder.ToString;
|
||||
trueEndOfUsesPos := FindTerminatingSemicolon(accumulatedContent);
|
||||
if trueEndOfUsesPos > 0 then
|
||||
contentToClean := Trim(Copy(accumulatedContent, 1, trueEndOfUsesPos - 1))
|
||||
else
|
||||
contentToClean := Trim(accumulatedContent);
|
||||
if contentToClean <> '' then
|
||||
begin
|
||||
cleanedContent := StripCommentsFromUsesBlock(contentToClean);
|
||||
if Trim(cleanedContent) <> '' then
|
||||
ExtractUsesFromClause(cleanedContent);
|
||||
end;
|
||||
end;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
var lineIsForUses := inUsesBlock;
|
||||
if not inUsesBlock and CheckAndExtractKeywordContent(LineValue, 'USES', contentAfterKeyword) then
|
||||
begin
|
||||
usesBuilder.Clear;
|
||||
inUsesBlock := True;
|
||||
usesBuilder.AppendLine(contentAfterKeyword); // Use AppendLine to preserve structure for comment stripping
|
||||
lineIsForUses := True;
|
||||
end
|
||||
else if inUsesBlock then
|
||||
begin
|
||||
// FIXED: Use AppendLine to preserve newlines for comment stripping logic
|
||||
usesBuilder.AppendLine(Trim(LineValue));
|
||||
lineIsForUses := True;
|
||||
end;
|
||||
|
||||
if not upperLine.StartsWith('INTERFACE') and not lineIsForUses then
|
||||
begin
|
||||
InterfaceSection.Add(LineValue);
|
||||
end;
|
||||
|
||||
if inUsesBlock then
|
||||
begin
|
||||
accumulatedContent := usesBuilder.ToString;
|
||||
trueEndOfUsesPos := FindTerminatingSemicolon(accumulatedContent);
|
||||
if trueEndOfUsesPos > 0 then
|
||||
begin
|
||||
contentToClean := Trim(Copy(accumulatedContent, 1, trueEndOfUsesPos - 1));
|
||||
usesBuilder.Clear;
|
||||
inUsesBlock := False;
|
||||
if contentToClean <> '' then
|
||||
begin
|
||||
cleanedContent := StripCommentsFromUsesBlock(contentToClean);
|
||||
if Trim(cleanedContent) <> '' then
|
||||
ExtractUsesFromClause(cleanedContent);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if inInterface then
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
finally
|
||||
usesBuilder.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CollectPasFilesRecursively(const Path: string; Files: TStringList; const ExcludedDirPatterns: TStrings);
|
||||
var
|
||||
dirName: string;
|
||||
foundPasFiles: TStringDynArray;
|
||||
subDirs: TStringDynArray;
|
||||
i: Integer;
|
||||
currentSubDir: string;
|
||||
isExcluded: Boolean;
|
||||
exclusionPattern: string;
|
||||
begin
|
||||
try
|
||||
foundPasFiles := TDirectory.GetFiles(Path, '*.pas', TSearchOption.soTopDirectoryOnly);
|
||||
for i := Low(foundPasFiles) to High(foundPasFiles) do
|
||||
Files.Add(foundPasFiles[i]);
|
||||
except
|
||||
on E: EDirectoryNotFoundException do
|
||||
begin
|
||||
WriteLn('Warning: Could not access path ' + Path + ' while scanning files: ' + E.Message);
|
||||
Exit;
|
||||
end;
|
||||
on E: EInOutError do
|
||||
begin
|
||||
WriteLn('Warning: IO error accessing path ' + Path + ' while scanning files: ' + E.Message);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
try
|
||||
subDirs := TDirectory.GetDirectories(Path);
|
||||
except
|
||||
on E: EDirectoryNotFoundException do
|
||||
begin
|
||||
WriteLn('Warning: Could not access path ' + Path + ' while scanning subdirectories: ' + E.Message);
|
||||
Exit;
|
||||
end;
|
||||
on E: EInOutError do
|
||||
begin
|
||||
WriteLn('Warning: IO error accessing path ' + Path + ' while scanning subdirectories: ' + E.Message);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
for currentSubDir in subDirs do
|
||||
begin
|
||||
dirName := ExtractFileName(currentSubDir);
|
||||
isExcluded := False;
|
||||
for exclusionPattern in ExcludedDirPatterns do
|
||||
begin
|
||||
if SameText(dirName, exclusionPattern) then
|
||||
begin
|
||||
isExcluded := True;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if not isExcluded then
|
||||
CollectPasFilesRecursively(currentSubDir, Files, ExcludedDirPatterns);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
allUnits: TDictionary<string, TUnitInfo>;
|
||||
sortedUnits: TList<TUnitInfo>;
|
||||
sourceDirectories: TList<string>;
|
||||
processingQueue: TQueue<TUnitInfo>;
|
||||
excludedDirectoryPatternsList: TStringList;
|
||||
allFoundPasFilesList: TStringList;
|
||||
item: TUnitInfo;
|
||||
outputLineText: string;
|
||||
recursiveSearch: Boolean;
|
||||
outputFileName: string;
|
||||
writeToClipboard: Boolean;
|
||||
currentParamIndex: Integer;
|
||||
focusMode: Boolean;
|
||||
focusFilesParameter: string;
|
||||
initialFocusFiles: TStringList;
|
||||
filesToExcludeFromOutput: TStringList;
|
||||
|
||||
begin
|
||||
recursiveSearch := False;
|
||||
outputFileName := '';
|
||||
writeToClipboard := False;
|
||||
sourceDirectories := nil;
|
||||
allUnits := nil;
|
||||
sortedUnits := nil;
|
||||
processingQueue := nil;
|
||||
excludedDirectoryPatternsList := nil;
|
||||
allFoundPasFilesList := nil;
|
||||
initialFocusFiles := nil;
|
||||
filesToExcludeFromOutput := nil;
|
||||
exitcode := 0;
|
||||
focusMode := False;
|
||||
focusFilesParameter := '';
|
||||
|
||||
try
|
||||
var usageStr := 'Usage: ExtractPascalInterfaces.exe [-r] [-dirs <file>] [-f <files> | -fx <files>] [-o <file> | -c] <SrcDir1> ...';
|
||||
|
||||
WriteLn('Delphi Interface Extractor');
|
||||
sourceDirectories := TList<string>.Create;
|
||||
excludedDirectoryPatternsList := TStringList.Create;
|
||||
initialFocusFiles := TStringList.Create;
|
||||
filesToExcludeFromOutput := TStringList.Create;
|
||||
for var excludedName in DefaultExcludedDirNames do
|
||||
excludedDirectoryPatternsList.Add(excludedName);
|
||||
|
||||
currentParamIndex := 1;
|
||||
while currentParamIndex <= ParamCount do
|
||||
begin
|
||||
var currentParam := ParamStr(currentParamIndex);
|
||||
|
||||
if SameText(currentParam, '-r') then
|
||||
begin
|
||||
recursiveSearch := True;
|
||||
Inc(currentParamIndex);
|
||||
end
|
||||
else if SameText(currentParam, '-c') then
|
||||
begin
|
||||
writeToClipboard := True;
|
||||
Inc(currentParamIndex);
|
||||
end
|
||||
else if SameText(currentParam, '-o') then
|
||||
begin
|
||||
if currentParamIndex + 1 <= ParamCount then
|
||||
begin
|
||||
outputFileName := ParamStr(currentParamIndex + 1);
|
||||
Inc(currentParamIndex, 2);
|
||||
end
|
||||
else begin WriteLn('Error: Missing filename after -o option.'); WriteLn(usageStr); exitcode := 1; exit; end;
|
||||
end
|
||||
else if SameText(currentParam, '-dirs') then
|
||||
begin
|
||||
if currentParamIndex + 1 <= ParamCount then
|
||||
begin
|
||||
var dirsFileName := ParamStr(currentParamIndex + 1);
|
||||
if TFile.Exists(dirsFileName) then
|
||||
begin
|
||||
var dirsFromFile := TStringList.Create;
|
||||
try
|
||||
dirsFromFile.LoadFromFile(dirsFileName);
|
||||
for var dirPath in dirsFromFile do
|
||||
sourceDirectories.Add(dirPath);
|
||||
finally
|
||||
dirsFromFile.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
WriteLn('Warning: File specified with -dirs not found: ' + dirsFileName);
|
||||
Inc(currentParamIndex, 2);
|
||||
end
|
||||
else begin WriteLn('Error: Missing filename after -dirs option.'); WriteLn(usageStr); exitcode := 1; exit; end;
|
||||
end
|
||||
else if SameText(currentParam, '-f') or SameText(currentParam, '-fx') then
|
||||
begin
|
||||
if focusMode then
|
||||
begin WriteLn('Error: -f and -fx options cannot be used together.'); WriteLn(usageStr); exitcode := 1; exit; end;
|
||||
|
||||
if currentParamIndex + 1 <= ParamCount then
|
||||
begin
|
||||
focusMode := True;
|
||||
focusFilesParameter := ParamStr(currentParamIndex + 1);
|
||||
initialFocusFiles.Text := StringReplace(focusFilesParameter, ';', sLineBreak, [rfReplaceAll]);
|
||||
if SameText(currentParam, '-fx') then
|
||||
filesToExcludeFromOutput.Text := initialFocusFiles.Text;
|
||||
Inc(currentParamIndex, 2);
|
||||
end
|
||||
else begin WriteLn('Error: Missing file list after ' + currentParam + ' option.'); WriteLn(usageStr); exitcode := 1; exit; end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
sourceDirectories.Add(currentParam);
|
||||
inc( currentParamIndex );
|
||||
end;
|
||||
end;
|
||||
|
||||
var i := sourceDirectories.Count - 1;
|
||||
while i >= 0 do
|
||||
begin
|
||||
var trimmedPath := Trim(sourceDirectories[i]);
|
||||
if (trimmedPath = '') or (not TDirectory.Exists(trimmedPath)) then
|
||||
begin
|
||||
if trimmedPath <> '' then
|
||||
WriteLn('Warning: Directory "' + trimmedPath + '" not found or is not a directory. Skipping.');
|
||||
sourceDirectories.Delete(i);
|
||||
end
|
||||
else
|
||||
sourceDirectories[i] := trimmedPath;
|
||||
Dec(i);
|
||||
end;
|
||||
|
||||
|
||||
if writeToClipboard and (outputFileName <> '') then
|
||||
begin
|
||||
WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.');
|
||||
exitcode := 1;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if sourceDirectories.Count = 0 then
|
||||
begin
|
||||
WriteLn('Error: No source directories specified.');
|
||||
WriteLn(usageStr);
|
||||
exitcode := 1;
|
||||
exit;
|
||||
end;
|
||||
|
||||
allFoundPasFilesList := TStringList.Create;
|
||||
WriteLn(IfThen(recursiveSearch, 'Recursive search enabled.', 'Non-recursive search.'));
|
||||
|
||||
for var currentScanDir in sourceDirectories do
|
||||
begin
|
||||
WriteLn('Scanning directory: ' + currentScanDir + IfThen(recursiveSearch, ' (recursively)', ''));
|
||||
if recursiveSearch then
|
||||
CollectPasFilesRecursively(currentScanDir, allFoundPasFilesList, excludedDirectoryPatternsList)
|
||||
else
|
||||
begin
|
||||
var filesInDir := TDirectory.GetFiles(currentScanDir, '*.pas', TSearchOption.soTopDirectoryOnly);
|
||||
for var fName in filesInDir do
|
||||
allFoundPasFilesList.Add(fName);
|
||||
end;
|
||||
end;
|
||||
|
||||
if focusMode then
|
||||
begin
|
||||
for var focusFile in initialFocusFiles do
|
||||
begin
|
||||
if not TFile.Exists(focusFile) then
|
||||
begin WriteLn('Warning: Focus file not found, skipping: ' + focusFile); Continue; end;
|
||||
if allFoundPasFilesList.IndexOf(focusFile) = -1 then
|
||||
allFoundPasFilesList.Add(focusFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
if allFoundPasFilesList.Count = 0 then
|
||||
begin WriteLn('No .pas files found in any specified directory (respecting exclusions).'); exit; end;
|
||||
|
||||
allUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal);
|
||||
sortedUnits := TList<TUnitInfo>.Create;
|
||||
processingQueue := TQueue<TUnitInfo>.Create;
|
||||
|
||||
WriteLn('Found ' + IntToStr(allFoundPasFilesList.Count) + ' .pas files in total. Parsing...');
|
||||
for var filePathKey in allFoundPasFilesList do
|
||||
begin
|
||||
var unitInfo := TUnitInfo.Create(filePathKey);
|
||||
if unitInfo.ParseUnit then
|
||||
begin
|
||||
if unitInfo.Name <> '' then
|
||||
begin
|
||||
if not allUnits.ContainsKey(unitInfo.NormalizedName) then
|
||||
allUnits.Add(unitInfo.NormalizedName, unitInfo)
|
||||
else
|
||||
begin
|
||||
WriteLn('Warning: Duplicate unit name "' + unitInfo.Name + '" found.');
|
||||
WriteLn(' Existing: ' + allUnits[unitInfo.NormalizedName].FilePath);
|
||||
WriteLn(' Skipped: ' + unitInfo.FilePath);
|
||||
unitInfo.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin WriteLn('Warning: Could not determine unit name for file: ' + filePathKey + '. Skipping.'); unitInfo.Free; end;
|
||||
end
|
||||
else
|
||||
begin WriteLn('Warning: Failed to parse unit: ' + filePathKey + '. Skipping.'); unitInfo.Free; end;
|
||||
end;
|
||||
|
||||
if allUnits.Count = 0 then
|
||||
begin WriteLn('No units successfully parsed.'); exit; end;
|
||||
|
||||
if focusMode then
|
||||
begin
|
||||
WriteLn('Focus mode active. Finding dependency cone for files: ' + focusFilesParameter);
|
||||
var workQueue := TQueue<TUnitInfo>.Create;
|
||||
var requiredUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal);
|
||||
var unitsToRemove := TStringList.Create;
|
||||
try
|
||||
for var unitInfo in allUnits.Values do
|
||||
begin
|
||||
if initialFocusFiles.IndexOf(unitInfo.FilePath) > -1 then
|
||||
begin
|
||||
if not requiredUnits.ContainsKey(unitInfo.NormalizedName) then
|
||||
begin
|
||||
workQueue.Enqueue(unitInfo);
|
||||
requiredUnits.Add(unitInfo.NormalizedName, unitInfo);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if requiredUnits.Count = 0 then
|
||||
WriteLn('Warning: None of the initial focus files could be parsed successfully.');
|
||||
|
||||
while workQueue.Count > 0 do
|
||||
begin
|
||||
var currentUnit := workQueue.Dequeue;
|
||||
for var usedUnitName in currentUnit.InterfaceUses do
|
||||
begin
|
||||
var dependencyUnit: TUnitInfo;
|
||||
if allUnits.TryGetValue(usedUnitName, dependencyUnit) and (not requiredUnits.ContainsKey(usedUnitName)) then
|
||||
begin
|
||||
requiredUnits.Add(dependencyUnit.NormalizedName, dependencyUnit);
|
||||
workQueue.Enqueue(dependencyUnit);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
WriteLn('Found ' + requiredUnits.Count.ToString + ' required units in total.');
|
||||
for var unitInfo in allUnits.Values do
|
||||
if not requiredUnits.ContainsKey(unitInfo.NormalizedName) then
|
||||
unitsToRemove.Add(unitInfo.NormalizedName);
|
||||
|
||||
if unitsToRemove.Count > 0 then
|
||||
begin
|
||||
WriteLn('Filtering out ' + unitsToRemove.Count.ToString + ' unneeded units...');
|
||||
for var unitNameToRemove in unitsToRemove do
|
||||
begin
|
||||
allUnits[unitNameToRemove].Free;
|
||||
allUnits.Remove(unitNameToRemove);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
workQueue.Free;
|
||||
requiredUnits.Free;
|
||||
unitsToRemove.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
WriteLn('Building dependency graph...');
|
||||
for var currentUnit in allUnits.Values do
|
||||
for var usedUnitName in currentUnit.InterfaceUses do
|
||||
begin
|
||||
var usedUnitInfo: TUnitInfo;
|
||||
if allUnits.TryGetValue(usedUnitName, usedUnitInfo) then
|
||||
begin
|
||||
currentUnit.InDegree := currentUnit.InDegree + 1;
|
||||
usedUnitInfo.AdjacencyList.Add(currentUnit);
|
||||
end;
|
||||
end;
|
||||
|
||||
WriteLn('');
|
||||
WriteLn('--------------------------------------------------------------------------------');
|
||||
WriteLn('Dependency Graph (Project Units Only):');
|
||||
WriteLn('--------------------------------------------------------------------------------');
|
||||
if allUnits.Count = 0 then
|
||||
WriteLn('(No units to display in graph)')
|
||||
else
|
||||
begin
|
||||
var tempUnitListForDisplay: TList<TUnitInfo>;
|
||||
tempUnitListForDisplay := TList<TUnitInfo>.Create(allUnits.Values);
|
||||
try
|
||||
tempUnitListForDisplay.Sort(
|
||||
TComparer<TUnitInfo>
|
||||
.Construct(function(const L, R: TUnitInfo): Integer begin Result := CompareText(L.Name, R.Name); end)
|
||||
);
|
||||
for var unitToDisplay in tempUnitListForDisplay do
|
||||
begin
|
||||
var usesClauseText := '';
|
||||
var projectDependenciesFound := False;
|
||||
if unitToDisplay.InterfaceUses.Count > 0 then
|
||||
begin
|
||||
var usedUnitDisplayNames := TStringList.Create;
|
||||
try
|
||||
for var usedNormalizedName in unitToDisplay.InterfaceUses do
|
||||
begin
|
||||
var usedUnitActualInfo: TUnitInfo;
|
||||
if allUnits.TryGetValue(usedNormalizedName, usedUnitActualInfo) then
|
||||
begin
|
||||
usedUnitDisplayNames.Add(usedUnitActualInfo.Name);
|
||||
projectDependenciesFound := True;
|
||||
end;
|
||||
end;
|
||||
if projectDependenciesFound then
|
||||
usesClauseText := usedUnitDisplayNames.CommaText
|
||||
else
|
||||
usesClauseText := '(none)';
|
||||
finally
|
||||
usedUnitDisplayNames.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
usesClauseText := '(none)';
|
||||
WriteLn(Format(' %-40s -> %s', [unitToDisplay.Name, usesClauseText]));
|
||||
end;
|
||||
finally
|
||||
tempUnitListForDisplay.Free;
|
||||
end;
|
||||
end;
|
||||
WriteLn('--------------------------------------------------------------------------------');
|
||||
WriteLn('');
|
||||
|
||||
WriteLn('Performing topological sort...');
|
||||
for item in allUnits.Values do
|
||||
if item.InDegree = 0 then
|
||||
processingQueue.Enqueue(item);
|
||||
while processingQueue.Count > 0 do
|
||||
begin
|
||||
var u := processingQueue.Dequeue;
|
||||
sortedUnits.Add(u);
|
||||
u.Processed := True;
|
||||
for var v in u.AdjacencyList do
|
||||
begin
|
||||
v.InDegree := v.InDegree - 1;
|
||||
if (v.InDegree = 0) and (not v.Processed) then
|
||||
processingQueue.Enqueue(v);
|
||||
end;
|
||||
end;
|
||||
|
||||
if sortedUnits.Count < allUnits.Count then
|
||||
begin
|
||||
WriteLn('Error: Circular dependency detected among units. Output generation aborted.');
|
||||
WriteLn('Units not processed:');
|
||||
for item in allUnits.Values do
|
||||
if not item.Processed then
|
||||
WriteLn('- ' + item.Name + ' (InDegree: ' + item.InDegree.ToString + ', File: ' + item.FilePath + ')');
|
||||
exitcode := 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
var outputContent := TStringList.Create;
|
||||
var externalUses := TDictionary<string, boolean>.Create;
|
||||
try
|
||||
outputContent.Add('// Combined interfaces from directories:');
|
||||
for var dirPath in sourceDirectories do
|
||||
outputContent.Add('// - ' + dirPath + IfThen(recursiveSearch, ' (recursive)', ''));
|
||||
if focusMode then
|
||||
begin
|
||||
var modeStr := IfThen(filesToExcludeFromOutput.Count > 0, '-fx', '-f');
|
||||
outputContent.Add('// Focus mode (' + modeStr + ') active for files: ' + focusFilesParameter);
|
||||
end;
|
||||
outputContent.Add('// Generated on: ' + DateTimeToStr(Now));
|
||||
outputContent.Add('');
|
||||
|
||||
for item in sortedUnits do
|
||||
begin
|
||||
if filesToExcludeFromOutput.IndexOf(item.FilePath) > -1 then
|
||||
Continue;
|
||||
|
||||
for var usedUnit in item.InterfaceUses do
|
||||
if not allUnits.ContainsKey(usedUnit) then
|
||||
externalUses.AddOrSetValue(usedUnit, True);
|
||||
end;
|
||||
|
||||
if externalUses.Count > 0 then
|
||||
begin
|
||||
var externalUsesList := TStringList.Create;
|
||||
try
|
||||
for var extUse in externalUses.Keys do
|
||||
externalUsesList.Add(extUse);
|
||||
externalUsesList.Sort;
|
||||
outputContent.Add('uses');
|
||||
for var j := 0 to externalUsesList.Count - 1 do
|
||||
begin
|
||||
if j = externalUsesList.Count - 1 then
|
||||
outputContent.Add(' ' + externalUsesList[j] + ';')
|
||||
else
|
||||
outputContent.Add(' ' + externalUsesList[j] + ',');
|
||||
end;
|
||||
outputContent.Add('');
|
||||
finally
|
||||
externalUsesList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
for item in sortedUnits do
|
||||
begin
|
||||
if filesToExcludeFromOutput.IndexOf(item.FilePath) > -1 then
|
||||
Continue;
|
||||
|
||||
if item.InterfaceSection.Count > 0 then
|
||||
begin
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent.Add('//== UNIT START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')');
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent.AddStrings(item.InterfaceSection);
|
||||
outputContent.Add('//== UNIT END: ' + item.Name);
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent.Add('');
|
||||
end;
|
||||
end;
|
||||
|
||||
if writeToClipboard then
|
||||
begin
|
||||
SetClipboardText(outputContent.Text);
|
||||
WriteLn('Output successfully copied to clipboard.');
|
||||
end
|
||||
else if outputFileName <> '' then
|
||||
begin
|
||||
outputContent.SaveToFile(outputFileName);
|
||||
WriteLn('Output successfully written to: ' + outputFileName);
|
||||
end
|
||||
else
|
||||
begin
|
||||
for outputLineText in outputContent do
|
||||
WriteLn(outputLineText);
|
||||
end;
|
||||
finally
|
||||
outputContent.Free;
|
||||
externalUses.Free;
|
||||
end;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WriteLn('An error occurred: ' + E.ClassName + ': ' + E.Message);
|
||||
exitcode := 1;
|
||||
end;
|
||||
end;
|
||||
if Assigned(filesToExcludeFromOutput) then
|
||||
filesToExcludeFromOutput.Free;
|
||||
if Assigned(initialFocusFiles) then
|
||||
initialFocusFiles.Free;
|
||||
if Assigned(excludedDirectoryPatternsList) then
|
||||
excludedDirectoryPatternsList.Free;
|
||||
if Assigned(allFoundPasFilesList) then
|
||||
allFoundPasFilesList.Free;
|
||||
if Assigned(sourceDirectories) then
|
||||
sourceDirectories.Free;
|
||||
if Assigned(allUnits) then
|
||||
begin
|
||||
for item in allUnits.Values do
|
||||
item.Free;
|
||||
allUnits.Free;
|
||||
end;
|
||||
if Assigned(sortedUnits) then
|
||||
sortedUnits.Free;
|
||||
if Assigned(processingQueue) then
|
||||
processingQueue.Free;
|
||||
if exitcode <> 0 then
|
||||
WriteLn('Extraction failed.');
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,66 @@
|
||||
### Projektplan: Delphi Interface Extractor
|
||||
|
||||
**Datum:** 13. Juni 2025, 14:34
|
||||
|
||||
#### Motivation
|
||||
|
||||
Die Notwendigkeit, `interface`-Abschnitte aus einer Vielzahl von Delphi-Units zu extrahieren und in einer einzigen, kompilierbaren Datei zusammenzufassen. Die größte Herausforderung bestand darin, die Abhängigkeiten zwischen den Units korrekt aufzulösen, um eine gültige Kompilierungsreihenfolge zu gewährleisten.
|
||||
|
||||
#### Ziel
|
||||
|
||||
Entwicklung eines robusten Kommandozeilen-Tools mit folgenden Kernfunktionen:
|
||||
* Rekursives Scannen von Quelltext-Verzeichnissen unter Ausschluss von VCS-Ordnern.
|
||||
* Topologische Sortierung der Units zur korrekten Auflösung von Abhängigkeiten.
|
||||
* Ein "Fokus-Modus" (`-f`, `-fx`) zur gezielten Analyse des Abhängigkeitsbaums einer oder mehrerer Start-Units.
|
||||
* Die Erzeugung einer einzigen, sauberen Ausgabedatei, die eine global konsolidierte `uses`-Klausel nur mit externen Abhängigkeiten enthält.
|
||||
* Eine Option (`-fx`), um die `interface`-Sektion der Start-Units selbst aus der Ausgabe auszuschließen – ideal für Test-Szenarien.
|
||||
|
||||
#### Ergebnis
|
||||
|
||||
Wir haben das Kommandozeilen-Tool `ExtractPascalInterfaces.exe` erfolgreich entwickelt. Das Programm erfüllt alle gestellten Anforderungen:
|
||||
* Der Parser verarbeitet Delphi-Units zuverlässig und extrahiert die `interface`-Inhalte, wobei `uses`-Klauseln und Kommentare korrekt behandelt werden.
|
||||
* Die topologische Sortierung stellt die korrekte Reihenfolge der Units sicher und erkennt zyklische Abhängigkeiten.
|
||||
* Die Fokus-Modi `-f` und `-fx` ermöglichen eine präzise Steuerung der zu verarbeitenden Units.
|
||||
* Die generierte Ausgabedatei ist hochgradig optimiert: Sie beginnt mit einer einzigen, formatierten `uses`-Klausel, die alle externen Abhängigkeiten des Projekts zusammenfasst, gefolgt von den `type`- und `const`-Deklarationen in der richtigen Reihenfolge.
|
||||
|
||||
#### Nächste Schritte
|
||||
|
||||
- [ ] **Testen**: Ausgiebige Tests des Tools mit einem großen, realen Delphi-Projekt.
|
||||
- [ ] **Erweiterung**: Unterstützung für bedingte Kompilierung (`{$IFDEF}`) innerhalb von `uses`-Klauseln evaluieren.
|
||||
- [ ] **Konfiguration**: Optional eine Konfigurationsdatei (z.B. `.json`) zur Angabe von Pfaden und Optionen anstelle von Kommandozeilen-Parametern ermöglichen.
|
||||
|
||||
|
||||
***
|
||||
|
||||
### Projektplan: Delphi Interface Extractor (Abschluss)
|
||||
|
||||
**Datum:** 13. Juni 2025, 16:05
|
||||
|
||||
#### Motivation
|
||||
|
||||
Das ursprüngliche Ziel war die Erstellung eines Werkzeugs, das `interface`-Abschnitte aus Delphi-Units extrahiert und zu einer einzigen, kompilierbaren Datei zusammenfügt. Die zentrale Herausforderung war das korrekte Management von Abhängigkeiten und die Erzeugung einer sauberen, wartbaren Ausgabedatei.
|
||||
|
||||
#### Ziel
|
||||
|
||||
Die Entwicklung eines hochflexiblen und robusten Kommandozeilen-Tools zur Automatisierung der Interface-Extraktion. Das Tool sollte einen reichhaltigen Satz an Funktionen bieten:
|
||||
* Scannen von Verzeichnissen, die direkt, rekursiv (`-r`) oder über eine Datei (`-dirs`) angegeben werden.
|
||||
* Zwei Fokus-Modi für gezielte Abhängigkeitsanalysen: `-f` (inklusive Start-Dateien) und `-fx` (exklusive Start-Dateien).
|
||||
* Flexible Ausgabe der Ergebnisse in eine Datei (`-o`), direkt in die Windows-Zwischenablage (`-c`) oder auf die Konsole.
|
||||
* Erzeugung einer einzigen, sauberen Ausgabedatei, die mit einer globalen, formatierten `uses`-Klausel beginnt, welche nur die wirklich benötigten externen Abhängigkeiten enthält.
|
||||
* Ein robuster Parser, der auch komplexe `uses`-Klauseln mit Zeilenkommentaren korrekt verarbeitet.
|
||||
|
||||
#### Ergebnis
|
||||
|
||||
Das Kommandozeilen-Tool `ExtractPascalInterfaces.exe` wurde erfolgreich fertiggestellt und hat alle gesetzten Ziele erreicht. Es ist nun ein ausgereiftes Werkzeug für die Build-Automatisierung.
|
||||
* **Funktionsumfang:** Alle Parameter (`-r`, `-o`, `-c`, `-dirs`, `-f`, `-fx`) sind implementiert und interagieren korrekt miteinander.
|
||||
* **Robustheit:** Der Parser wurde im Laufe der Entwicklung mehrfach verfeinert und kann nun auch komplexe `uses`-Klauseln mit eingeschobenen Kommentaren zuverlässig verarbeiten. Kritische Bugs bei der String- und Index-Verarbeitung wurden behoben.
|
||||
* **Ausgabequalität:** Das erzeugte Artefakt ist optimal für die Weiterverwendung: eine einzige Datei mit einer sauberen, alphabetisch sortierten und formatierten `uses`-Klausel an der Spitze, gefolgt von den topologisch sortierten Interface-Deklarationen.
|
||||
* **Flexibilität:** Die `fx`-Option ermöglicht den Einsatz in Test-Szenarien, bei denen die Abhängigkeiten eines Test-Harness aufgelöst werden, ohne dieses selbst in die Ausgabe aufzunehmen. Die Clipboard-Ausgabe beschleunigt den manuellen Einsatz erheblich.
|
||||
|
||||
#### Nächste Schritte
|
||||
|
||||
Das Projekt ist aus Entwicklungssicht abgeschlossen. Die nächsten logischen Schritte konzentrieren sich auf die Distribution und Anwendung:
|
||||
|
||||
- [ ] **Dokumentation**: Erstellen einer `README.md`-Datei, die alle Kommandozeilen-Optionen mit Beispielen detailliert beschreibt.
|
||||
- [ ] **Praxistest**: Einsatz des Tools in einem oder mehreren großen, realen Delphi-Projekten, um die Stabilität unter Beweis zu stellen.
|
||||
- [ ] **Deployment**: Bereitstellung der finalen `.exe`-Datei für den Einsatz in automatisierten Build-Prozessen.
|
||||
Reference in New Issue
Block a user