Pascal Quellcode Zeichenkette Extractor

[Roland Chastain]

Hallo!

Entschuldigung für die Sprache Fehler.

Da ist ein klein Programm das ich gemacht habe. Es suchet durch einem Pascal Quelltext die Kommentare, die literale Zeichenkette und die Kompiler Optionen.

Es löschet die Kommentare und ersetzt die Zeichenkette und die Optionen mit einem Kennnummer.

Das Programm benutzet FLRE.

Wie sehen Sie das?

[Roland Chastain]

Da ist eine andere (bessere ich hoffe) Version meines Programms. Nun das Programm benutzet nur eine List, als Wörterbuch. So das Code ist kurzer und mehr verständlich.

Bitte siehen die Programms Ausgabe ("1.txt", "2.txt" und "3.txt") zum verstehen was das Programm genau macht.

Ihre Meinungen sind willkommen.

[Roland Chastain]

Hallo!

Noch eine andere Version des Programms.

Code: Alles auswählen

 
program extractor5;
 
{$I DIRECTIVES}
 
uses
  Classes, SysUtils, IOUtils, FLRE, FLREUnicode;
{ https://github.com/BeRo1985/flre }
 
function SubStr(const aSource: string; aStart: integer; aEnd: integer = MAXINT): string;
begin
  result := Copy(aSource, aStart, aEnd - aStart + 1);
end;
 
type
  TExtractor = class
    private
      fText: string;
      fData: TStringList;
    public
      constructor Create(const aFileName: string);
      destructor Destroy(); override;
      procedure Extract(var aCount: integer; const aType: string; const aStart, aEnd: integer);
      function Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;
      procedure Restore(const aType: string);
      procedure ExtractAll();
      procedure SaveText(const aFileName: string);
      procedure SaveData(const aFileName: string);
      procedure RestoreAll();
      procedure Remove(const aType: string);
  end;
 
constructor TExtractor.Create(const aFileName: string);
begin
  inherited Create();
  fData := TStringList.Create;
  fText := TFile.ReadAllText(aFileName);
end;
 
destructor TExtractor.Destroy();
begin
  fData.Free();
  inherited Destroy();
end;
 
procedure TExtractor.Extract(var aCount: integer; const aType: string; const aStart, aEnd: integer);
begin
  Inc(aCount);
  fData.Append(Format('_%s_%d_=%s', [aType, aCount, SubStr(fText, aStart, aEnd)]));
  fText := Format('%s_%s_%d_%s', [SubStr(fText, 1, aStart - 1), aType, aCount, SubStr(fText, aEnd + 1)]);
end;
 
function TExtractor.Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;
begin
  with aCaptures[0] do result := fData.Values[FLREPtrCopy(aInput, Start, Length)];
end;
 
procedure TExtractor.Restore(const aType: string);
begin
  if Assigned(fData) then
    with TFLRE.Create(Format('_%s_\d+_', [aType]), []) do
    begin
      fText := ReplaceCallback(fText, Callback);
      Free();
    end;
end;
 
procedure TExtractor.ExtractAll();
var
  c: char;
  l: integer;
  d: boolean;
  cCount,
  lCount,
  dCount,
  i,
  iStart,
  iEnd: integer;
begin
  c := #0;
  l := 0;
  d := FALSE;
 
  cCount := 0;
  lCount := 0;
  dCount := 0;
 
  i := 1;
  iStart := 0;
  iEnd := 0;
 
  while i <= Length(fText) do
  begin
    if c <> #0 then
    begin
      if ((c = '{') and (fText[i] = '}'))
      or ((c = '(') and (fText[i] = ')') and (fText[i - 1] = '*'))
      or ((c = '/') and (i < Length(fText)) and (fText[i + 1] in [#10, #13])) then
      begin
        iEnd := i;
        Extract(cCount, 'comment', iStart, iEnd);
        c := #0; // => comment = FALSE
        i := iStart - 1;
      end;
    end else
 
      if l <> 0 then
      begin
        if fText[i] = '''' then
        begin
          Inc(l);
          if (l mod 2 = 0) and (i < Length(fText)) and (fText[i + 1] <> '''') then
          begin
            iEnd := i;
            Extract(lCount, 'literal', iStart, iEnd);
            l := 0; // => literal = FALSE
            i := iStart - 1;
          end;
        end;
      end else
 
        if d then
        begin
          if fText[i] = '}' then
          begin
            iEnd := i;
            Extract(dCount, 'directive', iStart, iEnd);
            d := FALSE; // => directive = FALSE
            i := iStart - 1;
          end;
        end else
 
          if ((fText[i] = '{') and (i < Length(fText)) and (fText[i + 1] <> '$'))
          or ((fText[i] = '(') and (i < Length(fText)) and (fText[i + 1] = '*'))
          or ((fText[i] = '/') and (i < Length(fText)) and (fText[i + 1] = '/')) then
          begin
            iStart := i;
            c := fText[i]; // => comment = TRUE
          end else
 
            if fText[i] = '''' then
            begin
              iStart := i;
              l := 1; // => literal = TRUE
            end else
 
              if ((fText[i] = '{') and (i < Length(fText)) and (fText[i + 1] = '$')) then
              begin
                iStart := i;
                d := TRUE; // => directive = TRUE
              end;
 
    Inc(i);
  end;
end;
 
procedure TExtractor.SaveText(const aFileName: string);
begin
  TFile.WriteAllText(aFileName, fText);
end;
 
procedure TExtractor.SaveData(const aFileName: string);
begin
  fData.SaveToFile(aFileName);
end;
 
procedure TExtractor.RestoreAll();
begin
  Restore('[a-z]+');
end;
 
{$IFDEF VERSION_1}
procedure TExtractor.Remove(const aType: string);
var
  captures: TFLREMultiCaptures;
  i: integer;
begin
  with TFLRE.Create(Format('_%s_\d+_', [aType]), []) do
  begin
    MaximalDFAStates := 65536;
    MatchAll(fText, captures);
    for i := High(captures) downto Low(captures) do with captures[i, 0] do Delete(fText, Start, Length);
    Free;
  end;
end;
{$ELSE}
procedure TExtractor.Remove(const aType: string);
begin
  with TFLRE.Create(Format('_%s_\d+_', [aType]), []) do
  begin
    MaximalDFAStates := 65536;
    fText := Replace(fText, '');
    Free;
  end;
end;
{$ENDIF}
 
var
  filename: string;
 
begin
  if (ParamCount = 1) then
    filename := ParamStr(1)
  else
    filename := {$IFDEF FPC}'extractor5.pp'{$ELSE}'extractor5.dpr'{$ENDIF};
 
  if FileExists(filename) then
    with TExtractor.Create(filename) do
    begin
      ExtractAll();
      SaveText('1.txt');
      SaveData('2.txt');
      Remove('comment');
      SaveText('3.txt');
      RestoreAll();
      SaveText('4.txt');
      Free();
    end;
end.
 

[Roland Chastain]

Hallo zusammen!

Ich biete Ihnen eine neue Version dieses Programms an. Die vorherige Version konnte aufgrund einer Änderung in der FLRE-Bibliothek nicht mehr kompiliert werden.

Neu: Das Programm verwendet standardmäßig die mit Free Pascal gelieferte RegExpr-Unit. Um die FLRE-Unit zu verwenden, müssen Sie dem Compiler die Option -dUSE_FLRE übergeben.

Weitere Informationen finden Sie in den Dateien README.md und Makefile.