用asp实现网址和邮件地址的转换函数

  网址和邮件地址的转换函数

  <%

  function URLconvert(str)

  convertstr=str

  urlLocation=instr(convertstr,"http://")

  if (urlLocation=0) and (mailLocation=0) then

  URLconvert=convertstr

  exit function

  end if

  if urlLocation<>0 then

  rightstr=str

  Do while urlLocation<>urlLocationend

  urlLocation=instr(rightstr,"http://")

  urlLocationend=InStrRev(rightstr,"http://")

  finalstr=finalstr&left(rightstr,urlLocation-1)

  midurlstr=mid(rightstr,urlLocation+1,1)

  do while (asc(midurlstr)>=45) and (asc(midurlstr)<=126)

  loopint=loopint+1

  midurlstr=mid(rightstr,urlLocation+loopint,1)

  if midurlstr="" then exit do

  loop

  endURLstr=mid(rightstr,urllocation,loopint)

  URLstr="<a href="&endURLstr&">"&endURLstr&"</a>"

  rightstr=mid(rightstr,urllocation+loopint)

  finalstr=finalstr&URLstr

  loopint=1

  Loop

  end if

  finalstr=finalstr&rightstr

  convertstr1=finalstr

  finalstr=""

  mailLocation=instr(convertstr1,"@")

  if mailLocation<>0 then

  Do while mailLocation<>mailLocationend

  mailLocation=instr(convertstr1,"@")

  mailLocationend=InStrRev(convertstr1,"@")

  mainmidmailstr=mid(convertstr1,mailLocation+1,1)

  midmailstr=mainmidmailstr

  do while (asc(midmailstr)>=45) and (asc(midmailstr)<=126)

  loopint1=loopint1+1

  midmailstr=mid(convertstr1,mailLocation-loopint1,1)

  loop

  firstSTR=mid(convertstr1,mailLocation-loopint1+1,loopint1-1)

  finalstr=finalstr&left(convertstr1,mailLocation-loopint1)

  midmailstr1=mainmidmailstr

  do while (asc(midmailstr1)>=45) and (asc(midmailstr1)<=126)

  loopint2=loopint2+1

  midmailstr1=mid(convertstr1,mailLocation+loopint2,1)

  if midmailstr1="" then exit do

  loop

  secondSTR=mid(convertstr1,mailLocation,loopint2)

  endmailstr=firstSTR&secondSTR

  mailstr="<a href=mailto:"&endmailstr&">"&endmailstr&"</a>"

  finalstr=finalstr&mailstr

  convertstr1=mid(convertstr1,maillocation+loopint2)

  loopint1=1

  loopint2=1

  Loop

  end if

  finalstr=finalstr&convertstr1

  URLconvert=finalstr

  end function

  %>