procedure THtmlDocumentTag.LinesChange(Sender: TObject);
var
Index: Integer;
Current: PChar;
CurrentTag:
String;
TagName:
String;
TagText:
String;
TagLines: TStrings;
InTag, InTagArea: Boolean;
TagKind: (tagOpen,tagClose,tagSingle,tagComment);
begin
for Index := 0
to TagCount - 1
do
begin
Tags[
Index].Free;
end;
SetLength(FTags,0);
FText := '
';
TagName := '
';
TagText := '
';
TagLines := TStringList.Create;
InTag := False;
InTagArea := False;
Current := PChar(Lines.Text);
try
try
while Current^ <> #0
do
begin
if (Current^ = '
<')
and ((Current + 1)^
in Letters + ['
!','
/'])
then
begin
InTag := True;
InTagArea := True;
if (Current + 1)^
in Letters
then
begin
TagKind := tagOpen;
if Length(TagName) <> 0
then
begin
TagText := TagText + Current^;
end;
//-->
Inc(Current);
Continue;
end;
if ((Current + 1)^ = '
!')
and ((Current + 2)^ = '
-')
and ((Current + 3)^ = '
-')
then
begin
TagKind := tagComment;
if Length(TagName) <> 0
then
begin
TagText := TagText + Current^ + (Current + 1)^ + (Current + 2)^ + (Current + 3)^;
end;
//-->
Inc(Current,4);
Continue;
end;
if ((Current + 1)^ = '
/')
and ((Current + 2)^
in Letters)
then
begin
TagKind := tagClose;
//-->
Inc(Current,2);
Continue;
end;
end;
if InTagArea
then
begin
if InTag
then
begin
case TagKind
of
tagSingle,
tagOpen:
if (Current^ = '
>')
or ((Current^ = '
/')
and (Length(Trim(CurrentTag)) <> 0))
then
begin
if Length(CurrentTag) <> 0
then
begin
InTag := False;
if Length(TagName) = 0
then
begin
TagName := CurrentTag;
end else
begin
TagText := TagText + Current^;
end;
CurrentTag := '
';
//Parse spaces and parameters .... (to be added)
if Current^ = '
/'
then
begin
TagKind := tagSingle;
if Length(TagText) <> 0
then
begin
TagText := TagText + Current^;
end;
end;
//-->
Inc(Current);
Continue;
end;
end else
begin
CurrentTag := CurrentTag + Current^;
if Length(TagName) <> 0
then
begin
TagText := TagText + Current^;
end;
//-->
Inc(Current);
Continue;
end;
tagClose:
if Current^ = '
>'
then
begin
if (Length(CurrentTag) <> 0)
and (Length(TagName) <> 0)
then
begin
InTag := False;
if TrimRight(CurrentTag) = TagName
then
begin
InTagArea := False;
SetLength(FTags,Length(FTags) + 1);
TagLines.Text := TagText;
FTags[TagCount - 1] := THtmlDocumentTag.Create(TagName,Document,Self,TagLines);
if Assigned(Document.OnTagAdd)
then
begin
Document.OnTagAdd(Self,FTags[TagCount - 1]);
end;
TagLines.Clear;
TagName := '
';
TagText := '
';
end else
begin
TagText := TagText + '
</' + CurrentTag + '
>';
end;
CurrentTag := '
';
//-->
Inc(Current);
Continue;
end;
end else
begin
CurrentTag := CurrentTag + Current^;
//-->
Inc(Current);
Continue;
end;
tagComment:
if (Current^ = '
-')
and ((Current + 1)^ = '
-')
and ((Current + 2)^ = '
>')
then
begin
InTag := False;
TagText := TagText + Current^ + (Current + 1)^ + (Current + 2)^;
//-->
Inc(Current,3);
Continue;
end else
begin
TagText := TagText + Current^;
//-->
Inc(Current);
Continue;
end;
end;
end else
begin
TagText := TagText + Current^;
//-->
Inc(Current);
Continue;
end;
end else
begin
FText := FText + Current^;
//-->
Inc(Current);
Continue;
end;
raise EHtmlParse.Create('
HTML parse error on line ' + IntToStr(CharLine(Current,Lines.Text)) + '
at position ' + IntToStr(CharPosition(Current,Lines.Text)));
end;
if InTagArea
then
begin
SetLength(FTags,Length(FTags) + 1);
TagLines.Text := TagText;
FTags[TagCount - 1] := THtmlDocumentTag.Create(TagName,Document,Self,TagLines);
if Assigned(Document.OnTagAdd)
then
begin
Document.OnTagAdd(Self,FTags[TagCount - 1]);
end;
end;
finally
TagLines.Free;
end;
except
raise;
end;
end;