VPF::[Delphi] Поиск и копирование в текстовом файле

lamos123456

Дата 7.11.2006, 05:55 (ссылка)

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

Загрузка ...

Новичок

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

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

Подскажите как сделать поиск в текстовом файле от определённых символов например от " и до '
а всё что между ними складывать в другой фаил?

Dynamic

Дата 7.11.2006, 06:54 (ссылка)

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

Загрузка ...

Опытный

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

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

Ищешь ", запоминаешь позицию, ищешь ', копируешь все от первой запомненной позиции до этой, ищешь дальше от последней позиции. В чем проблема-то?

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

lamos123456

Дата 7.11.2006, 07:26 (ссылка)

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

Загрузка ...

Новичок

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

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

Я незнаю как работать с pos можешь пример небольшой дать?

Dynamic

Дата 7.11.2006, 07:40 (ссылка)

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

Загрузка ...

Опытный

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

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

пример, который дает дельфя по Ф1 (справка, если ты не знал)

Код


var S: string;

begin
  S := '   123.5';
  { Convert spaces to zeros }
  while Pos(' ', S) > 0 do
    S[Pos(' ', S)] := '0';
end;

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

Insert

Дата 7.11.2006, 07:44 (ссылка)

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

Загрузка ...

Бывалый

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

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

