VPF::распарсить html и в stringgrid - Форум программистов

wofs

Дата 1.4.2009, 15:31 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 1.5.2007

Репутация: нет
Всего: нет

Привет. Есть html файл след структуры

Код


<html> 
<body><b>некий текст, не нужен</b>
 <table style="text-align: left; width: 100%;" border="1">
  <tr>
    <td width="93" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
    <td width="431" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">Заголовок, не нужен</font></td>
</tr>
  <tr>
    <td width="93" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="431" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
</tr>
    <tr>
    <td width="93" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="431" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
    <td width="50" height="17"><font color="#000000" face="Arial">данные</font></td>
</tr>
  <tr><td></td><td></td><td></td><td></td><td></td><td><b>некий текст, не нужен</b></td></tr></table>
</body>
</html>

задача выдернуть данные из него и закинуть в стринг-грид. точнее проблема именно выдернуть... пытался парсить по тегам - ничего хорошего не вышло :( помогите плиз.
структура файла всегда одна, только могут добавляться строки в таблице, т.е. кол-во строк в таблице неизвестно.

Это сообщение отредактировал(а) wofs - 1.4.2009, 15:33

Alix

Дата 1.4.2009, 15:34 (ссылка)

(нет голосов)

Загрузка ...

L45

Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 7
Всего: 23

тег фонт игнорируется? цвета на stringgrid переносятся?

--------------------

Знание только тогда знание, когда оно приобретено усилиями своей мысли, а не памятью (с) Л. Толстой
High tech. Low live. (с) Gardner Dozois

wofs

Дата 1.4.2009, 16:03 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 1.5.2007

Репутация: нет
Всего: нет

Цитата(Alix @ 1.4.2009, 15:34)

тег фонт игнорируется? цвета на stringgrid переносятся?

нужны только данные, остальное в игнор smile

Данкинг

Дата 1.4.2009, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130

Цитата(wofs @ 1.4.2009, 16:31

)

ничего хорошего не вышло

Что именно не получается и что ты от нас хочешь? smile

--------------------

There's nothing left but silent epitaphs.

Alix

Дата 1.4.2009, 17:57 (ссылка)

(нет голосов)

Загрузка ...

L45

Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 7
Всего: 23

Вот честно позаимствованный из FIT и переработанный мной для дельфи кусок парсера. В нем много странно: публичные поля, рабочий код прямо в конструкторе - так было и в оригинальной версии. Конструктор 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;

В аттаче весь проект.

Присоединённый файл ( Кол-во скачиваний: 39 )

HTMLTableParser.zip 2,62 Kb

--------------------

wofs

Дата 2.4.2009, 08:25 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 1.5.2007

Репутация: нет
Всего: нет

Цитата(Данкинг @ 1.4.2009, 17:54)

Что именно не получается и что ты от нас хочешь? smile

у меня получилось очистить код от тегов, но закинуть в стринг-грид не получилось, т.к. текст получался списком в мемо.

Добавлено через 40 секунд
Alix, спасибо большое, все работает! тема закрыта.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »