如何用Delphi实现Delphi代码的Minify压缩？求相关函数或类库

需求说明 #

需要实现一个Delphi函数MinifyDelphiCode，用于压缩.pas格式的代码，移除冗余空白、单行注释，并压缩块注释内的空白，同时保留字符串内容、编译指令等关键信息。函数框架如下：

function MinifyDelphiCode(delphi: String): String;
begin
// 返回压缩后的Delphi代码字符串
end;

输入输出示例 #

输入代码 #

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Skia,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Skia;

type
  TForm2 = class(TForm)
    SkSvg1: TSkSvg;
    Button1: TButton;
    RadioButton1: TRadioButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

{
   gas

        dgsgdsdgs
     gdsdgs
  dgssdgdg

}

procedure TForm2.Button1Click(Sender: TObject);
  // Some comment
begin
  ShowMessage('Hello World');  // Random comment that I put here
end;

end.

压缩后输出 #

unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Skia, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Skia; type TForm2 = class(TForm) SkSvg1: TSkSvg; Button1: TButton; RadioButton1: TRadioButton; CheckBox1: TCheckBox; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.fmx} { gas dgsgdsdgs gdsdgs dgssdgdg } procedure TForm2.Button1Click(Sender: TObject); begin ShowMessage('Hello World'); end; end.

实现方案 #

Delphi本身没有内置的代码压缩函数，也没有广泛普及的第三方类库专门做这件事，最直接的方式是自行实现解析逻辑。以下是一个现成的实现函数：

function MinifyDelphiCode(const DelphiCode: string): string;
type
  TParseState = (psNormal, psString, psLineComment, psBlockComment);
var
  I: Integer;
  State: TParseState;
  CharCount: Integer;
  CurrentChar, NextChar: Char;
begin
  Result := '';
  State := psNormal;
  CharCount := Length(DelphiCode);
  I := 1;
  while I <= CharCount do
  begin
    CurrentChar := DelphiCode[I];
    NextChar := #0;
    if I < CharCount then
      NextChar := DelphiCode[I + 1];

    case State of
      psNormal:
        begin
          if CurrentChar = '''' then
          begin
            Result := Result + CurrentChar;
            State := psString;
            Inc(I);
          end
          else if (CurrentChar = '/') and (NextChar = '/') then
          begin
            State := psLineComment;
            Inc(I, 2);
          end
          else if CurrentChar = '{' then
          begin
            Result := Result + CurrentChar;
            State := psBlockComment;
            Inc(I);
          end
          else if CurrentChar in [#9, #10, #13, ' '] then
          begin
            if (Result <> '') and (Result[Length(Result)] <> ' ') then
              Result := Result + ' ';
            Inc(I);
            while (I <= CharCount) and (DelphiCode[I] in [#9, #10, #13, ' ']) do
              Inc(I);
          end
          else
          begin
            Result := Result + CurrentChar;
            Inc(I);
          end;
        end;

      psString:
        begin
          Result := Result + CurrentChar;
          if CurrentChar = '''' then
          begin
            if (I < CharCount) and (DelphiCode[I + 1] = '''') then
            begin
              Result := Result + '''';
              Inc(I, 2);
            end
            else
            begin
              State := psNormal;
              Inc(I);
            end;
          end
          else
            Inc(I);
        end;

      psLineComment:
        begin
          while (I <= CharCount) and (DelphiCode[I] <> #10) do
            Inc(I);
          State := psNormal;
        end;

      psBlockComment:
        begin
          if CurrentChar = '}' then
          begin
            Result := Result + CurrentChar;
            State := psNormal;
            Inc(I);
          end
          else if CurrentChar in [#9, #10, #13, ' '] then
          begin
            if (Result[Length(Result)] <> ' ') then
              Result := Result + ' ';
            Inc(I);
            while (I <= CharCount) and (DelphiCode[I] in [#9, #10, #13, ' ']) do
              Inc(I);
          end
          else
          begin
            Result := Result + CurrentChar;
            Inc(I);
          end;
        end;
    end;
  end;
  while (Length(Result) > 0) and (Result[Length(Result)] = ' ') do
    SetLength(Result, Length(Result) - 1);
end;

函数逻辑说明 #

• 状态解析：通过四种状态（正常文本、字符串、单行注释、块注释）区分不同代码段，避免误处理字符串或注释内的内容
• 字符串保留：完全保留字符串内的所有内容，包括空格、换行和转义单引号
• 注释处理：直接跳过单行注释；块注释保留内容，但将其中的连续空白、换行替换为单个空格
• 空白压缩：将正常代码中的连续换行、制表符、空格替换为单个空格，同时避免在代码开头或符号后添加多余空格

你可以根据实际需求调整逻辑，比如是否完全移除块注释，或者对编译指令做特殊处理。

内容的提问来源于stack exchange，提问作者Shaun Roselt