cl_function_article.asp

正版创力4.1SQL商业版!!!ASP版。

	Dim sTContent
	Set ClUbb = New Cls_UbbCode
	ClUbb.OpenHTML = 1
	Select Case Rs("PaginationType")
	Case 0 : sTContent = Rs("Content")   '不分页显示
	Case 1 : sTContent = AutoPagination   '自动分页显示
	Case 2 : sTContent = ManualPagination   '手动分页显示
	Case Else : sTContent = Rs("Content")   '不分页显示
	End Select
	ShowArticleContent = ErrMsg & ClUbb.UbbCode(sTContent)
	Set ClUbb=Nothing
End Function

'采用手动分页方式
Function ManualPagination()
	Dim strContent, ContentLen, arrContent
	strContent = rs("Content")
	ContentLen = len(strContent)
	if InStr(strContent,"[NextPage]")<=0 then
		ManualPagination = strContent : Exit Function
	else
		Dim sTemp
		arrContent = split(strContent,"[NextPage]")
		pages = Ubound(arrContent)+1
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages
		sTemp = "<div class='content'>"
		sTemp = sTemp & arrContent(CurrentPage-1)
		sTemp = sTemp & "</div>"
		ManualPagination = sTemp & ArticleContentPage
	end if
End Function

'采用自动分页方式
Function AutoPagination()
	Dim strContent, sMaxCharPerPage
	Dim ContentLen, lngBound
	Dim BeginPoint, EndPoint
	strContent = rs("Content")
	ContentLen = Len(strContent)
	sMaxCharPerPage = rs("MaxCharPerPage")
	if Not IsNumeric(sMaxCharPerPage) then sMaxCharPerPage = 0
	if ContentLen <=  sMaxCharPerPage Or sMaxCharPerPage < 10 then
		AutoPagination = strContent
		Exit Function
	else
		pages = ContentLen\sMaxCharPerPage
		if sMaxCharPerPage*pages < ContentLen Then pages = pages+1
		lngBound = ContentLen          '最大误差范围
		if CurrentPage < 1 then CurrentPage = 1
		if CurrentPage > pages then CurrentPage = pages
		strContent = Cl.FormatHTML(strContent)
		if CurrentPage = 1 then
			BeginPoint = 1
		else
			BeginPoint = sMaxCharPerPage*(CurrentPage-1)+1
			BeginPoint = GetAutoPaginationChar(strContent,BeginPoint)
		end if
		if CurrentPage = pages then
			EndPoint = ContentLen
		else
			EndPoint = sMaxCharPerPage*CurrentPage
			EndPoint = GetAutoPaginationChar(strContent,EndPoint)
		end If
		if BeginPoint > EndPoint then '确保EndPoint大于BeginPoint。
			if (BeginPoint-EndPoint)>sMaxCharPerPage then
				EndPoint = BeginPoint+sMaxCharPerPage
			else
				EndPoint = EndPoint+sMaxCharPerPage
			end if
		end If
		Dim sTemp
		sTemp = "<div class='content'>"
		sTemp = sTemp & AdjustAutoPaginationContent(Mid(strContent,BeginPoint,EndPoint-BeginPoint))
		sTemp = sTemp & "</div>"
		AutoPagination = sTemp & ArticleContentPage
	end if
End Function

Function ArticleContentPage()
	Dim sTemp, i
	sTemp = "<div class='content_page' style='font-weight: bold;'>"
	if CreateHtmlIng = True then
		if CurrentPage>1 then
			if (CurrentPage-1) > 1 then
			sTemp = sTemp & "<a href='" & sInfoFileName & "_P" & CurrentPage-1 & "."&Cl.Channel.selectSingleNode("@createfileext").text&"'>上一页</a>&nbsp;&nbsp;"
			else
			sTemp = sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel.selectSingleNode("@createfileext").text&"'>上一页</a>&nbsp;&nbsp;"
			end if
		end if
		for i = 1 to pages
			if i = CurrentPage then
				sTemp = sTemp & "<strong><font color='#ff0033'>[" & cstr(i) & "]</font></strong>&nbsp;"
			else
				if i>1 then
				sTemp = sTemp & "<a href='" & sInfoFileName & "_P" & i & "."&Cl.Channel.selectSingleNode("@createfileext").text&"'>[" & i & "]</a>&nbsp;"
				else
				sTemp = sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel.selectSingleNode("@createfileext").text&"'>[" & i & "]</a>&nbsp;"
				end if
			end if
		next
		if CurrentPage<pages then
			sTemp = sTemp & "&nbsp;<a href='" & sInfoFileName & "_P" & CurrentPage+1 & "."&Cl.Channel.selectSingleNode("@createfileext").text&"'>下一页</a>"
		end if
	else
		if CurrentPage>1 then
			sTemp = sTemp & "<a href='" & FileName & "?InfoID=" & InfoID & "&Page=" & CurrentPage-1 & "'>上一页</a>&nbsp;&nbsp;"
		end if
		for i = 1 to pages
			if i = CurrentPage then
				sTemp = sTemp & "<strong><font color='#ff0033'>[" & cstr(i) & "]</font></strong>&nbsp;"
			else
				sTemp = sTemp & "<a href='" & FileName & "?InfoID=" & InfoID & "&Page=" & i & "'>[" & i & "]</a>&nbsp;"
			end if
		next
		if CurrentPage<pages then
			sTemp = sTemp & "&nbsp;<a href='" & FileName & "?InfoID=" & InfoID & "&Page=" & CurrentPage+1 & "'>下一页</a>"
		end if
	end if
	ArticleContentPage = sTemp & "</div>"
