Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [Delphi] Поиск и копирование в текстовом файле


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

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

Автор: lamos123456 7.11.2006, 07:26
Я незнаю как работать с pos можешь пример небольшой дать?

Автор: Dynamic 7.11.2006, 07:40
пример, который дает дельфя по Ф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
d:integer
d:= pos('б,'абвг')
в d будет 2 - позиция строки в подстроке, если подстрока будет не найдена то в d будет 0

Автор: lamos123456 7.11.2006, 08:56
Вот у меня есть файл вида 
Код

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
Код

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;

Автор: lamos123456 7.11.2006, 09:15
А если мне нужно файл перебирать? А не строку?

Автор: Dynamic 7.11.2006, 09:20
Цитата(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
Вот выдаёт ошибку 
Код

     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
Цитата(lamos123456 @  7.11.2006,  09:38 Найти цитируемый пост)
Вот выдаёт ошибку 


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

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

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

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

Автор: Alexeis 7.11.2006, 10:09
Цитата(lamos123456 @  7.11.2006,  10:05 Найти цитируемый пост)
Так работает, только  алгоритм находит лишь 1 ссылку, а как сделать чтобы когда он нашёл ссылку переходил дальше и искал следующую? 


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

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

Автор: Dynamic 7.11.2006, 10:19
можно примерно так:
Код

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
Цитата(Dynamic @  7.11.2006,  10:19 Найти цитируемый пост)
а это PosEx (не помню, где стырил):

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

Автор: lamos123456 7.11.2006, 10:59
Вот сделал так вообще ничего в 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
У меня была точно такая же задача. Вот пример полностью рабочий, кидаеш на форму 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
Цитата(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
Я только в делфи пытаюсь что то сделать а ты отладчик..
Во всяких EAX я 0... тут главное разобраться, что я и хочу сделать!!! 
Я не хочу просто копипастить я ОЧЕНЬ хочу вникнуть как это работает!!!!
Я понимаю что таких тысячи и миллионы.... , но всётаки не все хотят
 понять как это работает! Им лишь бы защитить свой диплом и получит бумажку! Я ХОЧУ, ОЧЕНЬ ХОЧУ научиться писать программы!!!... Я ещё студент, но я учусь... И вы мне очень помогаете спасибо вам за это!!!  Ну извините за глупые(для вас) вопросы, просто я пытаюсь что то написать! Вы мне очень помогли спасибо вам огромное!!!! 

Автор: Dynamic 8.11.2006, 06:42
Цитата(lamos123456 @  7.11.2006,  17:18 Найти цитируемый пост)
Я только в делфи пытаюсь что то сделать а ты отладчик..
Во всяких EAX я 0... 


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



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


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

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

Автор: Elfebet 9.11.2006, 10:01
Цитата

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

Вставляеш код на нажатие кнопки:
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
Elfebet, 
Я просто забыл написать StrUtils поэтому и ошибку выдавало...
А как в твоей процедуре работать не с мемо а с тхт файлом? 

Автор: Elfebet 11.11.2006, 11:32
Цитата

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


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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)