'友情鏈接
Function FriendLink(LinkTypeStr,TitleNumberStr,PicWidthStr,PicHeightStr,LinkNumberStr,RowNumberStr,RowHeightStr,NewWindowTF)
Dim FriendLinkSql,RsFriendLinkObj,i
If TitleNumberStr <> "" then
TitleNumberStr = Cint(TitleNumberStr)
Else
TitleNumberStr = 10
End If
IF NewWindowTF = "1" Then
NewWindowTF = "target=""_blank"""
Else
NewWindowTF = ""
End IF
Select Case RefreshType
Case "Index"
FriendLinkSql = "Select Top " & LinkNumberStr & " * from FS_FriendLink where Address like '%1%' and Type=" & LinkTypeStr
Case "Class"
FriendLinkSql = "Select Top " & LinkNumberStr & " * from FS_FriendLink where Address like '%2%' and Type=" & LinkTypeStr
Case "News"
FriendLinkSql = "Select Top " & LinkNumberStr & " * from FS_FriendLink where Address like '%3%' and Type=" & LinkTypeStr
Case "Special"
FriendLinkSql = "Select Top " & LinkNumberStr & " * from FS_FriendLink where Address like '%4%' and Type=" & LinkTypeStr
Case Else
FriendLinkSql = ""
End Select
if FriendLinkSql <> "" then
Dim TTTemp,Temp_Str
Set RsFriendLinkObj = Conn.Execute(FriendLinkSql)
if Not RsFriendLinkObj.Eof then
if RowHeightStr <> "" then RowHeightStr = " Height=""" & RowHeightStr & """"
FriendLink = "<table cellpadding=""2"" bgColor=""#cccccc"" cellspacing=""1"" border=""0"" width=""100%"">"
do while Not RsFriendLinkObj.Eof
FriendLink = FriendLink & "<tr bgColor=""#f5f5f5"">"
for i = 1 to RowNumberStr
if LinkTypeStr = "0" then
FriendLink = FriendLink & "<td " & RowHeightStr & " align=""center""><a href=""" & RsFriendLinkObj("Url") & """ "& NewWindowTF &">" & GotTopic(RsFriendLinkObj("Name"),TitleNumberStr) & "</a></TD>" '<TD>從上面移下來用于文字友情鏈接成為表格，當然可以設表格為其他顏色
else
TTTemp = RsFriendLinkObj("Content")
If Instr(1,LCase(TTTemp),"0/'>http://",1)<>0 then
Temp_Str = TTTemp
Else
Temp_Str = AvailableDoMain & TTTemp
End If
FriendLink = FriendLink & "<a href=""" & RsFriendLinkObj("Url") & """ "& NewWindowTF &"><img border=""0"" width=""" & PicWidthStr & """ Height=""" & PicHeightStr & """ src=""" &Temp_Str & """></a>&nbsp;" '加空格用于圖片友情連接中的距離 同理可加表格
end if
RsFriendLinkObj.MoveNext
if RsFriendLinkObj.Eof then Exit For
Next
FriendLink = FriendLink & "</tr>"
Loop
FriendLink = FriendLink & "</table>"
else
FriendLink = ""
end if
Set RsFriendLinkObj = Nothing
else
FriendLink = ""
end if
End Function