タグ内の値を取り出すには

解決

SO 2004-09-08 00:18:34 No: 10820

以下のようなHTML文書のnameやvalueの値を取り出すには、
そのようにしたらいいのでしょうか。

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<HTML>
<HEAD>
</HEAD>
<BODY>
<UL>
<LI>
  <OBJECT type="text/sitemap">
   <param name="Name" value="TEST">
   <param name="Local" value="_RESOURCE\TEST.html">
  </OBJECT>
</LI>
</UL>
</BODY>
</HTML>

Mr.XRAY URL 2004-09-08 00:58:34 No: 10821

こんなとこは参考になりませんでしょうか．

http://homepage2.nifty.com/Mr_XRAY/Halbow/Notes/N021.html

TtPIPICH 2004-09-08 01:14:55 No: 10822

http://takamichie.at.infoseek.co.jp/warehouse/units/index.html
たかみちえさんのサイトに在るstdHTMLユニットが便利です

にしの 2004-09-08 02:43:04 No: 10823

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.

SO 2004-09-17 19:31:32 No: 10824

亀レスですみません。
HalbowさんやstdHTMLユニット、にしのさんのコードを
見よう見まねで行って解決することができました。
ありがとうございます。