'================================================ ==========
'Function name: formatremoteurl
'For use: format it to the complete URL of the current website-convert the relative address to an absolute address
'Parameter: URL ---- URL string
'Parameter: currenturl ---- Of course, the website URL
'Return value: formatted URL
'================================================ ==========
Public Function formatremoteurl (byval URL, byval currenturl)
Dim strurl
If Len (URL) <2 or Len (URL)> 255 or Len (currenturl) <2 then
Formatremoteurl = vbnullstring
Exit Function
End if
Currenturl = trim (replace (currenturl, "'", vbnullstring), ", vbnullstring), vbnewline, vbnullstring ),"\", "/"), "|", vbnullstring ))
Url = trim (replace (URL, "'", vbnullstring), ", vbnullstring), vbnewline, vbnullstring ),"\", "/"), "|", vbnullstring ))
If instr (9, currenturl, "/") = 0 then
Strurl = currenturl
Else
Strurl = left (currenturl, instr (9, currenturl, "/")-1)
End if
If strurl = vbnullstring then strurl = currenturl
Select case left (lcase (URL), 6)
Case "http:/", "https:", "ftp: //", "rtsp:/", "MMS ://"
Formatremoteurl = URL
Exit Function
End select
If left (URL, 1) = "/" then
Formatremoteurl = strurl & URL
Exit Function
End if
If left (URL, 3) = "../" then
Dim arrayurl
Dim arraycurrenturl
Dim arraytemp ()
Dim strtemp
Dim I, n
Dim C, L
N = 0
Arraycurrenturl = Split (currenturl ,"/")
Arrayurl = Split (URL ,"../")
C = ubound (arraycurrenturl)
L = ubound (arrayurl) + 1
If C> L + 2 then
For I = 0 to c-l
Redim preserve arraytemp (N)
Arraytemp (n) = arraycurrenturl (I)
N = n + 1
Next
Strtemp = join (arraytemp ,"/")
Else
Strtemp = strurl
End if
Url = Replace (URL, "../", vbnullstring)
Formatremoteurl = strtemp & "/" & URL
Exit Function
End if
Strurl = left (currenturl, limit Rev (currenturl ,"/"))
Formatremoteurl = strurl & replace (URL, "./", vbnullstring)
Exit Function
End Function