Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Перебор Memo 
:(
    Опции темы
sneJok
Дата 4.10.2007, 12:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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



Пишу парсер для хтмл кода, нужно убрать ссылки во всем html коде.
Вот код:
Код

procedure TForm1.Button2Click(Sender: TObject);
var
y,i,z:Integer;
begin
Memo1.Lines.LoadFromFile('af.htm');
for i:=1 to Memo1.Lines.Count-1 do begin
   for y:=1 to Length(Memo1.Lines.Strings[i]) do begin
     if (MEmo1.Lines.Text[y]='<') then begin
         Memo1.SelStart:=y;
          Memo1.SelLength:=3;
        // удаление выделенного..
     end;
   end;
end;
end;


Вопросы:
1) Почему не работает код поиска тега <td, если реализовать так:
Код

Вместо:

     if (MEmo1.Lines.Text[y]='<') then begin

Написать так:

     if (MEmo1.Lines.Text[y]='<') and  (MEmo1.Lines.Text[y+1]='t') and  (MEmo1.Lines.Text[y+2]='d')  then begin    


2) При переборе, почему то выделяется всегда первая строка :/ , дальше перебор не идет, почему?
3) Как удалить выделенный тег?

Заранее благодарю.
PM MAIL   Вверх
fse
Дата 4.10.2007, 12:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 75
Регистрация: 28.9.2007
Где: г. Рязань

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



Привет. Попробуй так:

Код

procedure TForm1.Button1Click(Sender: TObject);

  function CheckDataAtPos(const Txt: string; const Data: string; FromPos: Integer): Boolean;
  var
    SubStr: string;
  begin
    Result := Length(Txt) - FromPos > Length(Data);
    if not Result then Exit;
    SubStr := Copy(Txt, FromPos, Length(Data));
    Result := SubStr = Data;
  end;

var
  S: string;
  I: Integer;

begin
  S := LowerCase(Memo1.Lines.Text);
  for I := Memo1.SelStart + 1 to Length(S) do
  begin
    if not CheckDataAtPos(S, '<td', I) then Continue;
    Memo1.SelStart := I;
    Memo1.SelLength := 2;
    Exit;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SendMessage(Memo1.Handle, WM_KEYDOWN, VK_DELETE, 0);
end;


По щелчку на Button1 найдётся TD, Button2 - удалится выделенный текст
PM MAIL   Вверх
sneJok
Дата 4.10.2007, 14:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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



Все-таки интересно узнать, что я сделал не так...

Спасибо за быстрый ответ, и за пример, ща буду разбираться.
PM MAIL   Вверх
DonPager
Дата 4.10.2007, 14:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Колдырь
**


Профиль
Группа: Участник
Сообщений: 327
Регистрация: 28.3.2003
Где: Воронеж

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



Цитата(sneJok @  4.10.2007,  06:12 Найти цитируемый пост)
Все-таки интересно узнать, что я сделал не так...
 во-первых надо привести буковки перед проверкой либо к верху либо к низу(UperCase LowerCase)
во вторых это не совсем корректно т.k. хтмл позволяет располагать название тегов как хочет
Код

< Td>
<td    >
<     TD   >
<td align=>
итд




--------------------
кодер + лодырь = колдырь
PM MAIL ICQ Skype GTalk   Вверх
fse
Дата 4.10.2007, 14:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 75
Регистрация: 28.9.2007
Где: г. Рязань

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



Посмотрим...

Код

procedure TForm1.Button2Click(Sender: TObject);
var
y,i,z:Integer;
begin
Memo1.Lines.LoadFromFile('af.htm');
for i:=1 to Memo1.Lines.Count-1 do begin
   for y:=1 to Length(Memo1.Lines.Strings[i]) do begin
     if (MEmo1.Lines.Text[y]='<') then begin
         Memo1.SelStart:=y;
          Memo1.SelLength:=3;
        // удаление выделенного..
     end;
   end;
end;
end;


1.

for i:=1 to Memo1.Lines.Count-1 do
i должна индексироваться с 0

2. Главное.
if (MEmo1.Lines.Text[y]='<') then ...

Скорее тогда

if (MEmo1.Lines[i, y]='<') then ...

Добавлено через 6 минут и 45 секунд
DonPager, вариант
Код

<     TD

Всё же, наверно, вряд ли. После < не допускается белых мест. Хотя блин, кто знает, по-всякому пишут! smile
PM MAIL   Вверх
sneJok
Дата 4.10.2007, 15:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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



вопросы...

Код

во-первых надо привести буковки перед проверкой либо к верху либо к низу(UperCase LowerCase)


Зачем?

Код

if (MEmo1.Lines[i, y]='<') then ...


Не понял кода. Поясни .
PM MAIL   Вверх
fse
Дата 4.10.2007, 16:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 75
Регистрация: 28.9.2007
Где: г. Рязань

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



if (MEmo1.Lines[i, y]='<') then ...
Вернее так: if (MEmo1.Lines[i][y]='<') then ...
Это мы берём i-тую строку, символ y.
Только тогда нужно ещё сделать проверку, не пустая ли строка, иначе будет ошибка. А вообще, советую сделать не так, а-то как-то не по-хорошемуsmile
Используй код, что я тебе дал хотя бы.
Цитата

вопросы...

 во-первых надо привести буковки перед проверкой либо к верху либо к низу(UperCase LowerCase)

Зачем?



Как зачем? Человек может написать и <td> и <TD>. Их сравнение покажет, что они не равны. А если сделать так if LowerCase(S) = '<td' - то всё покатит.
PM MAIL   Вверх
DonPager
Дата 4.10.2007, 16:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Колдырь
**


Профиль
Группа: Участник
Сообщений: 327
Регистрация: 28.3.2003
Где: Воронеж

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



Цитата(sneJok @  4.10.2007,  07:07 Найти цитируемый пост)
код Pascal/Delphi
1:
во-первых надо привести буковки перед проверкой либо к верху либо к низу(UperCase LowerCase)
Зачем?

Затем что тогда ты сможешь смело их сравнивать или с большими буковками или с маленькими не боясь что в коде используются другие
Код

S := ' <Td> ';
if S[1]='<' and S[2]='t' and S[3]='d' then OK; //не сработает
S := ' <Td> ';
S := LowerCase(S);
if S[1]='<' and S[2]='t' and S[3]='d' then OK; //сработает



--------------------
кодер + лодырь = колдырь
PM MAIL ICQ Skype GTalk   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

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


 




[ Время генерации скрипта: 0.0548 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.