Удалить дубли по началу строки

[gamer123]

Добрый день. Не могу даже алгоритм придумать, как удалить дубли. Есть мемо, там список линков вида

site1.ru/index.php?id=2
site1.ru/index.php?id=1
site1.ru/news.php?id=1
site3.ru/index.php?id=1
site1.ru/news.php?id=4
site1.ru/news.php?id=3

нужно удалить дубли по домену, т.е оставить 1 линк (то что после index.php или news.php сверять ненужно, без разницы что там) site1.ru/news.php?id=1 и site1.ru/news.php?id=1 (сверка на дубли идет по домену и 1му файлу, т.е
site1.ru/index.php).

из этого
site1.ru/index.php?id=2
site1.ru/index.php?id=1
site1.ru/news.php?id=1
site3.ru/index.php?id=1
site1.ru/news.php?id=4
site1.ru/news.php?id=3

должно остаться

site1.ru/index.php?id=2 или site1.ru/index.php?id=1 (без разницы)
site1.ru/news.php?id=1 или site1.ru/news.php?id=4 или site1.ru/news.php?id=3
site3.ru/index.php?id=1

[Stilet]

Не особо проверял но что-то в этом роде:

var e,k,i:integer; s:string;
begin
 e:=0;
 for i:=Memo1.Lines.Count-1 downto 0 do begin
   s:=copy(Memo1.Lines[i],1,pos('?',Memo1.Lines[i]));
   k:=Memo1.Perform(LB_FINDSTRING,e,integer(pchar(s)));
    if k<>LB_ERR then
       Memo1.Lines.Delete(e);
   inc(e);
 end;
   s:=copy(Memo1.Lines[0],1,pos('?',Memo1.Lines[0]));
   k:=Memo1.Perform(LB_FINDSTRING,1,integer(pchar(s)));
    if k<>LB_ERR then
       Memo1.Lines.Delete(0);
end;

[gamer123]

Сообщение от Stilet

Не особо проверял но что-то в этом роде:

var e,k,i:integer; s:string;
begin
 e:=0;
 for i:=Memo1.Lines.Count-1 downto 0 do begin
   s:=copy(Memo1.Lines[i],1,pos('?',Memo1.Lines[i]));
   k:=Memo1.Perform(LB_FINDSTRING,e,integer(pchar(s)));
    if k<>LB_ERR then
       Memo1.Lines.Delete(e);
   inc(e);
 end;
   s:=copy(Memo1.Lines[0],1,pos('?',Memo1.Lines[0]));
   k:=Memo1.Perform(LB_FINDSTRING,1,integer(pchar(s)));
    if k<>LB_ERR then
       Memo1.Lines.Delete(0);
end;

Жму кнопку, полсписка чистит, еще раз жму - еще список урезает, 3й раз жму - уже одлинарные ссылки удаляет, 4й раз - весь список очищает. В чем может быть проблема?

[Stilet]

В чем может быть проблема?

Я с потолка писал. особо не проверял.

[Alter]

Вот, работает как нужно

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure DelDuplicat(Inp: TStrings);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DelDuplicat(Inp: TStrings);
var
  I,J,II :Integer;
  Buf0,Buf1 :string;
begin // поиск и удаление дубликатов файлов
 if Inp=nil then Exit;
 if Inp.Count <= 0 then Exit;
  // чистим список
 Inp.BeginUpdate;
  try
 for I:=Inp.Count-1 DownTo 0 Do
 begin
    // строка для сравнения
   Buf0 := AnsiUpperCase(Inp.Strings[I]);
    // берём название домена
   if Pos('/', Buf0) > 0 then
    Buf0 := Copy(Buf0, 1, Pos('/', Buf0)-1);
     // ищим похожие строки
    for J:=I-1 Downto 0 do
    begin
     Buf1 := AnsiUpperCase(Inp.Strings[J]);
      // проверка совпадения
     if Pos(Buf0, Buf1) > 0 then
     begin
      Inp.Delete(J);
     end;
    end;
 end;
  finally
 Inp.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Button1.Enabled := False;
  try
 DelDuplicat(Memo1.Lines);
  finally
 Button1.Enabled := True;
  end;
end;

end.