End Function

Function AdjustAutoPaginationContent(ByVal sContent)
	Dim ContentTemp
	Dim ArrayStr1,ArrayStr2
	Dim Nums1,Nums2
	Dim n
	ContentTemp = sContent
	Nums1 = InStr(ContentTemp,"<td")
	Nums2 = InStr(ContentTemp,"</td>")
	If Nums1>Nums2 Then
		ContentTemp = "<td>" & ContentTemp
	End if
	If Nums1>0 Then
		ArrayStr1 = Split(ContentTemp,"<td")
		ArrayStr2 = Split(ContentTemp,"</td>")
		Nums1 = UBound(ArrayStr1)
		Nums2 = UBound(ArrayStr2)
		If Nums1 > Nums2 Then
			For n=1 To Nums1-Nums2
				ContentTemp = ContentTemp & "</td>"
			Next
		End if
	End If
	Nums1 = InStr(ContentTemp,"<tr")
	Nums2 = InStr(ContentTemp,"</tr>")
	If Nums1>Nums2 Then
		ContentTemp = "<tr>" & ContentTemp
	End if
	If Nums1>0 Then
		ArrayStr1 = Split(ContentTemp,"<tr")
		ArrayStr2 = Split(ContentTemp,"</tr>")
		Nums1 = UBound(ArrayStr1)
		Nums2 = UBound(ArrayStr2)
		If Nums1 > Nums2 Then
			For n=1 To Nums1-Nums2
				ContentTemp = ContentTemp & "</tr>"
			Next
		End if
	End If
	Nums1 = InStr(ContentTemp,"<table")
	Nums2 = InStr(ContentTemp,"</table>")
	If Nums1>Nums2 Then
		ContentTemp = "<table>" & ContentTemp
	End if
	If Nums1>0 Then
		ArrayStr1 = Split(ContentTemp,"<table")
		ArrayStr2 = Split(ContentTemp,"</table>")
		Nums1 = UBound(ArrayStr1)
		Nums2 = UBound(ArrayStr2)
		If Nums1 > Nums2 Then
			For n=1 To Nums1-Nums2
				ContentTemp = ContentTemp & "</table>"
			Next
		End if
	End If
	Nums1 = InStr(ContentTemp,"<div")
	Nums2 = InStr(ContentTemp,"</div>")
	If Nums1>Nums2 Then
		ContentTemp = "<div>" & ContentTemp
	End if
	If InStr(ContentTemp,"<div")>0 Then
		ArrayStr1 = Split(ContentTemp,"<div")
		ArrayStr2 = Split(ContentTemp,"</div>")
		Nums1 = UBound(ArrayStr1)
		Nums2 = UBound(ArrayStr2)
		If Nums1 > Nums2 Then
			For n=1 To Nums1-Nums2
				ContentTemp = ContentTemp & "</div>"
			Next
		End if
	End If
	AdjustAutoPaginationContent = ContentTemp
End Function

