タグ内の値を取り出すには (ID:10823)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

stdHTMLではたしか問題があったような気がします。
# "、'など扱いだったか、タグ内の改行だったか忘れましたが

ざっと作ってみました。

使い方は、
  HtmlParse := THtmlParse.Create;
で生成し、
  HtmlParse.Text := HTMLの内容;
で解析対象を設定。

while HtmlParse.NextToken(タグ名が格納される文字列変数, 属性リストが格納されるTStringsオブジェクト) <> hptEof
で回して取得できます。
所々問題有りです。
# NAME=VALUEのVALUEに、=が含まれていた場合など。
まあ、こんな感じにコーディングしても出来ますよというサンプルですので、ご容赦を。

unit uHtmlParse;

interface

uses
  Windows, SysUtils, Classes;

type
  THtmlParseType=(hptTag, hptPlain, hptEof);
  THtmlParse=class(TObject)
  private
    FText: String;
    FParsePos: PCHAR;
  private
    procedure SetText(Value: String);
  protected
    function IsWhiteSpace: Boolean;
    procedure SkipWhiteSpace;
    procedure GetToken(var AToken: String);
  public
    constructor Create;
    destructor Destroy; override;

function NextToken(var TagName: String; Values: TStrings): THtmlParseType;

property Text: String read FText write SetText;
  end;

implementation

procedure THtmlParse.SetText(Value: String);
begin
  FText := Value;
  FParsePos := PCHAR(FText);
end;

constructor THtmlParse.Create;
begin
  inherited Create;
  FText := '';
  FParsePos := PCHAR(FText);
end;

destructor THtmlParse.Destroy;
begin
  inherited Destroy;
end;

function THtmlParse.IsWhiteSpace: Boolean;
begin
  Result := FParsePos^ in [' ', #9, #10, #13];
end;

procedure THtmlParse.SkipWhiteSpace;
begin
  while FParsePos^ <> #0 do
  begin
    if not IsWhiteSpace then Break;
    Inc(FParsePos);
  end;
end;

procedure THtmlParse.GetToken(var AToken: String);
var
  PrevParsePos: PCHAR;
  Quote: Char;
begin
  PrevParsePos := FParsePos;
  case FParsePos^ of
    '''','"':
    begin
      Quote := FParsePos^;
      Inc(FParsePos);
    end;
    else Quote := #0;
  end;
  while (FParsePos^ <> #0) and (FParsePos^ <> Quote) do
  begin
    if (Quote = #0) and IsWhiteSpace then Break;
    if (Quote = #0) and (FParsePos^ = '=') then Break;
    if FParsePos^ = '>' then Break;
    Inc(FParsePos);
  end;
  if (FParsePos^ <> #0) and (FParsePos^ = Quote) then Inc(FParsePos);
  SetLength(AToken, FParsePos - PrevParsePos);
  CopyMemory(PCHAR(AToken), PrevParsePos, FParsePos - PrevParsePos);
end;

function THtmlParse.NextToken(var TagName: String; Values: TStrings): THtmlParseType;
var
  PrevParsePos: PCHAR;
  AToken, ATokenValue: String;
begin
  TagName := '';
  Values.Clear;
  SkipWhiteSpace;
  case FParsePos^ of
    #0:
    begin
      Result := hptEof;
    end;
    '<':
    begin
      Result := hptTag;
      Inc(FParsePos);
      GetToken(AToken);
      TagName := AToken;
      SkipWhiteSpace;
      while FParsePos^ <> '>' do
      begin
        GetToken(AToken);
        ATokenValue := AToken;
        SkipWhiteSpace;
        if FParsePos^ = '=' then
        begin
          Inc(FParsePos);
          SkipWhiteSpace;
          GetToken(ATokenValue);
        end;
        Values.Add(AToken + '=' + ATokenValue);
        SkipWhiteSpace;
      end;
      Inc(FParsePos);
    end;
    else
    begin
      Result := hptPlain;
      PrevParsePos := FParsePos;
      while (FParsePos^ <> #0) and (FParsePos^ <> '<') do Inc(FParsePos);
      SetLength(AToken, FParsePos - PrevParsePos);
      CopyMemory(PCHAR(AToken), PrevParsePos, FParsePos - PrevParsePos);
      Values.Text := AToken;
    end;
  end;

end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る