この発言に対し以下のコメントが寄せられています

#00949　ぜえた          さん　RE:Simple XML-like token reader






　こんにちは、ぜえた です。

<header>
  <from>ぜえた</from>
  <to>ALL</to>
</header>

のようなＸＭＬに似たタグを使ったテキストをトークン（タグと内容）に分解
するクラスです。空白は除きません。タグの解釈などは各自で行なってくださ
い(^^;

type
  TToken = (tkEndOfText, tkStartTag, tkEndTag, tkContent);

  TTokenReader = class
  private
    FText: string;
    FToken: TToken;
    FValue: string;
    FCur: PChar;
    procedure SetText(const Value: string);
  public
    procedure Next;
    property Token: TToken read FToken;
    property Text: string read FText write SetText;
    property Value: string read FValue;
  end;

procedure TTokenReader.SetText(const Value: string);
begin
  FText := Value;
  FCur := PChar(FText);
end;

procedure TTokenReader.Next;
var
  p: PChar;
  l: Integer;
begin
  p := FCur;
  case p^ of
    #0: begin
      FToken := tkEndOfText;
    end;
    '<': begin
      Inc(p);
      if p^ = '/' then begin
        FToken := tkEndTag;
        Inc(p);
      end else begin
        FToken := tkStartTag;
      end;
      while not (p^ in [#0, '>']) do Inc(p);
      if p^ = '>' then begin
        Inc(p);
        l := p - FCur;
        SetLength(FValue, l);
        if l > 0 then begin
          Move(FCur^, Pointer(FValue)^, l)
        end;
      end;
    end;
  else
    FToken := tkContent;
    while not (p^ in [#0, '<']) do Inc(p);
    l := p - FCur;
    SetLength(FValue, l);
    if l > 0 then begin
      Move(FCur^, Pointer(FValue)^, l)
    end;
  end;
  FCur := p;
end;

--------------------------------------------------------------------

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    TokenReader: TTokenReader;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TokenReader := TTokenReader.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TokenReader.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  s: array[tkStartTag..tkContent] of string =
    ('StartTag: ', 'EndTag: ', 'Context: ');
begin
  TokenReader.Text := Memo1.Lines.Text;
  TokenReader.Next;
  while TokenReader.Token <> tkEndOfText do begin
    Memo2.Lines.Add(s[TokenReader.Token] + TokenReader.Value);
    TokenReader.Next;
  end;
end;

                                                    ぜえた (QZC05100)

Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。