网址解析函数(一)

近期有个项目需要对网址进行解析，查了下网络上的一些解析单元都不是理想，先将需要的函数写出来，后期根据需要再进行完善！

本单元只有2个功能，一个是解析主域名，一个是当前域名

好处在于可以分辨出域名是否是双后缀的

 

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.