<% Dim ACTCLS,ModeID Dim Url,urlarr,ACT_L,UserHS,ACT_Lable,PerPageNumber,TypeContent,UserID,PayTF,classid,Type_file_Content,Purview Dim CurrPage,ID,InfoPurview,ReadPoint,ClassPurview,ClassReadPoint,UserLoginTF,ChargeType,PitchTime,ReadTimes Set ACT_L = New ACT_Code Set UserHS = New ACT_User Dim SqlStr,TemplateContent,Rs,sqlstrs UserLoginTF=Cbool(UserHS.UserLoginChecked) ID = rsql(fycms.s("id")) CurrPage=ChkNumeric(fycms.s("page")) ModeID=1 If ModeID=0 Then ModeID=1 If CurrPage<=0 Then CurrPage=CurrPage+1 If IsNumeric(ID)=True Then If Len(ID)<9 Then sqlstrs=" id="&ID Else sqlstrs=" classid="&ID End If Else sqlstrs=" pinyin='"&ID&"'" End If Set Rs=fycms.actexe("Select * From "&fycms.ACT_C(ModeID,2)&" where " & sqlstrs) If Rs.Eof And Rs.Bof Then Call fycms.Alert("您要查看的文章已删除。或是您非法传递注入参数!!",fycms.Domain):Response.End ElseIf Rs("actlink") = 1 Then Response.Redirect Rs("FileName") End If Type_file_Content=fycms.Htmljapan(getcontentxml(modeid,id,rs("addtime"))) InfoPurview = Cint(rs("infopurview")) ReadPoint = Cint(rs("readpoint")) ChargeType = Cint(rs("ChargeType")) PitchTime = Cint(rs("pitchtime")) ReadTimes = Cint(rs("readtimes")) UserID = ChkNumeric(rs("userid")) classid = rs("classid") ClassPurview= Cint(fycms.ACT_L(rs("classid"),19)) ClassReadPoint= Cint(fycms.ACT_L(rs("classid"),20)) Dim ClassChargeType,ClassPitchTime,ClassReadTimes Select Case InfoPurview Case "0" Call checkclassinfo() Case "1" IF UserLoginTF=false Then Purview=True:Call GetNoLoginInfo() Case "2" If fycms.FoundInArr(rs("arrGroupID"),Trim(UserHS.GroupID),",")=False Then die("对不起,你所在的用户组没有查看的权限1!") Else Call PayPointProcess() End If End Select If ReadPoint>0 Then Call PayPointProcess() Sub checkclassinfo() IF (ClassPurview=1 or ClassPurview=2 Or ClassReadPoint>0) Then If UserLoginTF=false Then Purview=true Call GetNoLoginInfo Else classReadPoint = Cint(fycms.ACT_L(classid,20)) classChargeType = Cint(fycms.ACT_L(classid,21)) classPitchTime = Cint(fycms.ACT_L(classid,22)) classReadTimes = Cint(fycms.ACT_L(classid,23)) If ClassPurview=2 Then If fycms.FoundInArr(fycms.ACT_L(classid,6),Trim(UserHS.GroupID),",")=false Then die("对不起,你所在的用户组没有查看的权限!") Else Call PayPointProcess() End If Else Call PayPointProcess() End If End If End If End Sub '收费扣点处理过程 Sub PayPointProcess() Dim UserChargeType:UserChargeType=UserHS.ChargeType If (Cint(ReadPoint)>0 or InfoPurview=2 or (InfoPurview=0 And (ClassPurview=1 Or ClassPurview=2))) and UserHS.UserID<>UserID Then If UserChargeType=1 Then Select Case ChargeType Case 0:Call CheckPayTF("1=1") Case 1:Call CheckPayTF("datediff('h',AddDate," & NowString & ")<" & PitchTime) Case 2:Call CheckPayTF("Times<" & ReadTimes) Case 3:Call CheckPayTF("datediff('h',AddDate," & NowString & ")<" & PitchTime & " or Times<" & ReadTimes) Case 4:Call CheckPayTF("datediff('h',AddDate," & NowString & ")<" & PitchTime & " and Times<" & ReadTimes) Case 5:Call PayConfirm() End Select Elseif UserChargeType=2 Then If UserHS.GetEdays <=0 Then Purview=true typeContent="
对不起,你的账户已过期 " & UserHS.GetEdays & " 天,此文需要在有效期内才可以查看,请及时与我们联系!
" End If end if End IF End Sub Sub GetNoLoginInfo() TypeContent="
对不起,您还没有登录,本文至少要求本站的注册会员才可查看!
如果您还没有注册,请点此注册吧!
如果您已是本站注册会员,赶紧点此登录吧!
" End Sub '检查是否过期,如果过期要重复扣点券 '返回值 过期返回 true,未过期返回false Sub CheckPayTF(Param) Dim SqlStr:SqlStr="Select top 1 Times From Point_Log_fy Where ModeID=" & ModeID & " And InfoID=" & ID & " And PointFlag=2 and UserID=" & UserHS.UserID & " And (" & Param & ") Order By ID" 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 End IF RS.Close:Set RS=nothing End Sub Sub PayConfirm() Purview=true If UserLoginTF=false Then Call GetNoLoginInfo():Exit Sub If ReadPoint<=0 Then Exit Sub If Cint(UserHS.Point)对不起,你的可用" & fycms.fycms_Sys(24) & "不足!阅读本文需要 " & ReadPoint & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) &",你还有 " & UserHS.Point & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) & ",请及时与我们联系!" Else If ChkNumeric(fycms.s("pay"))="1" Then Call fycms.PointInOrOut(ModeID,ID,UserHS.UserID,2,ReadPoint,"系统","阅读文档收费",0) Dim PayPoint:PayPoint=(ReadPoint*fycms.ACT_L(classid,24))/100 If PayPoint>0 Then Call fycms.PointInOrOut(ModeID,ID,UserID,1,PayPoint,"系统","阅读文档收费",0) End If Else TypeContent="
阅读本文需要消耗 " & ReadPoint & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) &",你目前尚有 " & UserHS.Point & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) &"可用,阅读本文后,您将剩下 " & UserHS.Point-ReadPoint & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) &"
你确实愿意花 " & ReadPoint & " " & fycms.fycms_Sys(25) & fycms.fycms_Sys(24) & "来阅读此文吗?
 
