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

Alexeis

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

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

Загрузка ...

Амеба

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

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

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

)

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

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

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

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

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

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

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 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »