function.asp

asp源码 图片ASP整站

<%
'通过专题英文名称获得专题ID
Function Get_SpecialID_From_EName(f_EName)
	Dim f_Special_RS
	Set f_Special_RS = Conn.Execute("Select SpecialID from FS_Special where EName='" & f_EName & "'")
	if Not f_Special_RS.Eof then
		Get_SpecialID_From_EName = f_Special_RS("SpecialID")
	else
		Get_SpecialID_From_EName = ""
	end if
	Set f_Special_RS = Nothing
End Function
'通过栏目英文名称获得栏目ID
Function Get_ClassID_From_ClassEName(ClassEName)
	Dim f_i,f_ClassCache
	Get_ClassID_From_ClassEName = ""
	Set f_ClassCache =New Cls_FsCache
	f_ClassCache.Name="ClassCache"
	f_ClassCache.ArrayIndex=2
	f_ClassCache.KnowValue=ClassEName
	Get_ClassID_From_ClassEName = f_ClassCache.FindNeedRecord("0")
	Set f_ClassCache = Nothing
End Function
'得到所有子栏目ID
Function Get_All_Child_Class_Str(ClassID)
	Dim f_ClassCache
	Set f_ClassCache =New Cls_FsCache
	f_ClassCache.Name="ClassCache"
	Get_All_Child_Class_Str=f_ClassCache.GetAllChildClassIDStr(ClassID)
	Set f_ClassCache = Nothing
	If Left(Get_All_Child_Class_Str,1)="," Then
		Get_All_Child_Class_Str=Mid(Get_All_Child_Class_Str,2)
	End If
	Get_All_Child_Class_Str=Replace(Get_All_Child_Class_Str,",","','")
End Function
'得到一个栏目的所有子栏目ID（包括自己)
Function Get_All_Child_ClassID(f_Class_ID,f_Include_Child_Class)
	if f_Include_Child_Class = "1" then
		Get_All_Child_ClassID = "'" & f_Class_ID & "','" &Get_All_Child_Class_Str(f_Class_ID) & "'"
	else
		Get_All_Child_ClassID = "'" & f_Class_ID & "'"
	end if
End Function
'3.2新增加函数，不要删除
Function RefreshInfo(f_Type,Refresh_ID,Parent_ID,Templet,SaveFileName,SaveFile_ExtName,SavePath)
	Dim f_Return_Val,RefreshObj
	Set RefreshObj = New Class_Refresh
	RefreshObj.Refresh_Type 		= f_Type
	RefreshObj.Refresh_ID 			= Refresh_ID
	RefreshObj.Parent_ID 			= Parent_ID
	RefreshObj.Templet				= Templet
	RefreshObj.SaveFileName			= SaveFileName
	RefreshObj.SaveFile_ExtName		= SaveFile_ExtName
	RefreshObj.SavePath				= SavePath
	f_Return_Val 	= RefreshObj.Refresh
	Set RefreshObj = Nothing
	RefreshInfo = f_Return_Val
End Function

Function ReplaceInnerLink(NewsContent)
	Dim RoutineSql,RsRoutineObj
	RoutineSql = "Select * from FS_Routine where Type=5"
	Set RsRoutineObj = Conn.Execute(RoutineSql)
	Dim StrReplace,Inti,DLocation,XLocation
	do while Not RsRoutineObj.Eof
		Inti=1
		StrReplace=RsRoutineObj("Name")
		If instr(1,NewsContent,StrReplace) then
			do while instr(Inti,NewsContent,StrReplace)<>0
				Inti=instr(Inti,NewsContent,StrReplace)
				'response.write Inti & "|"
				If Inti<>0 then
					DLocation=instr(Inti,NewsContent,">")'如果内容在><之间则替换
					XLocation=instr(Inti,NewsContent,"<")
					If DLocation>XLocation Then
						If instr(1,"[Page]",StrReplace)=0 then'避免替换[Page]里面的内容后，造成分页混乱
							NewsContent=left(NewsContent,Inti-1) & "<a href=" & RsRoutineObj("Url") & " target=_blank>" & StrReplace & "</a>" & mid(NewsContent,Inti+len(StrReplace))
							Inti=Inti+len("<a href=" & RsRoutineObj("Url") & " target=_blank>" & StrReplace & "</a>")
						Else
							Inti=Inti+len(StrReplace)
						End If
					Else
						Inti=Inti+len(StrReplace)
					end If
				End If
			
			loop
		End If
		RsRoutineObj.MoveNext
	Loop
	Set RsRoutineObj = Nothing
	ReplaceInnerLink = NewsContent
End Function
'========================================================
'辅助字段替换
Function CMS_ReplaceField(TempletStr,RefreshType,infoID)
 If RefreshType <> "" And infoID <> "" Then 
    Dim RsField,FieldSql,ValueName,ValueStr,RsFieldCount,TempStrs
    CMS_ReplaceField = ""
    FieldSql = "Select * from FS_AuxiTable where TableEName='"&RefreshType&"' and OwnerID='"&infoID&"'"
    Set RsField = Server.CreateObject(G_FS_RS)
    RsField.open FieldSql,Conn,1,1
    Do While Not RsField.Eof
     If Not RsField.Eof then
       ValueName = "{"&Trim(RsField("ColumnName"))&"}" '得到标签名
       ValueStr = Trim(RsField("ColumnValue")) '得到标签内容
     Else
       ValueName = "" '得到空内容
       ValueStr = "" '得到空内容
     End If
     TempletStr = Replace(TempletStr,ValueName,ValueStr) '替换标签内容
     RsField.MoveNext
  Loop
  rsfield.close
         set rsfield=nothing 
    CMS_ReplaceField = TempletStr
  Else
     CMS_ReplaceField = TempletStr
  End If
End Function
'=========================================================
Function GetNewsContent(TempletContent,NewsRecordSet,NewsContent)
	Dim TxtSourceRs,TxtSourceLink,TxtSourceSql
	TempletContent = Replace(TempletContent,"{News_Title}",NewsRecordSet("Title"))
	'内容字体大小标签 start