d:integer
d:= pos('б,'абвг')
в d будет 2 - позиция строки в подстроке, если подстрока будет не найдена то в d будет 0

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

пьяный русский кодер практически непобедим

lamos123456

Дата 7.11.2006, 08:56 (ссылка)

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

Загрузка ...

Новичок

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

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

Вот у меня есть файл вида

Код


class="cat">More&nbsp;from&nbsp;this&nbsp;site</a>&nbsp;- <a  href="/search?q=&q.related=http%3A%2F%2Fwww%2Eurbandictionary%2Ecom%2Fdefine%2Ephp%3Fterm%3Dlol&adv=1&channel=1&tag=se.sr-1-118-1140,1436.sim" class="cat">Similar&nbsp;pages</a><br /><span class="attrib">[ Result from <a href="http://www.google.com/search?q=lol">Google</a>, <a href="http://search.msn.com/results.aspx?FORM=PORE1&srch_type=0&count=21&q=lol">MSN</a> ]</span></span></li><li><a class="title"  href="/click?sl,marin.1.118.1249-1554.1.7.lol.0,http%3A%2F%2Fwww%2Especialissues%2Ecom%2Flol%2F">Special Issues - Gary Price's List of Lists</a><br />One of FIND/SVP's 60 "Best of the Business Web" selections.  http://www.bestbizweb.com<br /><span class="url">www.specialissues.com/lol&nbsp;- <a  href="/search?q=lol&adv=1&q.site=www%2Especialissues%2Ecom&channel=1&tag=se.sr-1-118-1249,1554.dom" class="cat">More&nbsp;from&nbsp;this&nbsp;site</a>&nbsp;- <a  href="/search?q=&q.related=http%3A%2F%2Fwww%2Especialissues%2Ecom%2Flol%2F&adv=1&channel=1&tag=se.sr-1-118-1249,1554.sim" class="cat">Similar&nbsp;pages</a><br /><span class="attrib">[ Result from <a href="http://www.wisenut.com/search/query.dll?q=lol">Wisenut</a>, <a href="http://www.ask.com/web?q=lol">Ask.com</a> ]</span></span></li><li><a class="title"  href="/click?sl,marin.1.118.1554.1.8.lol.0,http%3A%2F%2Fwww%2Evegsource%2Ecom%2Ftalk%2Frecipes%2Fmessages%2F53300%2Ehtml">Dumb question, but what do &quot;ISO&quot; and &quot;<b>LOL</b>&quot; stand for in web-speak?? ...</a><br />From: Frannie (hse-mtl-ppp77919.qc.sympatico.ca)  Subject: Dumb question, but what do "ISO" and "<b>LOL</b>" stand for in web-speak??<br /><span class="url">www.vegsource.com/talk/recipes…53300.html&nbsp;- <a  href="/search?q=lol&adv=1&q.site=www%2Evegsource%2Ecom&channel=1&tag=se.sr-1-118-1554.dom"

нужно выдернуть все ссылки немогу понять как сделать поиск например от href=" до " я в программировании недавно smile

Guedda

Дата 7.11.2006, 09:05 (ссылка)

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

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

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

Код


var
  s : string;
begin
  s := 'class="cat">More&nbsp;from&nbsp;this&nbsp;site</a>&nbsp;- <a  href="/search?q=&q.related=http%3A%2F%2Fwww%2Eurbandictionary%2Ecom%2Fdefine%2Ephp%3Fterm%3Dlol&adv=1&channel=1&tag=se.sr-1-118-1140,1436.sim" class="cat">Similar&nbsp;pages</a><br /><span class="attrib">[ Result from <a href="http://www.google.com/search?q=lol">Google</a>, <a href="http://search.msn.com/results.aspx?FORM=PORE1&srch_type=0&count=21&q=lol">MSN</a> ]</span></span></li><li><a class="title"  href="/click?sl,marin.1.118.1249-1554.1.7.lol.0,http%3A%2F%2Fwww%2Especialissues%2Ecom%2Flol%2F">Special Issues - Gary Price's List of Lists</a><br />One of FIND/SVP's 60 "Best of the Business Web" selections.  http://www.bestbizweb.com<br /><span class="url">www.specialissues.com/lol&nbsp;- <a  href="/search?q=lol&adv=1&q.site=www%2Especialissues%2Ecom&channel=1&tag=se.sr-1-118-1249,1554.dom" class="cat">More&nbsp;from&nbsp;this&nbsp;site</a>&nbsp;- <a  href="/search?q=&q.related=http%3A%2F%2Fwww%2Especialissues%2Ecom%2Flol%2F&adv=1&channel=1&tag=se.sr-1-118-1249,1554.sim" class="cat">Similar&nbsp;pages</a><br /><span class="attrib">[ Result from <a href="http://www.wisenut.com/search/query.dll?q=lol">Wisenut</a>, <a href="http://www.ask.com/web?q=lol">Ask.com</a> ]</span></span></li><li><a class="title"  href="/click?sl,marin.1.118.1554.1.8.lol.0,http%3A%2F%2Fwww%2Evegsource%2Ecom%2Ftalk%2Frecipes%2Fmessages%2F53300%2Ehtml">Dumb question, but what do &quot;ISO&quot; and &quot;<b>LOL</b>&quot; stand for in web-speak?? ...</a><br />From: Frannie (hse-mtl-ppp77919.qc.sympatico.ca)  Subject: Dumb question, but what do "ISO" and "<b>LOL</b>" stand for in web-speak??<br /><span class="url">www.vegsource.com/talk/recipes…53300.html&nbsp;- <a  href="/search?q=lol&adv=1&q.site=www%2Evegsource%2Ecom&channel=1&tag=se.sr-1-118-1554.dom"';
  while Pos('<a href="', s) > 0 do begin
    Memo1.Lines.Add(copy(s, Pos('<a href="'), Pos('"'));
  end;
end;

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

Ll 2

lamos123456

Дата 7.11.2006, 09:15 (ссылка)

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

Загрузка ...

Новичок

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

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

А если мне нужно файл перебирать? А не строку?

Dynamic

Дата 7.11.2006, 09:20 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(lamos123456 @ 7.11.2006, 09:15

)

А если мне нужно файл перебирать? А не строку?

прочитай файл в строку и читай как строку.

Код


var L: TStringList
begin
L := TStringList.Create;
L.LoadFromFile('file.htm');
//    L.Text       << ----   твоя строка

Цитата(Guedda @ 7.11.2006, 09:05

)

;
  while Pos('<a href="', s) > 0 do begin
    Memo1.Lines.Add(copy(s, Pos('<a href="'), Pos('"'));
  end;

бесконечный цикл

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

lamos123456

Дата 7.11.2006, 09:38 (ссылка)

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

Загрузка ...

Новичок

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

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

Вот выдаёт ошибку

Код


     L := TStringList.Create;
                  L.LoadFromFile('SEARCH.txt');
                        while Pos('<a href="', L.Text) > 0 do begin
                        Memo1.Lines.Add(copy(L.Text, Pos('<a href="'){тут выдаёт ошибку}, Pos('"'));
                        end;
end;

Dynamic

Дата 7.11.2006, 09:51 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(lamos123456 @ 7.11.2006, 09:38

)

Вот выдаёт ошибку

посмотри синтаксис функции Pos, ты указал ЧТО искать, но не указал ГДЕ искать.
хотя выше написано верно :

Код


Pos('<a href="', L.Text)

вот что значит копировать не думая...

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

lamos123456

Дата 7.11.2006, 10:05 (ссылка)

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

Загрузка ...

Новичок

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

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

Так вот я и пытаюсь разобраться в работе этой функции...
Так работает, только алгоритм находит лишь 1 ссылку, а как сделать чтобы когда он нашёл ссылку переходил дальше и искал следующую, а когда заканчивается файл *.тхт останавливался?

Это сообщение отредактировал(а) lamos123456 - 7.11.2006, 10:07

Alexeis

Дата 7.11.2006, 10:09 (ссылка)

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

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

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

Цитата(lamos123456 @ 7.11.2006, 10:05

)

Так работает, только алгоритм находит лишь 1 ссылку, а как сделать чтобы когда он нашёл ссылку переходил дальше и искал следующую?

Для этого лучше использовать PosEx() модулть strUtils, он позволяет искать начиная в определенной позиции.

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

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

lamos123456

Дата 7.11.2006, 10:16 (ссылка)

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

Загрузка ...

Новичок

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

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

alexeis1,
А можешь пример привести и обьяснить как она работает?

Dynamic

Дата 7.11.2006, 10:19 (ссылка)

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

Загрузка ...

Опытный

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

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

можно примерно так:

Код


procedure TForm1.BitBtn1Click(Sender: TObject);
const Prefix = 'href="';
var i, j: integer;
    src: string;
begin
     src := AnsiLowerCase(Memo1.Text);
     Memo2.Lines.BeginUpdate;
     try
       j := 1;
       repeat
         i := PosEx(src, Prefix, j);
         if i > 0 then
         begin
           inc(i, Length(Prefix));
           j := PosEx(src, '"', i);
           if j > 0 then
           begin
             Memo2.Lines.Add(Copy(src, i, j-i));
             i := Succ(j);
           end;
         end;
       until i = 0;
     finally
       Memo2.Lines.EndUpdate;
     end;
end;

Добавлено @ 10:20
а это PosEx (не помню, где стырил):

Код


function PosEx(const S, SubStr: AnsiString; FromPos: integer): integer;
var
  P: PChar;
begin
  Result := 0;
  P := AnsiStrPos(PChar(S) + FromPos - 1, PChar(SubStr));
  if P <> nil then
    Result := Integer(P) - Integer(PChar(S)) + 1;
end;

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

Alexeis

Дата 7.11.2006, 10:48 (ссылка)

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

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

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

Цитата(Dynamic @ 7.11.2006, 10:19

)

а это PosEx (не помню, где стырил):

Зачем его тырить, когда он и так есть и оптимизирован на ассемблере в модуле StrUtils.

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

lamos123456

Дата 7.11.2006, 10:59 (ссылка)

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

Загрузка ...

Новичок

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

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

Вот сделал так вообще ничего в Memo2 нет smile

Просто как в пустую кнопку тыкаю и все...

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils,StrUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
const Prefix = 'href="';
var i, j: integer;
    src: string;
    L:TStringList;
begin
    L := TStringList.Create;
    L.LoadFromFile('SEARCH.txt');
    src := AnsiLowerCase(L.Text);
     Memo2.Lines.BeginUpdate;
     try
       j := 1;
       repeat
         i := PosEx(src, Prefix, j);
         if i > 0 then
         begin
           inc(i, Length(Prefix));
           j := PosEx(src, '"', i);
           if j > 0 then
           begin
             Memo2.Lines.Add(Copy(src, i, j-i));
             i := Succ(j);
           end;
         end;
       until i = 0;
     finally
       Memo2.Lines.EndUpdate;
     end;
end;

end.

Elfebet

Дата 7.11.2006, 11:42 (ссылка)

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

Загрузка ...

Опытный

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

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

У меня была точно такая же задача. Вот пример полностью рабочий, кидаеш на форму memo1, button1:

Код


procedure FindURLs(text: string; listURL:TStringList);

    function NormalizeUrl(var Url:String):Boolean;
    var i:integer;
    begin
      Result:=False;
      Url:=StringReplace(Url, '#13#10', '', [rfReplaceAll]);
      i:=Pos(' ', Url);
      if (i<>0) then Url:=Copy(Url, 1, i-1);
      Url:=StringReplace(Url, '"', '', [rfReplaceAll]);
      Url:=StringReplace(Url, '''', '', [rfReplaceAll]);
      if ((Pos(';', Url)<>0)or
          (Pos('@', Url)<>0)or
          (Pos('#', Url)<>0)or
          (Pos('mailto:', Url)<>0)or
          (Pos('file://', Url)<>0)) then Exit;
      if Url='' then Exit;
      Result:=True;
    end;

var idxPos:Integer;
    link:string;
begin
    idxPos:=1;
    listURL.Clear;
    while True do begin
      idxPos:=PosEx('<a ', text, idxPos);
      if idxPos=0 then Break;
      Inc(idxPos, 2);
      idxPos:=PosEx('href=', text, idxPos);
      if idxPos<=0 then Continue;
      Inc(idxPos, 5);
      link:=Copy(text, idxPos, PosEx('>', text, idxPos)-idxPos);
      if (not NormalizeUrl(link)) then Continue;
      listURL.Add(link);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var list:TStringList;
begin
  list:=TStringList.Create;
  FindURLs(AnsiLowerCase(Memo1.Lines.Text), list);
  Memo1.Lines:=list;
  list.Free;
end;

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

Программист не должен всё знать... он должен знать где можно посмотреть

Dynamic

Дата 7.11.2006, 13:17 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(alexeis1 @ 7.11.2006, 10:48

)

Зачем его тырить, когда он и так есть и оптимизирован на ассемблере в модуле StrUtils.

есть, да не у всех. У меня в Д6, например, нету, вот и пришлось тырить ;)

Добавлено @ 13:20

Цитата(lamos123456 @ 7.11.2006, 10:59

)

Вот сделал так вообще ничего в Memo2 нет
Просто как в пустую кнопку тыкаю и все...

попробуй первую строку переписать так:

Код


src := StringReplace(AnsiLowerCase(Memo1.Text), #13#10, ' ', [rfReplaceAll]);

а вообще отладчик в таких случаях помогает

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

lamos123456

Дата 7.11.2006, 17:18 (ссылка)

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

Загрузка ...

Новичок

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

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

Я только в делфи пытаюсь что то сделать а ты отладчик..
Во всяких EAX я 0... тут главное разобраться, что я и хочу сделать!!!
Я не хочу просто копипастить я ОЧЕНЬ хочу вникнуть как это работает!!!!
Я понимаю что таких тысячи и миллионы.... , но всётаки не все хотят
понять как это работает! Им лишь бы защитить свой диплом и получит бумажку! Я ХОЧУ, ОЧЕНЬ ХОЧУ научиться писать программы!!!... Я ещё студент, но я учусь... И вы мне очень помогаете спасибо вам за это!!! Ну извините за глупые(для вас) вопросы, просто я пытаюсь что то написать! Вы мне очень помогли спасибо вам огромное!!!!

Dynamic

Дата 8.11.2006, 06:42 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(lamos123456 @ 7.11.2006, 17:18

)

Я только в делфи пытаюсь что то сделать а ты отладчик..
Во всяких EAX я 0...

Не путай отладчик и дизассемблер.

Цитата(lamos123456 @ 7.11.2006, 17:18

)

Я не хочу просто копипастить я ОЧЕНЬ хочу вникнуть как это работает!!!!
Я понимаю что таких тысячи и миллионы.... , но всётаки не все хотят
понять как это работает! Им лишь бы защитить свой диплом и получит бумажку! Я ХОЧУ, ОЧЕНЬ ХОЧУ научиться писать программы!!!... Я ещё студент, но я учусь

нечасто такое можно услышать...

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

Было бы о чем молчать, а уж что сказать – всегда найдется...

lamos123456

Дата 9.11.2006, 06:59 (ссылка)

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

Загрузка ...

Новичок

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

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

Elfebet,
А куда этот код вставлять? Вставляю в кнопку ошибку выдаёт...

Elfebet

Дата 9.11.2006, 10:01 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата

А куда этот код вставлять? Вставляю в кнопку ошибку выдаёт...

Вставляеш код на нажатие кнопки:
var list:TStringList;
begin
  list:=TStringList.Create;
  FindURLs(AnsiLowerCase(Memo1.Lines.Text), list);
  Memo1.Lines:=list;
  list.Free;

а функцию приведенную в моем сообщении FindURLs поставь выше процедуры нажатия на кнопки. вот   smile

а что за ошибку выдает?

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

Программист не должен всё знать... он должен знать где можно посмотреть

lamos123456

Дата 11.11.2006, 09:12 (ссылка)

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

Загрузка ...

Новичок

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

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

Elfebet,
Я просто забыл написать StrUtils поэтому и ошибку выдавало...
А как в твоей процедуре работать не с мемо а с тхт файлом?

Elfebet

Дата 11.11.2006, 11:32 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата

А как в твоей процедуре работать не с мемо а с тхт файлом?

ну загрузи файл в стринглист и работай.

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

Программист не должен всё знать... он должен знать где можно посмотреть

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