我愿意 我不愿意
" End If End If End Sub If rs("isAccept")<>0 Then If UserHS.UserName<>rs("ArticleInput") Then Call fycms.Alert("对不起,该文章还没有通过审核!",fycms.Domain) Response.End End If End If Application(fycmsN & "fycms_TCJ_Type") = "ARTICLECONTENT" Application(fycmsN & "classid") = rs("classid") Application(fycmsN & "modeid")=ModeID Application(fycmsN & "id")=rs("id") id = rs("id") classid=rs("classid") TemplateContent = LoadTemplate(rs("templateurl")) Dim ContentArr If fycms.ACT_C(modeid,18)="1" Then ContentArr=Split(getcontentxml(modeid,rs("id"),rs("addtime")),"[NextPage]") Else If rs("content")<>"" Then ContentArr = Split(rs("content"),"[NextPage]") Else ContentArr = Split(" ","[NextPage]") End If End If Dim TotalPage,N,ArticlePageStr TotalPage = Cint(UBound(ContentArr) + 1) If TotalPage > 1 Then If CurrPage = 1 Then ArticlePageStr = "

下一页
" ElseIf CurrPage = TotalPage Then ArticlePageStr = "

上一页
" Else ArticlePageStr = "

上一页      下一页
" End If ArticlePageStr = ArticlePageStr & "本文共 " & TotalPage & " 页,第  " For N = 1 To TotalPage If CurrPage = N Then ArticlePageStr = ArticlePageStr & "[" & N & "] " Else ArticlePageStr = ArticlePageStr & "[" & N & "] " End If If TotalPage > 8 Then If N Mod 8 = 0 Then ArticlePageStr = ArticlePageStr & "

" End If Next ArticlePageStr = ContentArr(CurrPage-1) & ArticlePageStr & "页

" Else If fycms.ACT_C(modeid,18)="1" Then ArticlePageStr = Type_file_Content Else ArticlePageStr = rs("content") End If End If If Purview=True Then ArticlePageStr=typecontent Dim newt:Set newt=New Cls_Template Dim userlogin:userlogin=CBool(UserHS.UserLoginChecked) If userlogin=True Then TemplateContent=rep(TemplateContent,"{fy:userlogin}","1=1") Else TemplateContent=rep(TemplateContent,"{fy:userlogin}","1=0") End If If fycms.ACT_C(ModeID,13)=0 Then TemplateContent=rep(TemplateContent,"{fy:Commentcode}","1=1") Else TemplateContent=rep(TemplateContent,"{fy:Commentcode}","1=0") End If TemplateContent=newt.GetContent(ModeID,rs,TemplateContent,ArticlePageStr)'自定义函数 If userlogin=True Then Dim usersqlstr,usrs usersqlstr="select f.*,u.* from User_fy F inner join "&fycms.ACT_U(UserHS.UModeID,2)&" U on F.userid=U.uid where u.uid="&userhs.userid&" order by u.uid desc" Set usrs=fycms.actexe(usersqlstr) If Not usrs.eof Then TemplateContent = newt.GetUserInfo(TemplateContent,usrs) Else TemplateContent = newt.GetnoUserInfo(TemplateContent,"") End If echo TemplateContent&vbcrlf & "" & vbCrLf Call CloseConn %>