TempletContent = Replace(TempletContent,"{News_FontSize}","【<a href=""javascript:fontzoom(16)"">大</a>&nbsp;<a href=""javascript:fontzoom(14)"">中</a>&nbsp;<a href=""javascript:fontzoom(12)"">小</a>】")
'内容字体大小标签 end
	if Not IsNull(NewsRecordSet("SubTitle")) then
		TempletContent = Replace(TempletContent,"{News_SubTitle}",NewsRecordSet("SubTitle"))
	else
		TempletContent = Replace(TempletContent,"{News_SubTitle}","")
	end if
	if Not IsNull(NewsRecordSet("Author")) then
		TempletContent = Replace(TempletContent,"{News_Author}",NewsRecordSet("Author"))
	else
		TempletContent = Replace(TempletContent,"{News_Author}","")
	end if
	TempletContent = Replace(TempletContent,"{News_Content}",NewsContent)
	
	if Not IsNull(NewsRecordSet("TxtSource")) then
		TxtSourceSql = "Select [url] From FS_Routine Where type=2 and [Name]='" & NewsRecordSet("TxtSource") & "'"
		Set TxtSourceRs = Conn.Execute(TxtSourceSql)
		If Not TxtSourceRs.Eof Then
			TxtSourceLink = "<a Href=""" & TxtSourceRs("url") & """>" & NewsRecordSet("TxtSource") & "</a>"
		Else
			TxtSourceLink = NewsRecordSet("TxtSource")
		End If
		TxtSourceRs.Close
		Set TxtSourceRs = Nothing
		TempletContent = Replace(TempletContent,"{News_TxtSource}",TxtSourceLink)
	else
		TempletContent = Replace(TempletContent,"{News_TxtSource}","")
	end if
	if Not IsNull(NewsRecordSet("KeyWords")) then
        TempletContent = Replace(TempletContent,"{News_KeyWords}",NewsRecordSet("KeyWords"))
    else
        TempletContent = Replace(TempletContent,"{News_KeyWords}","")
    end if
	if Not IsNull(NewsRecordSet("Editer")) then
		TempletContent = Replace(TempletContent,"{News_TxtEditer}",NewsRecordSet("Editer"))
	else
		TempletContent = Replace(TempletContent,"{News_TxtEditer}","")
	end if
	if Not IsNull(NewsRecordSet("AddDate")) then 
		TempletContent = Replace(TempletContent,"{News_AddDate}",NewsRecordSet("AddDate"))
	else
		TempletContent = Replace(TempletContent,"{News_AddDate}","")
	end if
	TempletContent = Replace(TempletContent,"{News_SendFriend}","<a href=" & GetConfig(0) & "/" & "Sendmail.asp?NewsID=" & NewsRecordSet("NewsID") & "  target=""_blank"">发送给好友</a>")
	TempletContent = Replace(TempletContent,"{News_ClickNum}","<script src=" & GetConfig(0) & "/" & "Click.asp?NewsID="& Fun_Refresh_ID &"></script>")
	TempletContent = Replace(TempletContent,"{News_ReviewContent}","<script language=Javascript src=" & GetConfig(0) & "/" & "ReviewContent.asp?NewsID="& NewsRecordSet("NewsID") &"></script>")
	'Added By Koolls at 2005.10.11
	TempletContent = Replace(TempletContent,"{News_Favorite}","<a target=""_blank"" Href=" & GetConfig(0) & "/" & UserDir &"/AddFavorite.asp?NewsID="& NewsRecordSet("ID") &">添加到收藏夹</a>")
	Dim ReviewStr
	if NewsRecordSet("ReviewTF") = 1 then
		ReviewStr = "<table width=""100%"" border=""0"" cellpadding=""3"" cellspacing=""1""><form name=""form1"" method=""post"" action=""" & GetConfig(0) & "/" & "NewsReview.asp?action=add&NewsID=" & NewsRecordSet("NewsID") & """><tr>"
		ReviewStr = ReviewStr & "<td width=""21%""><div align=right>会员名称：</div></td>"
		ReviewStr = ReviewStr & "<td width=""79%""> <input name=""MemName"" type=""text"" id=""MemName"" size=""10"" value="""">密码：<input name=""Password"" type=""password"" size=""8"" id=""Password""><input name=""NoName"" type=""checkbox"" id=""NoName"" value=""1"">匿名 <font color=""#FF0000"">·</font><a href=""" & GetConfig(0) & "/"& UserDir &"/sRegister.asp""><font color=""#FF0000"">注册</font></a>·<a href=""" & GetConfig(0) & "/"& UserDir &"/User_GetPassword.asp"">忘记密码？</a></td></tr>" 
		ReviewStr = ReviewStr & "<td>  <input name=""NewsID"" type=""hidden"" id=""NewsID"" value=""" & NewsRecordSet("NewsID") & """>"
		ReviewStr = ReviewStr & "<input name=""action"" type=""hidden"" id=""action"" value=""add""></tr>"
		ReviewStr = ReviewStr & "<tr><td> <div align=""right"">评论内容：<br>(最多300个字符) </div></td><td> <textarea name=""RevContent"" cols=""40"" rows=""5"" id=""RevContent""></textarea></td></tr>"
		ReviewStr = ReviewStr & "<tr><td></td><td> <input type=""submit"" name=""Submit"" value=""发表"">&nbsp;&nbsp;<a href=""" & GetConfig(0) & "/" & "NewsReview.asp?NewsID=" & NewsRecordSet("NewsID") & """><font color=red><b>查看评论</b></font></a></td></tr></form></table>"
	else
		ReviewStr = ""
	end if
	TempletContent = Replace(TempletContent,"{News_Review}",ReviewStr)
	TempletContent = CMS_ReplaceField(TempletContent,"FS_News",NewsRecordSet("NewsID"))'替换辅助字段
	GetNewsContent = TempletContent
End Function

Function GetDownLoadContent(TempletContent,DownLoadRecordObj)
	Dim TempStr,AddressSql,RsAddressObj,DownLoadID,AddressStr,ReviewStr
	if Not DownLoadRecordObj.Eof then
		DownLoadID = DownLoadRecordObj("DownLoadID")
		if Not IsNull(DownLoadID) then
			AddressSql = "Select * from FS_DownLoadAddress where DownLoadID='" & DownLoadID & "'"
			Set RsAddressObj = Conn.Execute(AddressSql)
			if Not RsAddressObj.Eof then
				AddressStr = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & Chr(13)
				do while Not RsAddressObj.Eof
					AddressStr = AddressStr & "<tr>" & Chr(13)
					AddressStr = AddressStr & "<td>" & Chr(13)
					AddressStr = AddressStr & "<a href=""" & GetConfig(0) & "/Down.asp?ID=" & RsAddressObj("ID") & "&DownID=" & RsAddressObj("DownLoadID") & """>点击下载--" & RsAddressObj("AddressName") & "</a>"
					AddressStr = AddressStr & "</td>" & Chr(13)
					AddressStr = AddressStr & "</tr>" & Chr(13)
					RsAddressObj.MoveNext
				Loop
				AddressStr = AddressStr & "</table>" & Chr(13)
			else
				AddressStr = ""
			end if
			Set RsAddressObj = Nothing
			TempletContent = Replace(TempletContent,"{DownLoad_Address}",AddressStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Address}","")
		end if
		if Not IsNull(DownLoadRecordObj("Name")) then
			TempletContent = Replace(TempletContent,"{DownLoad_Name}",DownLoadRecordObj("Name"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Name}","")
		end if
		if Not IsNull(DownLoadRecordObj("Version")) then
			TempletContent = Replace(TempletContent,"{DownLoad_Version}",DownLoadRecordObj("Version"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Version}","")
		end if
		TempletContent = Replace(TempletContent,"{DownLoad_ClickNum}","<script src=" & GetConfig(0) & "/" & "DownClick.asp?DownLoadID="& DownLoadRecordObj("DownLoadID") &"></script>")
		if Not IsNull(DownLoadRecordObj("Types")) then
			Select Case DownLoadRecordObj("Types")
				Case 1 TempStr = "图片"
				Case 2 TempStr = "文件"
				Case 3 TempStr = "程序"
				Case 4 TempStr = "Flash"
				Case 5 TempStr = "音乐"
				Case 6 TempStr = "影视"
				Case 7 TempStr = "其他"
				Case Else TempStr = ""
			End Select
			TempletContent = Replace(TempletContent,"{DownLoad_Types}",TempStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Types}","")
		end if
		if Not IsNull(DownLoadRecordObj("Language")) then
			Select Case DownLoadRecordObj("Language")
				Case 1 TempStr = "简体中文"
				Case 2 TempStr = "繁体中文"
				Case 3 TempStr = "英文"
				Case 4 TempStr = "法文"
				Case 5 TempStr = "日文"
				Case 6 TempStr = "德文"
				Case Else TempStr = ""
			End Select
			TempletContent = Replace(TempletContent,"{DownLoad_Language}",TempStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Language}","")
		end if
		if Not IsNull(DownLoadRecordObj("Accredit")) then
			Select Case DownLoadRecordObj("Accredit")
				Case 1 TempStr = "免费"
				Case 2 TempStr = "共享"
				Case 3 TempStr = "试用"
				Case 4 TempStr = "演示"
				Case 5 TempStr = "注册"
				Case 6 TempStr = "破解"
				Case 7 TempStr = "零售"
				Case 8 TempStr = "其他"
				Case Else TempStr = ""
			End Select
			TempletContent = Replace(TempletContent,"{DownLoad_Accredit}",TempStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Accredit}","")
		end if
		if Not IsNull(DownLoadRecordObj("FileSize")) then
			TempletContent = Replace(TempletContent,"{DownLoad_FileSize}",DownLoadRecordObj("FileSize"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_FileSize}","")
		end if
		if Not IsNull(DownLoadRecordObj("Appraise")) then
			Select Case DownLoadRecordObj("Appraise")
				Case 1 TempStr = "★"
				Case 2 TempStr = "★★"
				Case 3 TempStr = "★★★"
				Case 4 TempStr = "★★★★"
				Case 5 TempStr = "★★★★★"
				Case 6 TempStr = "★★★★★★"
				Case Else TempStr = ""
			End Select
			TempletContent = Replace(TempletContent,"{DownLoad_Appraise}",TempStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Appraise}","")
		end if
		if Not IsNull(DownLoadRecordObj("SystemType")) then
			TempletContent = Replace(TempletContent,"{DownLoad_SystemType}",DownLoadRecordObj("SystemType"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_SystemType}","")