Вот честно позаимствованный из http://en.wikipedia.org/wiki/Framework_for_Integrated_Tests и переработанный мной для дельфи кусок парсера. В нем много странно: публичные поля, рабочий код прямо в конструкторе - так было и в оригинальной версии. Конструктор Parse, а не Create - это уже моя работа, так он более отражает свою суть. Вообще код в целом довольно простой, я намеренно не использовал конструкции try и т.п. чтобы не загромождать код.
| Код | type
TParser = class
public
sLeader,
sTag,
sBody,
sEnd,
sTrailer : string;
more: TParser;
parts: TParser;
constructor Parse(const text: string);overload;
constructor Parse(const text: string; const tags: array of string);overload;
constructor Parse(const text: string; const tags: array of string; level, offset: integer);overload;
procedure print(where: TMemo);
end;
const
tags: array [1..3] of string = ('table', 'tr', 'td');
implementation
{ TParser }
constructor TParser.Parse(const text: string);
begin
self.Parse(text, tags, 0, 0);
end;
constructor TParser.Parse(const text: string; const tags: array of string);
begin
self.Parse(text, tags, 0, 0);
end;
constructor TParser.Parse(const text: string; const tags: array of string;
level, offset: integer);
var
lc: string;
startTag,
endTag,
startEnd,
endEnd,
startMore: integer;
begin
lc := AnsiLowerCase(text);
startTag := Pos('<' + tags[level], lc);
endTag := PosEx('>', lc, startTag + 1) + 1; // 3rd arg posex have +1 to prevent 0 offset
startEnd := PosEx('</' + tags[level], lc, endTag);
endEnd := PosEx('>', lc, startEnd + 1) + 1;
startMore := PosEx('<' + tags[level], lc, endEnd);
if (startTag = 0) or (endTag = 0) or (startEnd = 0) or (endEnd = 0) then
raise Exception.Create('Cannt find tag ' + tags[level] + ' at offset: ' + inttostr(offset));
sLeader := copy(lc, 1, startTag - 1);
sTag := copy(lc, startTag, endTag - startTag);
sBody := copy(lc, endTag, startEnd - endTag);
sEnd := copy(lc, startEnd, endEnd - startEnd);
sTrailer := copy(lc, endEnd, length(lc));
if (level + 1) < length(tags) then
begin
parts := TParser.Parse(sBody, tags, level+1, offset + endTag);
sBody := '';
end;
if startMore > 0 then
begin
more := TParser.Parse(sTrailer, tags, level, offset + endEnd);
sTrailer := '';
end;
end;
procedure TParser.print(where: TMemo);
begin
where.lines.add(sLeader);
where.lines.add(sTag);
if (parts <> nil) then
parts.print(where)
else
where.lines.add(sBody);
where.lines.add(sEnd);
if (more <> nil) then
more.print(where)
else
where.lines.add(sTrailer);
end; |
Пример применения конкретно для твоей задачи:
| Код |
procedure fillTable(table: TParser; grid: TStringGrid); forward;
procedure fillRow(row: TParser; grid: TStringGrid; rowIndex: integer);forward;
procedure fillCell(text: string; grid: TStringGrid; rowIndex, columnIndex: integer);forward;
procedure fillStringGrid(const filename: string; grid: TStringGrid);
var
list: TStringList;
parser: TParser;
begin
list := TStringList.Create;
list.LoadFromFile(filename);
parser := TParser.Parse(list.Text);
// assume there's only one table
if copy(parser.sTag, 2, 5) = 'table' then
fillTable(parser, grid);
end;
procedure fillTable(table: TParser; grid: TStringGrid);
var
row: TParser;
rowIndex: integer;
begin
row := table.parts;
rowIndex := 0;
while (row <> nil) do
begin
if (grid.RowCount <= rowIndex) then
grid.RowCount := rowIndex + 1;
fillRow(row, grid, rowIndex);
row := row.more;
inc(rowIndex);
end;
end;
procedure fillRow(row: TParser; grid: TStringGrid; rowIndex: integer);
var
columnIndex: integer;
col: TParser;
begin
columnIndex := 0;
col := row.parts;
while (col <> nil) do
begin
if (grid.ColCount <= columnIndex) then
grid.ColCount := columnIndex + 1;
fillCell(col.sBody, grid, rowIndex, columnIndex);
col := col.more;
inc(columnIndex);
end;
end;
procedure fillCell(text: string; grid: TStringGrid; rowIndex, columnIndex: integer);
var
startTag,
endTag,
startEnd,
endEnd: integer;
begin
// этот код ужасен и его можно было бы избежать, если бы в td всегда был только тег font
// (тогда его можно запихать четвертым в константу tags и Parser автоматом бы его разобрал).
// Но т.к. там встречается и <b>, то пришлось их обработку перенести сюда
startTag := Pos('<font', text);
endTag := PosEx('>', text, startTag + 1) + 1;
startEnd := PosEx('</font', text, endTag);
endEnd := PosEx('>', text, startEnd + 1) + 1;
if (startTag = 0) or (endTag = 0) or (startEnd = 0) or (endEnd = 0) then
grid.Cells[columnIndex, rowIndex] := ''
else
grid.Cells[columnIndex, rowIndex] := copy(text, endTag, startEnd - endTag);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
fillStringGrid(OpenDialog1.FileName, StringGrid1);
end;
end; |
В аттаче весь проект. |
