• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 701
  • Last Modified:

Remove duplicate URL

I have a memo1 with 1000 URL in,  i want to remove all duplicate domain url in and keep only 1.

www.site.com/hello.php    and   www.site.com/index.html   are same domain i want it delete all duplicate domain URL and keep only 1 with is extension.


THANK YOU 500 point foy you.
0
Clubreseau
Asked:
Clubreseau
  • 2
1 Solution
 
ThievingSixCommented:
Are all domains going to be in the format www.domain.com or will some be domain.com?
0
 
ClubreseauAuthor Commented:
some domain www.site.com some domain site.com and some domain site.com/hello.php
0
 
ThievingSixCommented:
This should work:
procedure RemoveDuplicateDomain(Memo: TMemo);
var
  Data : TStringList;
  Domain : String;
  I, J : Integer;
  Count : Integer;
  WWWPos : Integer;
  SLASHPos : Integer;
  DomainIndex : Integer;
begin
  Data := TStringList.Create;
  Data.Text := LowerCase(Memo.Text);
  I := 0;
  Count := Data.Count;
  While I < Count Do
    begin
    Domain := Data.Strings[I];
    WWWPos := Pos('www',Domain);
    SLASHPos := Pos('/',Domain);
    If SLASHPos = 0 Then SLASHPos := Length(Domain);
    If WWWPos > 0 Then
      begin
      Domain := Copy(Domain,WWWPos + 3,SLASHPos - (WWWPos + 3));
    end
    Else
      begin
      Domain := Copy(Domain,1,SLASHPos - 1);
    end;
    J := I + 1;
    While J < Count Do
      begin
      DomainIndex := Pos(Domain,Data.Strings[J]);
      If DomainIndex > 0 Then
        begin
        Data.Delete(J);
        Dec(Count);
        Continue;
      end;
      Inc(J);
    end;
    Inc(I);
  end;
  Memo.Text := Data.Text;
end;

Open in new window

0
 
ziolkoCommented:
try this:

uses Wininet;

function GetDomain(AURL: string):string;
var comps: URL_COMPONENTS;
    hs, pth: string;
begin
  FillChar(comps, SizeOf(comps), 0);
  comps.dwStructSize := SizeOf(comps);
  comps.dwHostNameLength := 1;
  comps.dwUrlPathLength := 1;
  if InternetCrackUrl(PChar(AURL), Length(AURL), 0, comps) then begin
    hs := comps.lpszHostName;
    pth := comps.lpszUrlPath;
    Delete(hs, Pos(pth, hs), MaxInt);
    Result := hs;
  end else
    Result := '';
end;

procedure TForm1.Button6Click(Sender: TObject);
var sl: TStringList;
    cnt: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Sorted := True;
    sl.Duplicates := dupIgnore;
    for cnt := 0 to Memo1.Lines.Count - 1 do
      sl.Add(GetDomain(Memo1.Lines[cnt]));
    Memo1.Lines.Assign(sl);
  finally
    sl.Free;
  end;
end;


ziolko.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now