经过一个多星期的时间(当然其实就一天....)，在官方版主给出的思路帮助下，总算在自建下载模型的“下载内容页”(即ShowInfo.asp)，加上登陆/收费/权限组等验证，和认证文章频道一样。刚刚调试完，就发上来咯~~热乎的！
首先，在自建模型的文件夹下，打开 showinfo.asp 进行修改编辑：
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit
response.Buffer=true
%>
<!--#include file="../Conn.asp"-->
<!--#include file="../KS_Cls/KS.UserCls.asp"-->
<!--#include file="../KS_Cls/KS.RCls.asp"-->
<!--#include file="config.asp"-->
<%
Dim KSCls
Set KSCls = New ShowArticle
KSCls.Kesion()
Set KSCls = Nothing
Class ShowArticle
Private ClassPurview,UserLoginTF,PayTF,InfoPurview,ReadPoint,ChargeType,PitchTime,ReadTimes,ShowInfoStr,TitleStr,DomainStr
Private KS,KSRFObj,KSUser
Private FileContent,RSObj,SqlStr,DownLoadContent
Private ID,ClassID
Private Sub Class_Initialize()
Set KS=New PublicCls
Set KSUser=New UserCls
Set KSRFObj = New Refresh
End Sub
Private Sub Class_Terminate()
Call CloseConn()
Set KS=Nothing
Set KSUser=Nothing
End Sub
Public Sub Kesion()
UserLoginTF=Cbool(KSUser.UserLoginChecked) '判断有没有登录
ID=KS.R(KS.S("ID"))
IF ID="" Then Exit Sub
SqlStr= "Select a.*,ClassPurview From " & KS.C_S(ChannelID,2) & " a inner join ks_class b on a.tid=b.id Where a.ID=" & ID
Set RSObj=Server.CreateObject("Adodb.Recordset")
RSObj.Open SqlStr,Conn,1,1
IF RSObj.Eof And RSObj.Bof Then
Call KS.Alert("您要查看的软件已删除。或是您非法传递注入参数!",""):Exit Sub
End IF
'得到收费信息
InfoPurview=Cint(RSObj("InfoPurview"))
ReadPoint=Cint(RSObj("ReadPoint"))
ChargeType=Cint(RSObj("ChargeType"))
PitchTime=Cint(RSObj("PitchTime"))
ReadTimes=Cint(RSObj("ReadTimes"))
ClassPurview=Cint(RSObj("ClassPurview"))
'进行判断
If InfoPurview=2 or ReadPoint>0 Then
IF UserLoginTF=false Then
Call GetNoLoginInfo
Else
IF KS.FoundInArr(RSObj("ArrGroupID"),KSUser.GroupID,",")=false and readpoint=0 Then
ShowInfoStr = ShowInfoStr & "<li>对不起，您没有下载本" & KS.C_S(ChannelID,3) & "的权限!</li>"
FoundErr=True:Call ShowInfo :Exit Sub
Else
Call PayPointProcess()
End If
End If
ElseIF InfoPurview=0 And (ClassPurview=1 Or ClassPurview=2) Then
If UserLoginTF=false Then
Call GetNoLoginInfo
Else
If ClassPurview=2 Then
IF KS.FoundInArr(RSObj("ArrGroupID"),KSUser.GroupID,",")=false Then
ShowInfoStr="<div align=center>对不起，您所在的营帐没有下载该教程的权限!</div>"
Else
Call PayPointProcess()
End If
Else
Call PayPointProcess()
End If
End If
Else
Call PayPointProcess()
End If
'判断showinfostr是否为空，不为空说明没有权限，并输出，终止继续执行
If ShowINfoStr<>"" Then Response.Write ShowinfoStr:response.end
Application(KS.SiteSN & "RefreshType") = "DownLoadContent"
Application(KS.SiteSN & "RefreshFolderID") = RSObj("Tid")
Application(KS.SiteSN & "RefreshInfoID") = RSObj("ID")
Application(KS.SiteSN & "ChannelID")=ChannelID
FileContent = KSRFObj.LoadTemplate(RSObj("TemplateID"))
FileContent = KSRFObj.KSLabelReplaceAll(FileContent)
FileContent = KSRFObj.ReplaceDownLoadContent(ChannelID,RSObj, FileContent)
Response.write FileContent
RSObj.Close:Set RSObj=Nothing
End Sub
'收费扣点处理过程
Sub PayPointProcess()
If Cint(ReadPoint)>0 or InfoPurview=2 or (InfoPurview=0 And (ClassPurview=1 Or ClassPurview=2)) Then
IF UserLoginTF=false Then Call GetNoLoginInfo :Exit Sub
Dim UserChargeType:UserChargeType=KSUser.ChargeType
If UserChargeType=1 Then
Select Case ChargeType
Case 0:Call CheckPayTF("1=1")
Case 1
If DataBaseType=1 Then
Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime)
Else
Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime)
End If
Case 2:Call CheckPayTF("Times<" & ReadTimes)
Case 3
If DataBaseType=1 Then
Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime & " or Times<" & ReadTimes)
Else
Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime & " or Times<" & ReadTimes)
End If
Case 4
If DataBaseType=1 Then
Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime & " and Times<" & ReadTimes)
Else
Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime & " and Times<" & ReadTimes)
End If
Case 5:Call PayConfirm()
End Select
Elseif UserChargeType=2 Then
If KSUser.GetEdays <=0 Then
ShowInfoStr="<div align=center>对不起，你的账户已过期 <font color=red>" & KSUser.GetEdays & "</font> 天,此" & KS.C_S(ChannelID,3) & "需要在有效期内才可以下载，请及时与我们联系！</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=" & ChannelID & " And InfoID=" & ID & " And InOrOutFlag=2 and UserName='" & KSUser.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.Point)<ReadPoint Then
ShowInfoStr="<div align=center>对不起，你的可用" & KS.Setting(45) & "不足!下载本" & KS.C_S(ChannelID,3) & "需要 <font color=red>" & ReadPoint & "</font> " & KS.Setting(46) & KS.Setting(45) &",你还有 <font color=green>" & KSUser.Point & "</font> " & KS.Setting(46) & KS.Setting(45) & "</div>,请及时与我们联系！"
Else
If PayTF="yes" Then
IF Cbool(KS.PointInOrOut(ChannelID,RSObj("ID"),KSUser.UserName,2,ReadPoint,"系统","下载收费" & KS.C_S(ChannelID,3) & "：<br>" & RSObj("Title")))=True Then Call GetContent()
Else
ShowInfoStr="<div align=center>下载本软件需要消耗 <font color=red>" & ReadPoint & "</font> " & KS.Setting(46) & KS.Setting(45) &",你目前尚有 <font color=green>" & KSUser.Point & "</font> " & KS.Setting(46) & KS.Setting(45) &"可用,下载本" & KS.C_S(ChannelID,3) & "后，您将剩下 <font color=blue>" & KSUser.Point-ReadPoint & "</font> " & KS.Setting(46) & KS.Setting(45) &"</div><div align=center>你确实愿意花 <font color=red>" & ReadPoint & "</font> " & KS.Setting(46) & KS.Setting(45) & "来下载本" & KS.C_S(ChannelID,3) & "吗?</div><div> </div><div align=center><a href=""?ID=" & ID & "&PayTF=yes&DownID=" & DownID & """>我愿意</a> <a href=""" &DomainStr & """>我不愿意</a></div>"
End If
End If
End Sub
Sub GetNoLoginInfo()
ShowInfoStr="<div align=center>对不起，你还没有登录，本" & KS.C_S(ChannelID,3) & "至少要求本站的注册会员才可下载!</div><div align=center>如果你还没有注册，请<a href=""" & DomainStr & "User/UserReg.asp""><font color=red>点此注册</font></a>吧!</div><div align=center>如果您已是本站注册会员，赶紧<a href=""" & domainstr & "User/login.asp""><font color=red>点此登录</font></a>吧！</div>"
End Sub
Sub GetContent()
TitleStr=RSObj("Title")
End Sub
End Class
%>
---------------------------------------------------------------------------------------------
以上是我修改并调试成功的源文件全部内容，红色部分为修改替换/增加的内容，大家可以参照修改或直接复制粘贴到你的文件中。
在此呢，我要感谢KS、感谢商区版主、感谢各位KS粉丝、感谢CCTV、感谢**风云榜.........
[此贴子已经被作者于2007-11-27 14:30:52编辑过]
当前位置：
支持(0) | 
反对(0)
顶端 
底部
![电子邮件:[ juncheng@foxmail.com ]](http://bbs.kesion.com/club/images/email.gif){kind=small}
