📄 showinfo.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit
response.Buffer=true
%>
<!--#include file="../Conn.asp"-->
<!--#include file="../SysCls/KS_UserCommonCls.asp"-->
<!--#include file="../SysCls/KS_RefreshCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim CacheTF:CacheTF=false rem 页面是否缓存
Dim CacheTime:CacheTime=100 rem 缓存失效时间
Dim KSCls
Set KSCls = New ShowArticle
KSCls.Execute()
Set KSCls = Nothing
Class ShowArticle
Private KSCMS,KSUser, KSRFObj
Private FileContent,RSObj,SqlStr,ArticleContent,InfoPurview,ReadPoint,ChargeType,PitchTime,ReadTimes
Private DomainStr,ID,ClassID,UserLoginTF,CurrPage,PayTF
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
Set KSUser=New UserCls
Set KSRFObj = New Refresh
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set KSCMS=Nothing:Set KSUser=Nothing
End Sub
Public Sub Execute()
DomainStr=KSCMS.GetDomain
UserLoginTF=Cbool(KSUser.UserLoginChecked)
ID=KSCMS.ReplaceBadChar(KSCMS.G("ID"))
CurrPage=KSCMS.ChkClng(KSCMS.G("Page"))
If CurrPage<=0 Then CurrPage=CurrPage+1
PayTF=KSCMS.G("PayTF")
IF ID="" Then Exit Sub
IF len(ID)>=10 Then
SqlStr= "Select * From KS_Article Where NewsID='" & ID & "'"
Else
SqlStr= "Select * From KS_Article Where ID=" & KSCMS.ChkClng(ID)
End IF
Set RSObj=Server.CreateObject("Adodb.Recordset")
RSObj.Open SqlStr,Conn,1,1
IF RSObj.Eof And RSObj.Bof Then
Call KSCMS.Alert("您要查看的文章已删除。或是您非法传递注入参数!",""):Exit Sub
ElseIF Cint(RSObj("Changes"))=1 Then
Response.Redirect RSObj("Fname")
End IF
Application(KSCMS.SiteSN & "RefreshType") = "ArticleContent"
Application(KSCMS.SiteSN & "RefreshFolderID") =RSObj("Tid")
Application(KSCMS.SiteSN & "RefreshArticleID")=RSObj("NewsID")
ID=RSObj("ID")
InfoPurview=Cint(RSObj("InfoPurview"))
ReadPoint=Cint(RSObj("ReadPoint"))
ChargeType=Cint(RSObj("ChargeType"))
PitchTime=Cint(RSObj("PitchTime"))
ReadTimes=Cint(RSObj("ReadTimes"))
ClassID=RSObj("Tid")
If InfoPurview=2 Then
IF UserLoginTF=false Then
Call GetNoLoginInfo
Else
IF InStr(RSObj("ArrGroupID"),KSUser.Get_GroupID)=0 Then
ArticleContent="<div align=center>对不起，你没有查看本文的权限!</div>"
Else
Call PayPointProcess()
End If
End If
ElseIF InfoPurview=0 And (KSCMS.GetClassConfig(ClassID,"ClassPurview")=1 Or KSCMS.GetClassConfig(ClassID,"ClassPurview")=2) Then
If UserLoginTF=false Then
Call GetNoLoginInfo
Else
Call PayPointProcess()
End If
Else
Call PayPointProcess()
End If
Dim KSCache:Set KSCache = New ClsCache
KSCache.name=KSCMS.SiteSN&"ArticlePage"&ID
IF KSCache.valid and KSCache.value<>"" And CacheTF=true Then
FileContent =KSCache.value
Else
Call KSCache.clean
FileContent = KSRFObj.LoadTemplate(RSObj("TemplateID"))
FileContent = KSRFObj.KSLabelReplaceAll(FileContent)
KSCache.add FileContent,dateadd("n",CacheTime,now)
End If
Dim ContentArr:ContentArr=Split(ArticleContent,"[NextPage]")
Dim TotalPage,N,ArticlePageStr
TotalPage = Cint(UBound(ContentArr) + 1)
If TotalPage > 1 Then
If CurrPage = 1 Then
ArticlePageStr = "<p><div align=center><a href=""?ID=" & ID & "&Page=" &(CurrPage + 1) & """>下一页</a><br>"
ElseIf CurrPage = TotalPage Then
ArticlePageStr = "<p><div align=center><a href=""?ID=" & ID & "&Page=" &(CurrPage - 1) & """>上一页</a><br>"
Else
ArticlePageStr = "<p><div align=center><a href=""?ID=" & ID & "&Page=" &(CurrPage - 1) & """>上一页</a> <a href=""?ID=" & ID & "&Page=" &(CurrPage + 1) & """>下一页</a><br>"
End If
ArticlePageStr = ArticlePageStr & "本文共<font color=red> " & TotalPage & " </font>页,第 "
For N = 1 To TotalPage
If CurrPage = N Then
ArticlePageStr = ArticlePageStr & "[" & N & "] "
Else
ArticlePageStr = ArticlePageStr & "<a href=""?ID=" & ID & "&Page=" & N & """>[" & N & "]</a> "
End If
If TotalPage > 10 Then
If N Mod 10 = 0 Then ArticlePageStr = ArticlePageStr & "<br>"
End If
Next
ArticlePageStr = ContentArr(CurrPage-1) & ArticlePageStr & "页</div></p>"
Else
ArticlePageStr = ArticleContent
End If
FileContent = KSRFObj.ReplaceNewsContent(RSObj, FileContent, ArticlePageStr)
Response.write FileContent
RSObj.Close:Set RSObj=Nothing
End Sub
'收费扣点处理过程
Sub PayPointProcess()
Dim UserChargeType:UserChargeType=KSUser.ChargeType
If Cint(ReadPoint)>0 Then
If UserChargeType=1 Then
Select Case ChargeType
Case 0
Call CheckPayTF("1=1")
Case 1
Call CheckPayTF("datediff('h',AddDate," & Application("SqlNowString") & ")<" & PitchTime)
Case 2
Call CheckPayTF("Times<" & ReadTimes)
Case 3
Call CheckPayTF("datediff('h',AddDate," & Application("SqlNowString") & ")<" & PitchTime & " or Times<" & ReadTimes)
Case 4
Call CheckPayTF("datediff('h',AddDate," & Application("SqlNowString") & ")<" & PitchTime & " and Times<" & ReadTimes)
Case 5
Call PayConfirm()
End Select
Elseif UserChargeType=2 Then
Dim Edays:Edays=KSUser.Edays-DateDiff("D",KSUser.BeginDate,now())
If Edays <=0 Then
ArticleContent="<div align=center>对不起，你的账户已过期 <font color=red>" & Edays & "</font> 天,此文需要在有效期内才可以查看，请及时与我们联系！</div>"
Else
Call GetContent()
End If
Else
Call GetContent()
end if
Else
Call GetContent()
End IF
End Sub
'检查是否过期，如果过期要重复扣点券
'返回值 过期返回 true,未过期返回false
Sub CheckPayTF(Param)
Dim SqlStr:SqlStr="Select top 1 Times From KS_LogPoint Where ChannelID=1 And InfoID=" & ID & " And InOrOutFlag=2 and UserName='" & KSUser.Get_UserName & "' And (" & Param & ") Order By ID"
'response.write sqlstr
'response.end
Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")
RS.Open SqlStr,conn,1,3
IF RS.Eof And RS.Bof Then
Call PayConfirm()
Else
RS.Movelast
RS(0)=RS(0)+1
RS.Update
Call GetContent()
End IF
RS.Close:Set RS=nothing
End Sub
Sub PayConfirm()
If UserLoginTF=false Then Call GetNoLoginInfo():Exit Sub
If Cint(KSUser.Get_Point)<ReadPoint Then
ArticleContent="<div align=center>对不起，你的可用" & KSCMS.PointName & "不足!阅读本文需要 <font color=red>" & ReadPoint & "</font> " & KSCMS.PointStr &",你还有 <font color=green>" & KSUser.Get_Point & "</font> " & KSCMS.PointStr & "</div>,请及时与我们联系！"
Else
If PayTF="yes" Then
IF Cbool(KSCMS.PointInOrOut(1,RSObj("ID"),KSUser.Get_UserName,2,ReadPoint,"系统","阅读收费文章：<br>" & RSObj("Title")))=True Then Call GetContent()
Else
ArticleContent="<div align=center>阅读本文需要消耗 <font color=red>" & ReadPoint & "</font> " & KSCMS.PointStr &",你目前尚有 <font color=green>" & KSUser.Get_Point & "</font> " & KSCMS.PointStr &"可用,阅读本文后，您将剩下 <font color=blue>" & KSUser.Get_Point-ReadPoint & "</font> " & KSCMS.PointStr &"</div><div align=center>你确实愿意花 <font color=red>" & ReadPoint & "</font> " & KSCMS.PointStr & "来阅读此文吗?</div><div> </div><div align=center><a href=""?ID=" & ID & "&PayTF=yes&Page=" & CurrPage &""">我愿意</a> <a href=""" &DomainStr & """>我不愿意</a></div>"
End If
End If
End Sub
Sub GetNoLoginInfo()
ArticleContent="<div align=center>对不起，你还没有登录，本文至少要求本站的注册会员才可查看!</div><div align=center>如果你还没有注册，请<a href=""" & DomainStr & "Register/UserReg_Step1.asp""><font color=red>点此注册</font></a>吧!</div><div align=center>如果您已是本站注册会员，赶紧<a href=""" & domainstr & "Member/login.asp""><font color=red>点此登录</font></a>吧！</div>"
End Sub
Sub GetContent()
ArticleContent=RSObj("ArticleContent")
End Sub
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -