delphi 几个实用的HTML解析函数-木庄网络博客

本文整理自网络，侵删。
  1)HTML 标签值攫取函数，任意标签哦，纯字符串分析，可以配合IDHTTP编程

uses StrUtils;

function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string; var Values: TStringList): integer;

function FindFirstCharAfterSpace(const Line: string; StartPos: integer): Integer;
var i: integer; 
begin 
Result := -1; 
for i := StartPos to Length(Line) do 
begin 
if (Line[i] <> ' ') then 
begin 
Result := i; 
exit; 
end; 
end; 
end;

function FindFirstSpaceAfterChars(const Line: string; StartPos: integer): Integer; 
begin 
Result := PosEx(' ', Line, StartPos);
end;

function FindFirstSpaceBeforeChars(const Line: string; StartPos: integer): Integer;
var i: integer; 
begin 
Result := 1; 
for i := StartPos downto 1 do 
begin 
if (Line[i] = ' ') then 
begin 
Result := i; 
exit; 
end; 
end; 
end;

var InnerTag: string; 
LastPos, LastInnerPos: Integer; 
SPos, LPos, RPos: Integer; 
AttribValue: string; 
ClosingChar: char; 
TempAttribName: string; 
begin 
Result := 0;
LastPos := 1;
while (true) do
begin
// find outer tags '<' & '>'
LPos := PosEx('<', HtmlText, LastPos);
if (LPos <= 0) then break;
RPos := PosEx('>', HtmlText, LPos+1);
if (RPos <= 0) then
LastPos := LPos + 1
else
LastPos := RPos + 1;

// get inner tag 
InnerTag := Copy(HtmlText, LPos+1, RPos-LPos-1); 
InnerTag := Trim(InnerTag); // remove spaces 
if (Length(InnerTag) < Length(TagName)) then continue;

// check tag name 
if (SameText(Copy(InnerTag, 1, Length(TagName)), TagName)) then 
begin 
// found tag 
AttribValue := ''; 
LastInnerPos := Length(TagName)+1; 
while (LastInnerPos < Length(InnerTag)) do 
begin 
// find first '=' after LastInnerPos 
RPos := PosEx('=', InnerTag, LastInnerPos); 
if (RPos <= 0) then break;

// this way you can check for multiple attrib names and not a specific attrib 
SPos := FindFirstSpaceBeforeChars(InnerTag, RPos); 
TempAttribName := Trim(Copy(InnerTag, SPos, RPos-SPos)); 
if (true) then 
begin 
// found correct tag 
LPos := FindFirstCharAfterSpace(InnerTag, RPos+1); 
if (LPos <= 0) then 
begin 
LastInnerPos := RPos + 1; 
continue; 
end; 
LPos := FindFirstCharAfterSpace(InnerTag, LPos); // get to first char after '=' 
if (LPos <= 0) then continue; 
if ((InnerTag[LPos] <> '"') and (InnerTag[LPos] <> '''')) then 
begin 
// AttribValue is not between '"' or ''' so get it 
RPos := FindFirstSpaceAfterChars(InnerTag, LPos+1); 
if (RPos <= 0) then 
AttribValue := Copy(InnerTag, LPos, Length(InnerTag)-LPos+1) 
else 
AttribValue := Copy(InnerTag, LPos, RPos-LPos+1); 
end 
else 
begin 
// get url between '"' or ''' 
ClosingChar := InnerTag[LPos]; 
RPos := PosEx(ClosingChar, InnerTag, LPos+1); 
if (RPos <= 0) then 
AttribValue := Copy(InnerTag, LPos+1, Length(InnerTag)-LPos-1) 
else 
AttribValue := Copy(InnerTag, LPos+1, RPos-LPos-1) 
end;

if (SameText(TempAttribName, AttribName)) and (AttribValue <> '') then 
begin 
Values.Add(AttribValue);
inc(Result); 
end; 
end;

if (RPos <= 0) then 
LastInnerPos := Length(InnerTag) 
else 
LastInnerPos := RPos+1; 
end; 
end; 
end; 
end;


用法示例：
取得页面中所有链接
var
Links : TStringList;
LinkFound,i : Integer;
begin
Links := TStringList.Create;
LinkFound := ExtractHtmlTagValues(HtmlText,'A','HREF',Links);
for i:=0 to LinkFound-1 do
begin
//Add your own codes here
end;
Links.Free;
end;

2)表单元素值攫取函数，可以从HTML文本中按照给定的Input名称解析出其Value

function GetValByName(S, Sub: string) : string;
var
EleS,EleE,iPos: Integer;
ELeStr,ValSt: String;
St,Ct : Integer;
function FindEleRange(str: string ; front : boolean; posi : integer): Integer;
var
i: integer;
begin
if Front then
begin
for i:=posi-1 downto 1 do
if Str[i]='<' then
begin
Result := i;
break;
end;
end else begin
for i := posi+1 to length(Str) do
if Str[i]='>' then
begin
Result := i;
break;
end;
end;
end;
function FindEnd (str : string; posi : integer) : Integer;
var
i: integer;
begin
for i:=posi to length(str) do
begin
if (str[i] ='"') or (str[i] ='''') or (str[i] =' ') then
begin
result := i-1;
break;
end;
end;
end;
begin
iPos := Pos('name="'+lowercase(Sub)+'"',lowercase(S));
if iPos = 0 then iPos := Pos('name='+lowercase(Sub),lowercase(S));
if iPos = 0 then iPos := Pos('name='''+lowercase(Sub)+'''',lowercase(S));
if iPos = 0 then exit;
EleS := FindEleRange(S,TRUE,iPos);
EleE := FindEleRange(S,FALSE,iPos);
EleStr := Copy(S,EleS,EleE-EleS+1);
ValSt := 'value="';
iPos := Pos(ValSt,EleStr);
if iPos = 0 then
begin
ValSt := 'value=''';
iPos := Pos(ValSt,EleStr);
end;
if iPos = 0 then
begin
ValSt := 'value=';
iPos := Pos(ValSt,EleStr);
end;
St := iPos+length(ValSt);
Ct := FindEnd(EleStr,St)-St+1;
Result := Copy(EleStr,St,Ct);
end;

用法示例：
取得页面中名为 Submit 的表单项的值
var
InputValue : String;
begin
InputValue := GetValByName(HtmlText,'Submit'); 
end;

3）取某两个字符串中间的字符

function getStrFromHtml(var Source: String; SbStr, bStr, eStr: String): String;
var
I: Integer;
sbPos, bPos, ePos: Integer;
S: String;
begin
S := Source;

Result := '' ;
if SBStr <> '' then
Begin
sbPos := Pos(UpperCase(SbStr), UpperCase(S));
if sbPos > 0 then
Delete(S, 1, sbPos - 1 + length(sbStr))
Else
Exit;
End;

bPos := Pos(UpperCase(bStr), UpperCase(S));
if bPos > 0 then
Delete(S, 1, bPos - 1 + length(bStr))
Else
Exit;

ePos := pos(UpperCase(eStr), UpperCase(S));
if ePos > 0 then
Delete(S, ePos, length(S));

Result := S;
end;

用法实例：
FUserID := getStrFromHtml(reqStr, 'id="userID"', 'value="', '"');
delphi 几个实用的HTML解析函数

相关推荐

评论
