아래 루틴은 제가 예전에 만들어서 썼도 루틴입니다.
원하시는 부분이 있으시면, 소스를 조금 수정하셔서 쓰시면
될것같습니다.
소스가 간단하니, 수정하시기에도 쉬우실겁니다..

그럼

//-----------------------------------------------------------------------------//
// 긴 Url 을 입력받아 Url인 맞는지 검사한후 순수 도메인만 추출하는 함수
//-----------------------------------------------------------------------------//
function Extrack_BaseUrl(CUrl: String; var ReturnUrl: String):Boolean;
const
  Domain : array[0..11] of string = ('.com','.kr','.net','.org','.info','.biz',
                                     '.dj','.cc','.ac','.to','.cn','.jp');
var
  num, Posnum ,Extractnum : Integer;
  _CheckStr               : String;

begin
  Result := False;
  _CheckStr := Lowercase(CUrl);     {소문자로 변환}

  for num :=0 to 11 do
    begin
      Posnum := Pos(Domain[num],  _CheckStr);
      if Posnum > 0 then
         begin
           Extractnum := Posnum + Length(Domain[num]) -1;  {도메인만 추출}
           ReturnUrl  := Copy(_CheckStr, 1, Extractnum);

           Posnum := Pos('://', ReturnUrl);                {http:// 등.. 삭제}
           if Posnum > 0 then
              Delete(ReturnUrl, 1, Posnum + 2);

           Result := True;
           Break;
         end;
    end;
end;