понедельник, 19 марта 2012 г.

TParser в Delphi

Если Вы не знакомы с блоком try – finally то прочитайте эту статью: http://www.delphisources.ru/pages/faq/faq_delphi_basics/Try.php.html
TParser позволяет обрабатывать DFM файлы (.dfm - расширение), используется RAD Studio для их анализа.
Embarcadero о TParser:
http://docwiki.embarcadero.com/Libraries/en/System.Classes.TParser
Данный класс находиться в модуле Classes, вот его описание:


{ TParser }

  TParserErrorEvent = procedure (Sender: TObject; const Message: string; var Handled: Boolean) of object;

  TParser = class(TObject)
  private type
    TCharType = (ctOther, ctLetterStart, ctLetterNumber, ctNumber, ctHash, ctQuote, ctDollar, ctDash);
  private
    FStream: TStream;
    FOrigin: Longint;
    FBuffer: TBytes;
    FBufPtr: Integer;
    FBufEnd: Integer;
    FSourcePtr: Integer;
    FSourceEnd: Integer;
    FTokenPtr: Integer;
    FStringPtr: Integer;
    FSourceLine: Integer;
    FSaveChar: Byte;
    FToken: Char;
    FFloatType: Char;
    FWideStr: UnicodeString;
    FOnError: TParserErrorEvent;
    FEncoding: TEncoding;
    FFormatSettings: TFormatSettings;
    procedure ReadBuffer;
    procedure SkipBlanks;
    function CharType(var ABufPos: Integer): TCharType;
  protected
    function GetLinePos: Integer;
  public
    constructor Create(Stream: TStream; AOnError: TParserErrorEvent = nil); overload;
    constructor Create(Stream: TStream; const FormatSettings: TFormatSettings; AOnError: TParserErrorEvent = nil); overload;
    destructor Destroy; override;
    procedure CheckToken(T: Char);
    procedure CheckTokenSymbol(const S: string);
    procedure Error(const Ident: string);
    procedure ErrorFmt(const Ident: string; const Args: array of const);
    procedure ErrorStr(const Message: string);
    procedure HexToBinary(Stream: TStream);
    function NextToken: Char;
    function SourcePos: Longint;
    function TokenComponentIdent: string;
    function TokenFloat: Extended;
    function TokenInt: Int64;
    function TokenString: string;
    function TokenWideString: UnicodeString;
    function TokenSymbolIs(const S: string): Boolean;
    property FloatType: Char read FFloatType;
    property SourceLine: Integer read FSourceLine;
    property LinePos: Integer read GetLinePos;
    property Token: Char read FToken;
    property OnError: TParserErrorEvent read FOnError write FOnError;
  end;
А вот сама демка:
unit uDemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, IniFiles, ExtDlgs;

type
   TLexeme = class
     LexemeType: Char;
     Value: string;
     Pos, Line: Integer;
   end;

  TFrm = class(TForm)
    BottomPanel: TPanel;
    btnOpen: TButton;
    btnParse: TButton;
    OpenTextFileDialog: TOpenTextFileDialog;
    PageControl: TPageControl;
    tsFile: TTabSheet;
    tsLexemsList: TTabSheet;
    RichEdit: TRichEdit;
    LeftPanel: TPanel;
    lbLexems: TListBox;
    RightPanel: TPanel;
    gbLexem: TGroupBox;
    lbMemo: TMemo;
    tsLexemsTree: TTabSheet;
    tvLexems: TTreeView;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    tvMemo: TMemo;
    procedure btnParseClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure lbLexemsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tvLexemsChange(Sender: TObject; Node: TTreeNode);
  private
    { Private declarations }
    procedure ShowLexemeInfo(Memo: TMemo; Lexeme: TLexeme);
  public
    { Public declarations }
  end;

var
  Frm: TFrm;

implementation

{$R *.dfm}

// Существует ли нода с таким именем в дереве
function IsItemExist(TV: TTreeView; Name: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to TV.Items.Count - 1 do
    if TV.Items[I].Text = Name then
      Result := True;
end;

// Добавить ноду как "Root"
function AddRootNode(TV: TTreeView; Name: string): TTreeNode;
var
  Node: TTreeNode;
begin
  Node := TV.Items.AddChild(nil, Name);
  Node.ImageIndex := 0;
  Node.SelectedIndex := 0;
  Result := Node;
end;

// Добавить ноду как "Child"
function AddChildNode(TV: TTreeView; Name: string; Parent: TTreeNode): TTreeNode;
var
  Node: TTreeNode;
begin
  Node := TV.Items.AddChild(Parent, Name);
  Node.ImageIndex := 0;
  Node.SelectedIndex := 0;
  Result := Node;
end;

// Получаем тип лексемы как string
function GetLexemeTypeAsString(Lexeme: TLexeme): string;
begin
  Result := Lexeme.LexemeType;
  case Lexeme.LexemeType of
    Char(0): Result := 'EOF';
    Char(1): Result := 'Symbol';
    Char(2): Result := 'String';
    Char(3): Result := 'Integer';
    Char(4): Result := 'Float';
    Char(5): Result := 'WString';
  end;
end;

// Открыть
procedure TFrm.btnOpenClick(Sender: TObject);
begin
  if OpenTextFileDialog.Execute then
  begin
    RichEdit.Lines.Clear;
    lbLexems.Clear;
    tvLexems.Items.Clear;
    lbMemo.Clear;
    tvMemo.Clear;
    RichEdit.Lines.LoadFromFile(OpenTextFileDialog.FileName);
  end;
end;

// Парсить
procedure TFrm.btnParseClick(Sender: TObject);
var
  Stream: TStringStream;
  Parser: TParser;
  Temp: TLexeme;
  Node, Root: TTreeNode;
begin
  if Length(RichEdit.Text) > 0 then
  begin
    lbLexems.Clear;
    tvLexems.Items.Clear;
    lbMemo.Clear;
    tvMemo.Clear;
    Stream := TStringStream.Create(RichEdit.Text); // записываем текст в поток
    try
      Parser := TParser.Create(Stream); // передаем поток парсеру
      try
        repeat
          Temp := TLexeme.Create; // создаём лексему
          // и заполняем её данными
          Temp.LexemeType := Parser.Token; // тип
          Temp.Value := Parser.TokenString; // значение
          Temp.Pos := Parser.SourcePos; // позиция
          Temp.Line := Parser.SourceLine; // линия
          lbLexems.AddItem(Temp.Value, Temp); // заносим в список
          // заносим в дерево
          tvLexems.Items.BeginUpdate;
          if not IsItemExist(tvLexems, IntToStr(Temp.Line)) then
          begin
            Root := AddRootNode(tvLexems, IntToStr(Temp.Line));
            Node := AddChildNode(tvLexems, Temp.Value, Root);
            Node.Data := Temp;
          end
          else
          begin
            Node := AddChildNode(tvLexems, Temp.Value, Root);
            Node.Data := Temp;
          end;
          tvLexems.Items.EndUpdate;
        until Parser.NextToken = toEOF; // повторяем действия до конца текста
      finally
        Parser.Free; // не забываем освобождать память
      end;
    finally
      Stream.Free; // не забываем освобождать память
    end;
  end;
  Label1.Caption := 'Всего лексем: ' + IntToStr(lbLexems.Count);
  Label2.Caption := 'Всего строк: ' + IntToStr(RichEdit.Lines.Count);
  tvLexems.FullExpand;
  tvLexems.Select(tvLexems.Items.GetFirstNode);
end;

// Выводим данные в мемо
procedure TFrm.ShowLexemeInfo(Memo: TMemo; Lexeme: TLexeme);
begin
  Memo.Lines.Clear;
  Memo.Lines.Add('Строка - ' + RichEdit.Lines[Lexeme.Line - 1]);
  Memo.Lines.Add('');
  Memo.Lines.Add('Значение: ' + Lexeme.Value);
  Memo.Lines.Add('Тип лексемы: ' + GetLexemeTypeAsString(Lexeme));
  Memo.Lines.Add('№ строки: ' + IntToStr(Lexeme.Line));
  Memo.Lines.Add('Позиция: ' + IntToStr(Lexeme.Pos));
end;

// Выводим данные по выбраной лексеме в списке
procedure TFrm.lbLexemsClick(Sender: TObject);
var
  Temp: TLexeme;
begin
  if lbLexems.ItemIndex >= 0 then
  begin
    Temp := lbLexems.Items.Objects[lbLexems.ItemIndex] as TLexeme;
    ShowLexemeInfo(lbMemo, Temp);
  end;
end;

// Выводим данные по выбраной лексеме в дереве
procedure TFrm.tvLexemsChange(Sender: TObject; Node: TTreeNode);
begin
  if Assigned(tvLexems.Selected) and (not tvLexems.Selected.HasChildren) then
    ShowLexemeInfo(tvMemo, TLexeme(tvLexems.Selected.Data));
end;

procedure TFrm.FormCreate(Sender: TObject);
begin
  btnParseClick(Sender);
  lbLexems.ItemIndex := 0;
  lbLexemsClick(Sender);
end;

end.

Пример очень прост и хорошо прокоментирован, при нажатии на кнопку «Парсить» мы создаём поток для передачи текста, который нам нужно проанализировать:
Stream := TStringStream.Create(RichEdit.Text);
После чего передаём поток самому парсеру:
Parser := Tparser.Create(Stream);
В цикле, до конца потока создаём экземпляры нашей лексемы:
Temp := TLexeme.Create; 
Заполняем её данными:
Temp.LexemeType := Parser.Token; // тип
Temp.Value := Parser.TokenString; // значение
Temp.Pos := Parser.SourcePos; // позиция
Temp.Line := Parser.SourceLine; // линия
Заносим лексему в список (TList):
lbLexems.AddItem(Temp.Value, Temp);
Заносим лексему в дерево (TTreeView)
tvLexems.Items.BeginUpdate;
if not IsItemExist(tvLexems, IntToStr(Temp.Line)) then
begin
  Root := AddRootNode(tvLexems, IntToStr(Temp.Line));
  Node := AddChildNode(tvLexems, Temp.Value, Root);
  Node.Data := Temp;
end
else
begin
  Node := AddChildNode(tvLexems, Temp.Value, Root);
  Node.Data := Temp;
end;
tvLexems.Items.EndUpdate;
После чего освобождаем память:
Parser.Free;
Stream.Free;

Ссылка на исходник:
http://www.fayloobmennik.net/1681798

Полезные ссылки:
Лексический анализ (Википедия):
http://ru.wikipedia.org/wiki/Лексема_(информатика)
Синтаксический анализ, парсер (Википедия):
http://ru.wikipedia.org/wiki/Парсер
Интерпретатор на коленке на основе TParser: (взята за основу, спасибо автору)
http://www.mirgames.ru/articles/base/tparser.html#part2_1
Использование TParser:
http://www.kansoftware.ru/?tid=4767
Пример TParser:
http://www.delphisources.ru/pages/faq/base/tparser_example.html

Комментариев нет:

Отправить комментарий