'友情链接 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),"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> " '加空格用于图片友情连接中的距离 同理可加表格 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
 |