[杂谈]从 Delphi 源码中解析资源字符串

这是应群友的要求写的一段代码，用于将 Delphi 源码中 resourcestring 定义的资源字符串解析出来。

uses qstring;

type
  TPascalResourceStringParser = class
  private
    function GetItems(const AIdx: Integer): QStringW;
    function GetCount: Integer;
    function GetNames(const AIdx: Integer): QStringW;
    function GetValues(const AIdx: Integer): QStringW;
  protected
    FItems: TStringList;
  public
    constructor Create; overload;
    destructor Destroy; override;
    procedure Parse(S: QStringW);
    property Items[const AIdx: Integer]: QStringW read GetItems;
    property Names[const AIdx: Integer]: QStringW read GetNames;
    property Values[const AIdx: Integer]: QStringW read GetValues;
    property Count: Integer read GetCount;
  end;

{ TPascalResourceStringParser }

constructor TPascalResourceStringParser.Create;
begin
  FItems := TStringList.Create;
end;

destructor TPascalResourceStringParser.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

function TPascalResourceStringParser.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TPascalResourceStringParser.GetItems(const AIdx: Integer): String;
begin
  Result := FItems[AIdx];
end;

function TPascalResourceStringParser.GetNames(const AIdx: Integer): QStringW;
begin
  Result := FItems.Names[AIdx];
end;

function TPascalResourceStringParser.GetValues(const AIdx: Integer): QStringW;
  function DecodeString(S: QStringW): QStringW;
  var
    ps, pd: PWideChar;
    V: Int64;
    AIntToChar: Boolean;
  begin
    if Length(S) > 0 then
    begin
      ps := PWideChar(S);
      SkipSpaceW(ps);
      SetLength(Result, Length(S));
      pd := PWideChar(Result);
      while ps^ <> #0 do
      begin
        if ps^ = '''' then
        begin
          Inc(ps);
          while ps^ <> '''' do
          begin
            pd^ := ps^;
            Inc(pd);
            Inc(ps);
          end;
          Inc(ps);
        end
        else
        begin
          if ps^ = '#' then
          begin
            Inc(ps);
            AIntToChar := true;
          end
          else if StartWithW(ps, 'char', true) then
          begin
            Inc(ps, 4);
            SkipSpaceW(ps);
            if ps^ = '(' then
            begin
              Inc(ps);
              SkipSpaceW(ps);
              AIntToChar := true;
            end;
          end
          else if StartWithW(ps, 'chr', true) then
          begin
            Inc(ps, 3);
            SkipSpaceW(ps);
            if ps^ = '(' then
            begin
              Inc(ps);
              SkipSpaceW(ps);
              AIntToChar := true;
            end;
          end
          else
            AIntToChar := false;
          if AIntToChar then
          begin
            if ParseInt(ps, V) > 0 then
            begin
              pd^ := WideChar(V);
              Inc(pd);
            end;
          end
          else
            Inc(ps);
        end;
      end;
      SetLength(Result, pd - PWideChar(Result));
    end
    else
      Result := '';
  end;

begin
  Result := DecodeString(FItems.ValueFromIndex[AIdx]);
end;

procedure TPascalResourceStringParser.Parse(S: QStringW);
var
  AHelper: TQStringCatHelperW;
  ps, pl: PQCharW;
  ALine: QStringW;
  ALn: Integer;
  AStarted: Boolean;
  function DecodeStatement: QStringW;
  var
    AQuoter: QCharW;
  begin
    SkipSpaceW(ps);
    AHelper.Position := 0;
    while ps^ <> #0 do
    begin
      // 跳过行注释
      if (ps[0] = '/') and (ps[1] = '/') then
        SkipLineW(ps)
        // 跳过块注释
      else if ps[0] = '{' then
      begin
        SkipUntilW(ps, '}');
        Inc(ps);
      end
      // 另一种块注释
      else if (ps[0] = '(') and (ps[0] = '*') then
      begin
        repeat
          SkipUntilW(ps, '*');
          if ps^ = '*' then
            Inc(ps);
        until (ps^ = ')') or (ps^ = #0);
        if ps^ = ')' then
          Inc(ps);
      end
      else if ps^ = '''' then
      begin
        AHelper.Cat(ps^);
        AQuoter := ps^;
        Inc(ps);
        while ps^ <> #0 do
        begin
          AHelper.Cat(ps^);
          if ps^ = '''' then
          begin
            Inc(ps);
            if ps^ <> '''' then
              Break
            else
              Inc(ps);
          end
          else
            Inc(ps);
        end;
      end
      else if ps^ = ';' then // 语句结束
      begin
        Result := AHelper.Value;
        Inc(ps);
        SkipSpaceW(ps);
        Break;
      end
      else
      begin
        if Ord(ps^) in [9, 10, 13, 32] then
        begin
          if AHelper.Position > 0 then
          begin
            if AHelper.Chars[AHelper.Position - 1] <> ' ' then
              AHelper.Cat(' ');
          end;
        end
        else
          AHelper.Cat(ps^);
        Inc(ps);
      end;
    end;
    SkipSpaceW(ps);
  end;

begin
  AHelper := TQStringCatHelperW.Create;
  FItems.Clear;
  try
    ps := PQCharW(S);
    ALn := 0;
    AStarted := false;
    while ps^ <> #0 do
    begin
      ALine := DecodeStatement;
      pl := PQCharW(ALine);
      if StartWithW(pl, 'interface ', true) then
      begin
        ALine := DeleteLeftW(ALine, 'interface ', true);
        AStarted := false;
      end
      else if StartWithW(pl, 'implementation ', true) then
      begin
        ALine := DeleteLeftW(ALine, 'implementation ', true);
        AStarted := false;
      end;
      pl := PQCharW(ALine);
      if StartWithW(pl, 'resourcestring ', true) then
      begin
        AStarted := true;
        ALine := DeleteLeftW(ALine, 'resourcestring ', true);
      end
      else if AStarted then
        AStarted := not(StartWithW(pl, 'var ', true) or StartWithW(pl,
          'function ', true) or StartWithW(pl, 'type ', true) or StartWithW(pl,
          'const ', true) or StartWithW(pl, 'uses ', true));;
      if AStarted then
      begin
        FItems.Add(ALine);
        // DebugOut('Line %d:%s', [ALn, ALine]);
        Inc(ALn);
      end;
    end;
  finally
    FreeAndNil(AHelper);
    FItems.EndUpdate;
  end;
end;

留此存念，同时分享给大家，有用的就拿去用。