网址解析函数(一)

unit UrlBase;
{
2015-2-25
本单元主要用于解析网址，测试网址
http://www.cnblogs.com/sishen/p/4297303.html
}

interface

Uses System.SysUtils;

Const
  //记录后缀域名是2位的
  DomainClass : array[1..40] of string= (‘com.cn‘,‘net.cn‘,‘org.cn‘,‘gov.cn‘,
                                        ‘mo.cn‘,‘ac.cn‘,‘bj.cn‘,‘sh.cn‘,
                                        ‘tj.cn‘,‘cq.cn‘,‘he.cn‘,‘sx.cn‘,
                                        ‘nm.cn‘,‘ln.cn‘,‘jl.cn‘,‘hl.cn‘,
                                        ‘js.cn‘,‘zj.cn‘,‘ah.cn‘,‘fj.cn‘,
                                        ‘jx.cn‘,‘sd.cn‘,‘ha.cn‘,‘hb.cn‘,
                                        ‘hn.cn‘,‘gd.cn‘,‘gx.cn‘,‘hi.cn‘,
                                        ‘sc.cn‘,‘gz.cn‘,‘yn.cn‘,‘gs.cn‘,
                                        ‘qh.cn‘,‘nx.cn‘,‘xj.cn‘,‘tw.cn‘,
                                        ‘hk.cn‘,‘com.tw‘,‘com.hk‘,‘cn.com‘);
//获取主域名函数:GetMainDoMain
//比如:http://www.cnblogs.com/sishen/p/4297303.html
//获取结果: cnblogs.com
function GetMainDoMain(Url:String):String;

//获取当前域名函数:GetCurrentDoMain
//比如:http://www.cnblogs.com/sishen/p/4297303.html
//获取结果: www.cnblogs.com
function GetCurrentDoMain(Url:String):String;


implementation

//判断数组是否存在指定字符
function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := Low(AValues) to High(AValues) do
  if AnsiSameText(AText, AValues[I]) then begin
    Result := I;
    Break;
  end;
end;

//查询字符在字符串出现次数
function StrPosCount(subs:string;source:string):integer;
var
  Str : string;
begin
  Result := 0;
  str := source;
  while Pos(Subs,Str)<>0 do begin
    Delete(Str,Pos(Subs,Str),Length(Subs));
    Inc(Result);
  end;
end;

function LeftStr(Const Str: String; Size: Word): String;
begin
  LeftStr := Copy(Str, 1, Size)
end;

function GetMainDoMain(Url:String):String;
Var
  Str:String;
begin
  If Leftstr(LowerCase(Url),7) = ‘http://‘ then Delete(Url,1,7);  //去除http://
  If Pos(‘/‘,Url) <> 0 then Delete(Url,Pos(‘/‘,Url),Length(Url)); //去除主域名以外的字符
  While StrPosCount(‘.‘,Url) <> 1 do begin //循环，直到获取最后2位
    Str:=Copy(Url,1,Pos(‘.‘,Url)-1);
    Delete(Url,1,Pos(‘.‘,Url));
  end;
  if AnsiIndexText(Url,DomainClass) <> -1 then Url:=Format(‘%s%s%s‘,[Str,‘.‘,Url]);
  Result:= Url;
end;

function GetCurrentDoMain(Url:String):String;
begin
  If Leftstr(LowerCase(Url),7) = ‘http://‘ then Delete(Url,1,7);  //去除http://
  If Pos(‘/‘,Url) <> 0 then Delete(Url,Pos(‘/‘,Url),Length(Url)); //去除主域名以外的字符
  Result:= Url;
end;

end.