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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Найти повторяющиеся строки. как сделать? непонимаю... 
V
    Опции темы
Elfebet
Дата 23.8.2006, 14:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 14
Заношу в лист бокс пути:
c:\windows\file.txt
c:\windows\system\
c:\windows\system\filenew.txt
c:\windows\temp\1.txt
c:\windows\temp\1.txt
и мне надо найти повторяющиеся символы, вот из этого примера я должне получить результат "c:\windows\". как мне это сделать? подскажите плиз, очень нужно! smile 


--------------------
Программист не должен всё знать... он должен знать где можно посмотреть
PM MAIL ICQ GTalk   Вверх
Yanis
Дата 23.8.2006, 14:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Если не смущает, то что список будет сортированым, то:
Код
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Sorted := True;

  sl.Duplicates := dupIgnore;
  sl.Assign(ListBox1.Items);

  ListBox1.Items.Assign(sl);

  FreeAndNil(sl);
end;



--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
Elfebet
Дата 23.8.2006, 14:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 14
Yanis, твой пример не для моей задачи, в моем случае он вообще ничего не делает!


--------------------
Программист не должен всё знать... он должен знать где можно посмотреть
PM MAIL ICQ GTalk   Вверх
dumb
Дата 23.8.2006, 15:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 13
Всего: 158
Elfebet, ты свою задачу дюже криво описал. почему должно выбраться "c:\windows", а не "c:\" или "c:\windows\temp", скажем? и сколько строк нужно, чтобы подстрока считалась повторяющейся? - все, что есть в листбоксе?
PM MAIL   Вверх
Yanis
Дата 23.8.2006, 15:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Цитата(Elfebet @  23.8.2006,  15:30 Найти цитируемый пост)
из этого примера я должне получить результат "c:\windows\". 

Вот теперь понял, что требуется по настоящему smile


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
Elfebet
Дата 23.8.2006, 15:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 14
c:\windows - должно вернуть потому что оно во всех строчка повторяется, если добавить еще строку к примеру c:\program files, тогда должно вернуть c:\, если ничего не повторяется то естественно  ничего не вернуть.


--------------------
Программист не должен всё знать... он должен знать где можно посмотреть
PM MAIL ICQ GTalk   Вверх
Yanis
Дата 23.8.2006, 15:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Извиняюсь, что без комментариев.
Код
procedure TForm1.Button2Click(Sender: TObject);

  function AllEquals(const sl: TStrings): Boolean;
  var
    i: Integer;
  begin
    Result := False;
    for i := 0 to sl.Count - 2 do
      begin
        if sl.Strings[i] <> sl.Strings[i+1] then
          Exit;
      end;

    Result := True;
  end;

  procedure DeleteLast(const sl: TStrings);
  var
    i, p: Integer;
  begin
    for i := 0 to sl.Count - 1 do
      begin
        if sl.Strings[i][Length(sl.Strings[i])] = '\' then
          sl.Strings[i] := Copy(sl.Strings[i], 1, Length(sl.Strings[i]) - 1);

        p := LastDelimiter('\', sl.Strings[i]);
        sl.Strings[i] := Copy(sl.Strings[i], 1, p);
      end;
  end;
begin
  while not AllEquals(ListBox1.Items) do
    DeleteLast(ListBox1.Items);
end;


Добавлено @ 15:44 
Мой ListBox:
Цитата
C:\Documents and Settings\Yanis123\Cookies\yanis@nnm[1].txt
C:\Documents and Settings\Yanis\Cookies\yanis@spylog[2].txt
C:\Documents and Settings\Yanis\Cookies\yanis@empo[1].txt
C:\Documents and Settings\Yanis\Cookies\[email protected][2].txt
C:\Documents and Settings\Yanis\Cookies\[email protected][2].txt


Результат:
Цитата
C:\Documents and Settings\
C:\Documents and Settings\
C:\Documents and Settings\
C:\Documents and Settings\
C:\Documents and Settings\



--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
volvo877
Дата 23.8.2006, 16:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 14
Всего: 116
Elfebet, если нужен еще вариант:

Код
procedure TForm1.Button1Click(Sender: TObject);
var
  i, p: integer;
  s: string;
begin
  // В Edit2 будет храниться результат...
  edit2.Text := listbox1.Items.Strings[0];
  if edit2.Text[length(edit2.text)] <> '\' then
    edit2.Text := edit2.Text + '\';

  i := 0;
  while (i < listbox1.Items.Count) and (length(edit2.text) > 0) do begin
    s := edit2.Text;
    if (s <> '') and (Pos(s, listbox1.Items.Strings[i]) = 0) then
      while Pos(s, listbox1.Items.Strings[i]) = 0 do begin
        p := length(s) - 1;
        while (p > 0) and (s[p] <> '\') do dec(p);
        delete(s, p + 1, length(s) - p);
        edit2.text := s;

        if s = '' then break;

      end;
    inc(i);
  end;
end;


Это сообщение отредактировал(а) volvo877 - 23.8.2006, 16:44
PM MAIL   Вверх
Elfebet
Дата 23.8.2006, 16:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 14
Спасибо Вам большое!
volvo877,  мне твой вариант больше понравился.
Yanis, не в обиду. smile 


--------------------
Программист не должен всё знать... он должен знать где можно посмотреть
PM MAIL ICQ GTalk   Вверх
Yanis
Дата 23.8.2006, 17:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Цитата(Elfebet @  23.8.2006,  17:52 Найти цитируемый пост)
Yanis, не в обиду.

Без проблем.


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
dumb
Дата 4.9.2006, 09:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 13
Всего: 158
наткнулся тут еще на один вариант решения: PathCommonPrefix
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




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


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

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