Pascal Interface Extract

This commit is contained in:
Michael Schimmel
2025-06-13 16:13:03 +02:00
parent ba8dd7b464
commit bbd9d1752a
8 changed files with 2191 additions and 16 deletions
+991
View File
@@ -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.
+66
View File
@@ -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.
-2
View File
@@ -1,2 +0,0 @@
# MycLib
+6 -11
View File
@@ -65,7 +65,7 @@
<Debugger_RunParams>--exitbehavior:Pause</Debugger_RunParams>
<DCC_Define>TESTINSIGHT;$(DCC_Define)</DCC_Define>
<PostBuildEventExecuteWhen>TargetOutOfDate</PostBuildEventExecuteWhen>
<PreBuildEvent><![CDATA[T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src
<PreBuildEvent><![CDATA[T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe $(SAVE) -o T:\Myc\intf.txt T:\Myc\src
$(PreBuildEvent)]]></PreBuildEvent>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
@@ -158,12 +158,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<Source>
<Source Name="MainSource">MycTests.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Excluded_Packages/>
</Delphi.Personality>
<Deployment Version="5">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
@@ -1170,7 +1165,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win32'">
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEvent>T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe $(SAVE) -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
@@ -1178,7 +1173,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win64'">
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEvent>T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe $(SAVE) -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
@@ -1186,7 +1181,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win32'">
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEvent>T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe $(SAVE) -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
@@ -1194,7 +1189,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win64'">
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEvent>T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe $(SAVE) -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
+2
View File
@@ -0,0 +1,2 @@
T:\Myc\Src
T:\Myc\Test