📄 function.asp

📁 asp源码图片ASP整站
💻 ASP
📖 第 1 页 / 共 3 页
字号:
		end if
		if DownloadRecordObj("ShowReviewTF") = 1 and  DownloadRecordObj("ReviewTF") = 1 Then
			TempletContent = Replace(TempletContent,"{DownLoad_ReviewContent}","<script src=" & GetConfig(0) & "/" & "ReviewContent.asp?DownloadID="& DownloadRecordObj("downloadid") &"></script>")
		else
			TempletContent = Replace(TempletContent,"{DownLoad_ReviewContent}","")
		end if
		if DownloadRecordObj("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&DownloadID=" & DownloadRecordObj("downloadID") & """><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) & "/Users/Reg.asp""><font color=""#FF0000"">注册</font></a>·<a href=""" & GetConfig(0) & "/Users/UserForGet.asp"">忘记密码？</a></td></tr>" 
			ReviewStr = ReviewStr & "<td>  <input name=""DownloadID"" type=""hidden"" id=""DownloadID"" value=""" & DownloadRecordObj("downloadID") & """>"
			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?DownloadID=" & DownloadRecordObj("downloadID") & """><font color=red><b>查看评论</b></font></a></td></tr></form></table>"
		else
			ReviewStr = ""
		end if
		TempletContent = Replace(TempletContent,"{DownLoad_Review}",ReviewStr)
		if Not IsNull(DownLoadRecordObj("EMail")) then
			TempletContent = Replace(TempletContent,"{DownLoad_EMail}",DownLoadRecordObj("EMail"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_EMail}","")
		end if
		if Not IsNull(DownLoadRecordObj("ProviderUrl")) then
			TempletContent = Replace(TempletContent,"{DownLoad_ProviderUrl}",DownLoadRecordObj("ProviderUrl"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_ProviderUrl}","")
		end if
		if Not IsNull(DownLoadRecordObj("Provider")) then
			TempletContent = Replace(TempletContent,"{DownLoad_Provider}",DownLoadRecordObj("Provider"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Provider}","")
		end if
		if Not IsNull(DownLoadRecordObj("PassWord")) then
			TempletContent = Replace(TempletContent,"{DownLoad_PassWord}",DownLoadRecordObj("PassWord"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_PassWord}","")
		end if
		if Not IsNull(DownLoadRecordObj("AddTime")) then
			TempletContent = Replace(TempletContent,"{DownLoad_AddTime}",DownLoadRecordObj("AddTime"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_AddTime}","")
		end if
		if Not IsNull(DownLoadRecordObj("EditTime")) then
			TempletContent = Replace(TempletContent,"{DownLoad_EditTime}",DownLoadRecordObj("EditTime"))
		else
			TempletContent = Replace(TempletContent,"{DownLoad_EditTime}","")
		end if
		TempletContent = Replace(TempletContent,"{DownLoad_Property}",DownLoadRecordObj("Property"))
		TempStr = DownLoadRecordObj("Description")
		if Not IsNull(TempStr) then
			TempletContent = Replace(TempletContent,"{DownLoad_Description}",TempStr)
		else
			TempletContent = Replace(TempletContent,"{DownLoad_Description}","")
		end if
		'=======================================
		'补足下载图片的显示地址，没有时不显示
		if instr(1,TempletContent,"{DownLoad_Pic}")>0 then 
			if Not IsNull(DownLoadRecordObj("Pic")) then
				TempletContent = Replace(TempletContent,"{DownLoad_Pic}",GetConfig(0) & DownLoadRecordObj("Pic"))
			else
				dim PicEnd,PicBegin
				PicEnd=instr(1,TempletContent,"{DownLoad_Pic}")+14
				PicBegin=InstrRev(TempletContent,"<img",PicEnd)
				TempletContent = Replace(TempletContent,mid(TempletContent,PicBegin,PicEnd-PicBegin+2),"")
			end if
		end if
		'=======================================
	else
		TempletContent = ""
	end if
	GetDownLoadContent = TempletContent
End Function

Function GetOneNewsLinkURL(NewsID)
	Dim DoMain,TempParentID,RsParentObj,RsDoMainObj,ReturnValue
	Dim CheckRootClassIndex,CheckRootClassNumber,TempClassSaveFilePath,RootSaveFilePath,RootTF,NewsClassSaveFilePath
	RootTF = False
	Dim NewsSql,RsNewsObj
	CheckRootClassNumber = 30
	ReturnValue = ""
	NewsSql = "Select *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.AuditTF=1 and FS_News.NewsID='" & NewsID & "'"
	Set RsNewsObj = Conn.Execute(NewsSql)
	if RsNewsObj.Eof then
		Set RsNewsObj = Nothing
		GetOneNewsLinkURL = ""
		Exit Function
	else
		if RsNewsObj("HeadNewsTF") = 1 then
			ReturnValue = RsNewsObj("HeadNewsPath")
		else
			if RsNewsObj("ParentID") <> "0" then
				Set RsParentObj = Conn.Execute("Select SaveFilePath,ParentID,Domain from FS_NewsClass where ClassID='" & RsNewsObj("ParentID") & "'")
				if Not RsParentObj.Eof then
					CheckRootClassIndex = 1
					TempParentID = RsParentObj("ParentID")
					do while Not (TempParentID = "0")
						CheckRootClassIndex = CheckRootClassIndex + 1
						RsParentObj.Close
						Set RsParentObj = Nothing
						Set RsParentObj = Conn.Execute("Select SaveFilePath,ParentID,Domain from FS_NewsClass where ClassID='" & TempParentID & "'")
						if RsParentObj.Eof then
							Set RsParentObj = Nothing
							Set RsNewsObj = Nothing
							GetOneNewsLinkURL = ""
							Exit Function
						end if
						TempParentID = RsParentObj("ParentID")
						if CheckRootClassIndex > CheckRootClassNumber then TempParentID = "0" '防止死循环
					Loop
					DoMain = RsParentObj("DoMain")
					RootSaveFilePath = RsParentObj("SaveFilePath")
					Set RsParentObj = Nothing
				else
					Set RsParentObj = Nothing
					Set RsNewsObj = Nothing
					GetOneNewsLinkURL = ""
					Exit Function
				end if
			else
				DoMain = RsNewsObj("DoMain")
				RootTF = True
				RootSaveFilePath =RsNewsObj("SaveFilePath")
			end if
			'/////////////////////////////////////////////l
			dim NewsDatePath
			if Application(LoginCacheNameStr)(21)="1" then NewsDatePath=RsNewsObj("Path") else NewsDatePath=""
			if (Not IsNull(DoMain)) And (DoMain <> "") then
				If Instr(lCase(DoMain),"http://") = 0 Then
					DoMain = "http://"&DoMain
				End if
				if RootTF = True then
					ReturnValue = DoMain & "/" & RsNewsObj("ClassEName") & NewsDatePath & "/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
				else
					NewsClassSaveFilePath = RsNewsObj("SaveFilePath")
					NewsClassSaveFilePath = Replace(NewsClassSaveFilePath,RootSaveFilePath,"")
					ReturnValue = DoMain & NewsClassSaveFilePath & "/" & RsNewsObj("ClassEName") & NewsDatePath & "/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
				end if
			else
				if RsNewsObj("SaveFilePath") = "/" then
					TempClassSaveFilePath = RsNewsObj("SaveFilePath")
				else
					TempClassSaveFilePath = RsNewsObj("SaveFilePath") & "/"
				end if
				ReturnValue = Application(LoginCacheNameStr)(0) & TempClassSaveFilePath & RsNewsObj("ClassEName") & NewsDatePath & "/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
			end if
			'/////////////////////////////////////////////
		end if
	end if
	Set RsNewsObj = Nothing
	GetOneNewsLinkURL = ReturnValue
End Function

Function GetOneDownLoadLinkURL(DownLoadID)
	Dim DoMain,TempParentID,RsParentObj,ReturnValue
	Dim DownLoadSql,RsDownLoadObj
	Dim CheckRootClassIndex,CheckRootClassNumber,TempClassSaveFilePath,RootTF,RootSaveFilePath,NewsClassSaveFilePath
	RootTF = False
	CheckRootClassNumber = 30
	ReturnValue = ""
	DownLoadSql = "Select *,FS_NewsClass.SaveFilePath,FS_NewsClass.FileExtName as ClassFileExtName,FS_Download.FileName,FS_DownLoad.FileExtName from FS_DownLoad,FS_NewsClass where FS_DownLoad.ClassID=FS_NewsClass.ClassID and FS_DownLoad.AuditTF=1 and FS_DownLoad.DownLoadID='" & DownLoadID & "'"
	Set RsDownLoadObj = Conn.Execute(DownLoadSql)
	if RsDownLoadObj.Eof then
		Set RsDownLoadObj = Nothing
		GetOneDownLoadLinkURL = ""
		Exit Function
	else
		if RsDownLoadObj("ParentID") <> "0" then
			Set RsParentObj = Conn.Execute("Select SaveFilePath,ParentID,Domain from FS_NewsClass where ClassID='" & RsDownLoadObj("ParentID") & "'")
			if Not RsParentObj.Eof then
				CheckRootClassIndex = 1
				TempParentID = RsParentObj("ParentID")
				do while Not (TempParentID = "0")
					CheckRootClassIndex = CheckRootClassIndex + 1
					RsParentObj.Close
					Set RsParentObj = Nothing
					Set RsParentObj = Conn.Execute("Select SaveFilePath,ParentID,Domain from FS_NewsClass where ClassID='" & TempParentID & "'")
					if RsParentObj.Eof then
						Set RsParentObj = Nothing
						Set RsDownLoadObj = Nothing
						GetOneDownLoadLinkURL = ""
						Exit Function
					end if
					TempParentID = RsParentObj("ParentID")
					if CheckRootClassIndex > CheckRootClassNumber then TempParentID = "0" '防止死循环
				Loop
				DoMain = RsParentObj("DoMain")
				RootSaveFilePath=RsParentObj("SaveFilePath")
				Set RsParentObj = Nothing
			else
				Set RsParentObj = Nothing
				Set RsDownLoadObj = Nothing
				GetOneDownLoadLinkURL = ""
				Exit Function
			end if
		else
			RootTF=True
			DoMain = RsDownLoadObj("DoMain")	
		end if
		if (Not IsNull(DoMain)) And (DoMain <> "") then
			If Instr(lCase(DoMain),"http://") = 0 Then
				DoMain = "http://"&DoMain
			End if
			if RootTF=true then 
				ReturnValue = DoMain & "/" & RsDownLoadObj("ClassEName") & "/" & RsDownLoadObj("FileName") & "." & RsDownLoadObj("FileExtName")
			else
					NewsClassSaveFilePath = RsDownLoadObj("SaveFilePath")
					NewsClassSaveFilePath = Replace(lcase(NewsClassSaveFilePath),lcase(RootSaveFilePath),"")
					ReturnValue = DoMain & NewsClassSaveFilePath & "/" & RsDownLoadObj("ClassEName") & "/" & RsDownLoadObj("FileName") & "." & RsDownLoadObj("FileExtName")
			end if
		else
			if RsDownLoadObj("SaveFilePath") = "/" then
				TempClassSaveFilePath = RsDownLoadObj("SaveFilePath")
			else
				TempClassSaveFilePath = RsDownLoadObj("SaveFilePath") & "/"
			end if
			ReturnValue = GetConfig(0) & TempClassSaveFilePath & RsDownLoadObj("ClassEName") & "/" & RsDownLoadObj("FileName") & "." & RsDownLoadObj("FileExtName")
		end if
	end if
	Set RsDownLoadObj = Nothing
	GetOneDownLoadLinkURL = ReturnValue
End Function

Function GetOneClassLinkURLByID(ClassID)
	Dim RsClassObj
	Set RsClassObj = Conn.Execute("Select SaveFilePath,ClassEName,FileExtName from FS_NewsClass where ClassID='" & ClassID & "'")
	GetOneClassLinkURLByID = GetOneClassLinkURL(RsClassObj("ClassEName"),RsClassObj("SaveFilePath"),RsClassObj("FileExtName"))
End Function

Function GetOneClassLinkURL(ClassEName,SaveFilePath,ClassFileExtName)
	Dim DoMain,TempParentID,RsParentObj,ReturnValue
	Dim CheckRootClassIndex,CheckRootClassNumber,TempClassSaveFilePath,RootTF,RootSaveFilePath
	RootTF = False
	CheckRootClassNumber = 30
	ReturnValue = ""
	Set RsParentObj = Conn.Execute("Select ClassLink,IsOutClass,SaveFilePath,ParentID,Domain from FS_NewsClass where ClassEName='" & ClassEName & "'")
	if Not RsParentObj.Eof then
		If RsParentObj("IsOutClass")="1" then 
			If left(RsParentObj("ClassLink"),7)="http://" Then
				GetOneClassLinkURL=RsParentObj("ClassLink")
			Else
				GetOneClassLinkURL="http://"&RsParentObj("ClassLink")
			End If
			Exit Function
		End If
		if RsParentObj("ParentID") = "0" then
			DoMain = RsParentObj("DoMain")
			RootTF = True 
		else
			CheckRootClassIndex = 1
			TempParentID = RsParentObj("ParentID")
			do while Not (RsParentObj("ParentID") = "0")
				CheckRootClassIndex = CheckRootClassIndex + 1
				RsParentObj.Close
				Set RsParentObj = Nothing
				Set RsParentObj = Conn.Execute("Select SaveFilePath,ParentID,Domain from FS_NewsClass where ClassID='" & TempParentID & "'")
				if RsParentObj.Eof then
					Set RsParentObj = Nothing
					GetOneClassLinkURL = ""
					Exit Function
				end if
				TempParentID = RsParentObj("ParentID")
				if CheckRootClassIndex > CheckRootClassNumber then TempParentID = "0" '防止死循环 
			Loop
			DoMain = RsParentObj("DoMain")
			RootSaveFilePath = RsParentObj("SaveFilePath")
		end if 
	else
		Set RsParentObj = Nothing
		GetOneClassLinkURL = ""
		Exit Function
	end if
	Set RsParentObj = Nothing
	if (Not IsNull(DoMain)) And (DoMain <> "") then
		if RootTF = True then
			ReturnValue = "http://" & DoMain & "/" & ClassEName & "/index." & ClassFileExtName
		else
			SaveFilePath = Replace(SaveFilePath,RootSaveFilePath,"")
			ReturnValue = "http://" & DoMain & SaveFilePath & "/" & ClassEName & "/index." & ClassFileExtName
		end if
	else
		if SaveFilePath = "/" then
			TempClassSaveFilePath = SaveFilePath
		else
			TempClassSaveFilePath = SaveFilePath & "/"
		end if
		ReturnValue = GetConfig(0) & TempClassSaveFilePath & ClassEName & "/index." & ClassFileExtName
	end if
	GetOneClassLinkURL = ReturnValue
End Function

Function GetRowSpanNumber(DateRuleStr,DateRightStr,RowNumberStr)
	if DateRuleStr <> "" then
		if DateRightStr = "Left" then
			GetRowSpanNumber = "colspan=""" & RowNumberStr & """"
💿 文件大小 7479 K
👤 上传用户 __catcher
📂 所属分类其他
🏷️ 相关标签

#asp #ASP #源码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -