'========================================================'함수 명:FormatRemoteUrl'작 사용:현재 사이트 의 전체 URL 로 포맷 합 니 다.상대 주 소 를 절대 주소 로 변환 합 니 다. 수: url ----Url 문자열'참조 수: CurrentUrl ----물론 웹 사이트 URL'반환 값:포맷 한 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(Replace(Replace(Replace(Replace(CurrentUrl, "'", vbNullString), """", vbNullString), vbNewLine, vbNullString), "\", "/"), "|", vbNullString)) URL = Trim(Replace(Replace(Replace(Replace(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, InStrRev(CurrentUrl, "/")) FormatRemoteUrl = strUrl & Replace(URL, "./", vbNullString) Exit Function End Function