Function GetAutoPaginationChar(ByVal sContent,ByVal BeginChar)
	Dim ContentTemp,LngTemp
	Dim TempBeginChar
	If BeginChar>7 Then
		TempBeginChar = BeginChar - 7
	Else
		TempBeginChar = 1
	End if
	ContentTemp = Mid(sContent,TempBeginChar,BeginChar+8)
	If InStr(ContentTemp,"<table")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<table") - 1
	ElseIf InStr(ContentTemp,"</table>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</table>") + 7
	ElseIf InStr(ContentTemp,"<div")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<div") - 1
	ElseIf InStr(ContentTemp,"</div>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</div>") + 6
	ElseIf InStr(ContentTemp,"<tr")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<tr") - 1
	ElseIf InStr(ContentTemp,"</tr>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</tr>") + 4
	ElseIf InStr(ContentTemp,"<td")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<td") - 1
	ElseIf InStr(ContentTemp,"</td>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</td>") + 4
	ElseIf InStr(ContentTemp,"<ul")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<ul") - 1
	ElseIf InStr(ContentTemp,"</ul>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</ul>") + 4
	ElseIf InStr(ContentTemp,"<li")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<li") - 1
	ElseIf InStr(ContentTemp,"</li>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"</li>") + 4
	ElseIf InStr(ContentTemp,"<img")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<img") - 1
	ElseIf InStr(ContentTemp,"<br>")>0 Then
		LngTemp = TempBeginChar + InStr(ContentTemp,"<br>") - 1
	Else
		LngTemp = BeginChar
	End If
	GetAutoPaginationChar = LngTemp
End Function

Function ChkTrueRead()
	Rem 这里判断权限
	ChkTrueRead = Cl.TrueInfoPurview
	If ChkTrueRead = False Then ErrMsg=Cl.ErrMessage : Exit Function
'============================================================================
	if rs("Receive")=True and SysTemVersion > 0 then
		if Request.Form("Receive")="now" then
			Call DoReceive(InfoID)
		end if
		Dim sUserMsg,sNotReceiveUser
		Dim IsPrivate,IsReceiveUser,IsReceived
		Dim LanguageObj
		Set LanguageObj = Cl.Language.selectSingleNode("//Article/Receive")
		IsPrivate=False:IsReceiveUser=False:IsReceived=False
		ErrMsg=LanguageObj.selectSingleNode("Body").text
		if Rs("ReceiveType")=1 then IsPrivate=True
		if Cl.UserID>0 and Cl.UserGroupID<>5 then
			if InStr(Rs("ReceiveUser"),"|"&Cl.MemberName&"|")>0 then IsReceiveUser=True
			if InStr(Rs("Received"),"|"&Cl.MemberName&"|")>0 then IsReceived=True
			ErrMsg=Replace(ErrMsg,"{$nologinmsg}","")
		else
			ErrMsg=Replace(ErrMsg,"{$nologinmsg}",LanguageObj.selectSingleNode("NoLogin").text)
		end if
		if IsReceiveUser then
			if Not IsReceived then
				ErrMsg=Replace(ErrMsg,"{$userreceivemsg}",LanguageObj.selectSingleNode("Form").text)
				if Rs("AutoReceiveTime")>0 then
					ErrMsg=ErrMsg & VbNewLine & Replace(LanguageObj.selectSingleNode("AutoJs").text,"{$time}",Rs("AutoReceiveTime"))
				end if
				ErrMsg=Replace(ErrMsg,"{$webdir}",InstallDir)
				ErrMsg=Replace(ErrMsg,"{$channeldir}",Cl.ChannelDir)
			else
				ErrMsg=Replace(ErrMsg,"{$userreceivemsg}",LanguageObj.selectSingleNode("IsReceive").text)
			end if
		else
			ErrMsg=Replace(ErrMsg,"{$userreceivemsg}","")
		end if
		ErrMsg=Replace(ErrMsg,"{$receiveuser}",replace(DelHeadTail(Rs("ReceiveUser")),"|",","))
		ErrMsg=Replace(ErrMsg,"{$received}",replace(DelHeadTail(Rs("Received")),"|",","))
		sNotReceiveUser=Trim(replace(DelHeadTail(Rs("NotReceiveUser")),"|",","))
		if sNotReceiveUser="" then
			ErrMsg=Replace(ErrMsg,"{$notreceiveuser}","")
		else
			ErrMsg=Replace(ErrMsg,"{$notreceiveuser}",sNotReceiveUser)
		end if
		ErrMsg=Replace(ErrMsg,"{$infoid}",InfoID)
		If IsPrivate and Not IsReceiveUser then
			ChkTrueRead=False
			ErrMsg=LanguageObj.selectSingleNode("NoReceive").text & ErrMsg
			Exit Function
		elseif IsPrivate then
			if Not IsReceived then
				ChkTrueRead=False
				ErrMsg=LanguageObj.selectSingleNode("NoUser").text & ErrMsg
				Exit Function
			end if
		end If
		Set LanguageObj = Nothing
	end if
'=========================================================================
End Function
%>