InstallDir & CacheChannel(2,0)
End Function
''================================================
''函数名:GetImageUrl
''作 用:获取
图片URL
''================================================
Public Function GetImageUrl(ByVal url, ByVal ChannelDir)
On Error Resume Next
Dim strTempUrl, strImageUrl
If Not IsNull(url) And Trim(url) <> "" And LCase(url) <> "http://" Then
strTempUrl = InstallDir & ChannelDir
If CheckUrl(url) = 1 Then
strImageUrl = Trim(url)
ElseIf CheckUrl(url) = 2 Then
strImageUrl = url
Else
strImageUrl = Replace(url, "../", "")
strImageUrl = Trim(strTempUrl & strImageUrl)
End If
Else
strImageUrl = InstallDir & "images/no_pic.gif"
End If
GetImageUrl = strImageUrl
End Function
''-----------------------------------------------------------------
''================================================
''作 用:读取
图片或者FLASH
''参 数:url ----文件URL
'' height ----高度
'' width ----宽度
''================================================
Function GetFlashAndPic(ByVal url, ByVal height, ByVal width)
On Error Resume Next
Dim sExtName, ExtName, strTemp
Dim strHeight, strWidth
If Not IsNumeric(height) Or height < 1 Then
strHeight = ""
Else
strHeight = " height=" & height
End If
If Not IsNumeric(width) Or width < 1 Then
strWidth = ""
Else
strWidth = " width=" & width
End If
sExtName = Split(url, ".")
ExtName = sExtName(UBound(sExtName))
If LCase(ExtName) = "swf" Then
strTemp = "<embed src=""" & url & """" & strWidth & strHeight & ">"
Else
strTemp = "<img src=""" & url & """" & strWidth & strHeight & " border=0>"
End If
GetFlashAndPic = strTemp
End Function
''================================================
''函数名:ReadFileUrl
''作 用:读取文件URL
''================================================
Public Function ReadFileUrl(url)
On Error Resume Next
ReadFileUrl = ""
If url = "" Then Exit Function
Dim strTemp
If CheckUrl(url) = 1 Then
strTemp = Trim(url)
ElseIf CheckUrl(url) = 2 Then
strTemp = Trim(url)
Else
strTemp = Replace(url, "../", "")
strTemp = Trim(InstallDir & strTemp)
End If
ReadFileUrl = strTemp
End Function
Public Function CheckUrl(ByVal url)
Dim strUrl
If Left(url, 1) = "/" Then
CheckUrl = 1
Exit Function
End If
strUrl = LCase(Left(url, 6))
Select Case Trim(strUrl)
Case "http:/", "https:", "ftp://", "rtsp:/", "mms://"
CheckUrl =