PageRenderTime 46ms CodeModel.GetById 15ms RepoModel.GetById 0ms app.codeStats 0ms

/Wap/Plus/DownLoad.asp

https://github.com/joechen2010/health
ASP | 313 lines | 292 code | 15 blank | 6 comment | 0 complexity | 6104c3b8d9613d258cee7f6cbd27ed3c MD5 | raw file
    

  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>

    2. 

  2. <%

    3. 

  3. Option Explicit

    4. 

  4. Response.Buffer=true

    5. 

  5. %>

    6. 

  6. <%Response.ContentType="text/vnd.wap.wml; charset=utf-8" %><?xml version="1.0" encoding="utf-8"?>

    7. 

  7. <!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml"> 

    8. 

  8. <!--#include file="../Conn.asp"-->

    9. 

  9. <!--#include file="../KS_Cls/Kesion.CommonCls.asp"-->

    10. 

  10. <!--#include file="../KS_Cls/Kesion.Label.CommonCls.asp"-->

    11. 

  11. <%

    12. 

  12. Dim KSCls

    13. 

  13. Set KSCls = New DownLoad

    14. 

  14. KSCls.Kesion()

    15. 

  15. Set KSCls = Nothing

    16. 

  16. %>

    17. 

  17. 

    18. 

  18. 

    19. 

  19. <%

    20. 

  20. Class DownLoad

    21. 

  21.         Private KS,KSUser, KSRFObj

    22. 

  22. 		Private FileContent,RSObj,SqlStr,ShowInfoStr,InfoPurview,ReadPoint,ChargeType,PitchTime,ReadTimes,DownUrl

    23. 

  23. 		Private DomainStr,ID,ChannelID,ClassPurview,UserLoginTF,PayTF,DownUrlTF,TitleStr,Rs,SQL,FoundErr,SoftName,DownID,Hits

    24. 

  24. 

    25. 

  25. 		Private Sub Class_Initialize()

    26. 

  26. 		    Set KS=New PublicCls

    27. 

  27. 		    Set KSUser=New UserCls

    28. 

  28. 		    Set KSRFObj = New Refresh

    29. 

  29. 		End Sub

    30. 

  30.         Private Sub Class_Terminate()

    31. 

  31. 		    Call CloseConn()

    32. 

  32. 		    Set KS=Nothing:Set KSUser=Nothing

    33. 

  33. 		End Sub

    34. 

  34. 		

    35. 

  35. 		Public Sub Kesion()

    36. 

  36. 		    DownUrlTF=false

    37. 

  37. 			DomainStr=KS.GetDomain

    38. 

  38. 		    UserLoginTF=Cbool(KSUser.UserLoginChecked)

    39. 

  39. 			ID = KS.ChkClng(KS.S("ID"))

    40. 

  40. 			ChannelID = KS.ChkClng(KS.S("ChannelID"))

    41. 

  41. 			DownID = KS.ChkClng(KS.S("DownID"))

    42. 

  42. 			PayTF=KS.S("PayTF")

    43. 

  43. 			

    44. 

  44. 			If ID = 0 Then

    45. 

  45. 			   TitleStr="下载错误提示"

    46. 

  46. 			   ShowInfoStr = ShowInfoStr & "错误的系统参数!请输入正确的" & KS.C_S(ChannelID,3) & "ID<br/>"

    47. 

  47. 			   FoundErr=True

    48. 

  48. 			End If

    49. 

  49. 			If DownID = 0 Then

    50. 

  50. 			   TitleStr="下载错误提示"

    51. 

  51. 			   ShowInfoStr = ShowInfoStr & "错误的系统参数!请输入正确的" & KS.C_S(ChannelID,3) & "ID<br/>"

    52. 

  52. 			   FoundErr=True

    53. 

  53. 			End If

    54. 

  54. 

    55. 

  55. 			If FoundErr Then Call ShowInfo :Exit Sub

    56. 

  56. 			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

    57. 

  57. 			Set RSObj=Server.CreateObject("Adodb.Recordset")

    58. 

  58. 			RSObj.Open SqlStr,Conn,1,3

    59. 

  59. 			IF RSObj.Eof And RSObj.Bof Then

    60. 

  60. 			   TitleStr="下载错误提示"

    61. 

  61. 			   ShowInfoStr = ShowInfoStr & "找不到你要下载的" & KS.C_S(ChannelID,3) & "！<br/>"

    62. 

  62. 			   FoundErr=True:Call ShowInfo :Exit Sub

    63. 

  63. 			End IF

    64. 

  64. 			ID=RSObj("ID")

    65. 

  65. 			InfoPurview=Cint(RSObj("InfoPurview"))

    66. 

  66. 			ReadPoint=Cint(RSObj("ReadPoint"))

    67. 

  67. 			ChargeType=Cint(RSObj("ChargeType"))

    68. 

  68. 			PitchTime=Cint(RSObj("PitchTime"))

    69. 

  69. 			ReadTimes=Cint(RSObj("ReadTimes"))

    70. 

  70. 			ClassPurview=Cint(RSObj("ClassPurview"))

    71. 

  71. 		    

    72. 

  72. 			If InfoPurview=2 or ReadPoint>0 Then

    73. 

  73. 			   IF UserLoginTF=false Then

    74. 

  74. 				  Call GetNoLoginInfo

    75. 

  75. 			   Else

    76. 

  76. 			      IF KS.FoundInArr(RSObj("ArrGroupID"),KSUser.GroupID,",")=false and readpoint=0 Then

    77. 

  77. 					 ShowInfoStr = ShowInfoStr & "对不起，你没有下载本" & KS.C_S(ChannelID,3) & "的权限!<br/>"

    78. 

  78. 					 FoundErr=True:Call ShowInfo :Exit Sub

    79. 

  79. 				  Else

    80. 

  80. 				     Call PayPointProcess()

    81. 

  81. 				  End If

    82. 

  82. 			   End If

    83. 

  83. 		    ElseIF InfoPurview=0 And (ClassPurview=1 Or ClassPurview=2) Then 

    84. 

  84. 			   If UserLoginTF=false Then

    85. 

  85. 			      Call GetNoLoginInfo

    86. 

  86. 			   Else     

    87. 

  87. 			  	 '============继承栏目收费设置时,读取栏目收费配置===========

    88. 

  88. 			      ReadPoint=Cint(RSObj("DefaultReadPoint"))   

    89. 

  89. 				  ChargeType=Cint(RSObj("DefaultChargeType"))

    90. 

  90. 				  PitchTime=Cint(RSObj("DefaultPitchTime"))

    91. 

  91. 				  ReadTimes=Cint(RSObj("DefaultReadTimes"))

    92. 

  92. 				  '============================================================

    93. 

  93. 				  If ClassPurview=2 Then

    94. 

  94. 					 IF KS.FoundInArr(RSObj("ArrGroupID"),KSUser.GroupID,",")=false Then

    95. 

  95. 					    ShowInfoStr="对不起，你所在的用户组没有下载的权限!<br/>"

    96. 

  96. 					 Else

    97. 

  97. 						Call PayPointProcess()

    98. 

  98. 					 End If

    99. 

  99. 				  Else    

    100. 

  100. 				     Call PayPointProcess()

    101. 

  101. 				  End If

    102. 

  102. 			   End If

    103. 

  103. 		    Else

    104. 

  104. 			   Call PayPointProcess()

    105. 

  105. 		    End If 

    106. 

  106. 		    If DownUrlTF=true Then

    107. 

  107. 		       RSObj("Hits") = RSObj("Hits") + 1

    108. 

  108. 			   If DateDiff("D", RSObj("LastHitsTime"), Now()) <= 0 Then

    109. 

  109. 			      RSObj("HitsByDay") = RSObj("HitsByDay") + 1

    110. 

  110. 			   Else

    111. 

  111. 			      RSObj("HitsByDay") = 1

    112. 

  112. 			   End If

    113. 

  113. 			   If DateDiff("ww", RSObj("LastHitsTime"), Now()) <= 0 Then

    114. 

  114. 			      RSObj("HitsByWeek") = RSObj("HitsByWeek") + 1

    115. 

  115. 			   Else

    116. 

  116. 			      RSObj("HitsByWeek") = 1  

    117. 

  117. 			   End If

    118. 

  118. 			   If DateDiff("m", RSObj("LastHitsTime"), Now()) <= 0 Then

    119. 

  119. 			      RSObj("HitsByMonth") = RSObj("HitsByMonth") + 1

    120. 

  120. 			   Else

    121. 

  121. 			      RSObj("HitsByMonth") = 1

    122. 

  122. 			   End If

    123. 

  123. 			   RSObj("LastHitsTime") = Now()

    124. 

  124. 			   RSObj.Update

    125. 

  125. 			   

    126. 

  126. 			   On Error Resume Next

    127. 

  127. 		       Dim DownArr:DownArr=Split(Split(RSObj("DownUrls"),"|||")(DownID-1),"|")

    128. 

  128. 			   If Err Then

    129. 

  129. 			      TitleStr="下载错误提示"

    130. 

  130. 				  ShowInfoStr = ShowInfoStr & "非法访问！<br/>"

    131. 

  131. 				  Call ShowInfo :Exit Sub

    132. 

  132. 			   End If

    133. 

  133. 			   

    134. 

  134. 			   If DownArr(0)="0" Then

    135. 

  135. 			      DownUrl=replace(DownArr(2),"&","&amp;")

    136. 

  136. 				  If lcase(left(DownUrl,4))<>"http" Then DownUrl=KS.Setting(2) & KS.Setting(3) & DownUrl

    137. 

  137. 			      Response.Write "<wml>"

    138. 

  138. 				  Response.Write "<head>"

    139. 

  139. 				  Response.Write "<meta http-equiv=""Cache-Control"" content=""no-Cache""/>"

    140. 

  140. 				  Response.Write "<meta http-equiv=""Cache-Control"" content=""max-age=0""/>"

    141. 

  141. 				  Response.Write "</head>"

    142. 

  142. 				  Response.Write "<card id=""main"" title=""" & TitleStr & """ ontimer="""& DownUrl&"""><timer value=""3""/>"

    143. 

  143. 				  Response.Write "<p align=""center"">"

    144. 

  144. 				  Response.Write "请稍候正在下载...<br/>"

    145. 

  145. 				  Response.Write "如果你的手机没能下载，请点击<a href="""&DownUrl&""">这里</a>下载<br/>"

    146. 

  146. 				  Response.Write "<anchor>点击返回<go href=""../Show.asp?ID="&ID&"&amp;ChannelID="&ChannelID&"&amp;"&KS.WapValue&""" method=""post""></go></anchor><br/>"

    147. 

  147. 				  Response.Write "<anchor>返回首页<go href="""&KS.GetGoBackIndex&""" method=""post""></go></anchor><br/>"

    148. 

  148. 				  Response.Write "</p>"

    149. 

  149. 				  Response.Write "</card>"

    150. 

  150. 				  Response.Write "</wml>"

    151. 

  151. 				  Exit Sub

    152. 

  152. 			   Else

    153. 

  153. 			      Set Rs = Server.CreateObject("ADODB.Recordset")

    154. 

  154. 				  SQL = "SELECT top 1 AllDownHits,DayDownHits,HitsTime FROM KS_DownSer WHERE downid="& KS.ChkClng(KS.S("Sid"))

    155. 

  155. 				  Rs.Open SQL,Conn,1,3

    156. 

  156. 				  If Not(Rs.BOF And Rs.EOF) Then

    157. 

  157. 				     hits = CLng(Rs("AllDownHits"))+1

    158. 

  158. 					 Rs("AllDownHits").Value = hits

    159. 

  159. 					 If DateDiff("D", Rs("HitsTime"), Now()) <= 0 Then

    160. 

  160. 					    Rs("DayDownHits").Value = Rs("DayDownHits").Value + 1

    161. 

  161. 					 Else

    162. 

  162. 					    Rs("DayDownHits").Value = 1

    163. 

  163. 						Rs("HitsTime").Value = Now()

    164. 

  164. 					 End If

    165. 

  165. 					 Rs.Update

    166. 

  166. 				  End If

    167. 

  167. 				  Rs.Close:Set Rs = Nothing

    168. 

  168. 				  

    169. 

  169. 				  Dim RS_S:Set RS_S=Server.CreateObject("ADODB.RECORDSET")

    170. 

  170. 				  RS_S.Open "Select IsOuter,DownloadPath,UnionID From KS_DownSer Where DownID=" & KS.ChkClng(KS.S("Sid")),Conn,1,1

    171. 

  171. 				  If Not RS_S.Eof Then

    172. 

  172. 			         Response.Write "<wml>"

    173. 

  173. 					 Response.Write "<head>"

    174. 

  174. 					 Response.Write "<meta http-equiv=""Cache-Control"" content=""no-Cache""/>"

    175. 

  175. 					 Response.Write "<meta http-equiv=""Cache-Control"" content=""max-age=0""/>"

    176. 

  176. 					 Response.Write "</head>"

    177. 

  177. 					 Select Case RS_S(0)

    178. 

  178. 					     Case 0

    179. 

  179. 						    Response.Write "<card id=""main"" title=""" & TitleStr & """ ontimer="""&RS_S(1) & DownArr(2)&"""><timer value=""3""/>"

    180. 

  180. 							Response.Write "<p align=""center"">"

    181. 

  181. 							Response.Write "请稍候正在下载...<br/>"

    182. 

  182. 							Response.Write "如果你的手机没能下载，请点击<a href="""&DownArr(2)&""">这里</a>下载<br/>"

    183. 

  183. 						 Case 2

    184. 

  184. 						    Response.Write "<card id=""main"" title=""操作提示"">"

    185. 

  185. 							Response.Write "<p align=""center"">"

    186. 

  186. 							Response.Write "WEB迅雷专用下载地址，请返回选择其它下载地址...<br/>"

    187. 

  187. 						 Case 3

    188. 

  188. 						    Response.Write "<card id=""main"" title=""操作提示"">"

    189. 

  189. 							Response.Write "<p align=""center"">"

    190. 

  190. 							Response.Write "FLASHGET(快车)专用下载地址，请返回选择其它下载地址...<br/>"

    191. 

  191. 					 End Select

    192. 

  192. 					 Response.Write "<anchor>点击返回<go href=""Show.asp?ID="&ID&"&amp;ChannelID="&ChannelID&"&amp;"&KS.WapValue&""" method=""post""></go></anchor><br/>"

    193. 

  193. 					 Response.Write "<anchor>返回首页<go href="""&KS.GetGoBackIndex&""" method=""post""></go></anchor><br/>"

    194. 

  194. 					 Response.Write "</p>"

    195. 

  195. 					 Response.Write "</card>"

    196. 

  196. 					 Response.Write "</wml>"

    197. 

  197. 					 Exit Sub

    198. 

  198. 				  End If

    199. 

  199. 				  RS_S.Close:Set RS_S=Nothing

    200. 

  200. 			   End If

    201. 

  201. 		   Else

    202. 

  202. 		     TitleStr="操作提示"

    203. 

  203. 		   End If

    204. 

  204. 		   Call ShowInfo()

    205. 

  205. 		   RSObj.Close:Set RSObj=Nothing

    206. 

  206. 	   End Sub

    207. 

  207. 

    208. 

  208. 

    209. 

  209.       '收费扣点处理过程

    210. 

  210. 	   Sub PayPointProcess()

    211. 

  211. 	       If Cint(ReadPoint)>0 or InfoPurview=2 or (InfoPurview=0 And (ClassPurview=1 Or ClassPurview=2)) Then

    212. 

  212. 		   IF UserLoginTF=false Then Call GetNoLoginInfo :Exit Sub

    213. 

  213. 		   Dim UserChargeType:UserChargeType=KSUser.ChargeType

    214. 

  214. 		   If UserChargeType=1 Then

    215. 

  215. 		      Select Case ChargeType

    216. 

  216. 			      Case 0:Call CheckPayTF("1=1")

    217. 

  217. 				  Case 1

    218. 

  218. 				     If DataBaseType=1 Then

    219. 

  219. 					    Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime)

    220. 

  220. 					 Else

    221. 

  221. 					    Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime)

    222. 

  222. 					 End If

    223. 

  223. 				  Case 2:Call CheckPayTF("Times<" & ReadTimes)

    224. 

  224. 				  Case 3

    225. 

  225. 				     If DataBaseType=1 Then

    226. 

  226. 					    Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime & " or Times<" & ReadTimes)

    227. 

  227. 					 Else

    228. 

  228. 					    Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime & " or Times<" & ReadTimes)

    229. 

  229. 					 End If

    230. 

  230. 				  Case 4

    231. 

  231. 				     If DataBaseType=1 Then

    232. 

  232. 					    Call CheckPayTF("datediff(hour,AddDate," & SqlNowString & ")<" & PitchTime & " and Times<" & ReadTimes)

    233. 

  233. 					 Else

    234. 

  234. 					    Call CheckPayTF("datediff('h',AddDate," & SqlNowString & ")<" & PitchTime & " and Times<" & ReadTimes)

    235. 

  235. 					 End If

    236. 

  236. 				  Case 5:Call PayConfirm()

    237. 

  237. 			  End Select

    238. 

  238. 		   Elseif UserChargeType=2 Then

    239. 

  239. 		      If KSUser.GetEdays <=0 Then

    240. 

  240. 			     ShowInfoStr="对不起，你的账户已过期" & KSUser.GetEdays & "天,此" & KS.C_S(ChannelID,3) & "需要在有效期内才可以下载，请及时与我们联系！<br/>"

    241. 

  241. 			  Else

    242. 

  242. 			     Call GetContent()

    243. 

  243. 			  End If

    244. 

  244. 		   Else

    245. 

  245. 		      Call GetContent()

    246. 

  246. 		   End If   	  

    247. 

  247. 		   Else

    248. 

  248. 		   Call GetContent()

    249. 

  249. 		   End IF

    250. 

  250. 	   End Sub

    251. 

  251. 	   '检查是否过期，如果过期要重复扣点券

    252. 

  252. 	   '返回值 过期返回 true,未过期返回false

    253. 

  253. 	   Sub CheckPayTF(Param)

    254. 

  254. 	       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"

    255. 

  255. 		   Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")

    256. 

  256. 		   RS.Open SqlStr,conn,1,3

    257. 

  257. 		   IF RS.Eof And RS.Bof Then

    258. 

  258. 		      Call PayConfirm()	

    259. 

  259. 		   Else

    260. 

  260. 		      RS.Movelast

    261. 

  261. 			  RS(0)=RS(0)+1

    262. 

  262. 			  RS.Update

    263. 

  263. 			  Call GetContent()

    264. 

  264. 		   End IF

    265. 

  265. 		   RS.Close:Set RS=nothing

    266. 

  266. 	   End Sub

    267. 

  267. 	   

    268. 

  268. 	   Sub PayConfirm()

    269. 

  269. 	       If UserLoginTF=false Then Call GetNoLoginInfo():Exit Sub

    270. 

  270. 		   If ReadPoint=0 Then GetContent():Exit Sub

    271. 

  271. 		   If Cint(KSUser.Point)<ReadPoint Then

    272. 

  272. 		      ShowInfoStr="对不起，你的可用" & KS.Setting(45) & "不足!下载本" & KS.C_S(ChannelID,3) & "需要" & ReadPoint & "" & KS.Setting(46) & KS.Setting(45) &",你还有" & KSUser.Point & "" & KS.Setting(46) & KS.Setting(45) & ",请及时与我们联系！<br/>" 

    273. 

  273. 		   Else

    274. 

  274. 		      If PayTF="yes" Then

    275. 

  275. 		         IF Cbool(KS.PointInOrOut(ChannelID,RSObj("ID"),KSUser.UserName,2,ReadPoint,"系统","下载收费" & KS.C_S(ChannelID,3) & "：<br>" & RSObj("Title")))=True Then

    276. 

  276. 				    '支付投稿者提成

    277. 

  277. 					Dim PayPoint:PayPoint=(ReadPoint*KS.C_C(RSObj("Tid"),11))/100

    278. 

  278. 					If PayPoint>0 Then

    279. 

  279. 					   Call KS.PointInOrOut(ChannelID,RSObj("ID"),RSObj("Inputer"),1,PayPoint,"系统",KS.C_S(ChannelID,3) & "“" & RSObj("Title") & "”的提成")

    280. 

  280. 					End If

    281. 

  281. 				    Call GetContent()

    282. 

  282. 				 End If

    283. 

  283. 		      Else

    284. 

  284. 		         ShowInfoStr="下载本软件需要消耗" & ReadPoint & "" & KS.Setting(46) & KS.Setting(45) &",你目前尚有" & KSUser.Point & "" & KS.Setting(46) & KS.Setting(45) &"可用,下载本" & KS.C_S(ChannelID,3) & "后，您将剩下" & KSUser.Point-ReadPoint & "" & KS.Setting(46) & KS.Setting(45) &"<br/>你确实愿意花" & ReadPoint & "" & KS.Setting(46) & KS.Setting(45) & "来下载本" & KS.C_S(ChannelID,3) & "吗?<br/><a href=""?ID=" & ID & "&PayTF=yes&DownID=" & DownID & """>我愿意</a> <a href=""" &DomainStr & """>我不愿意</a><br/>"

    285. 

  285. 			   End If

    286. 

  286. 			End If

    287. 

  287. 	   End Sub

    288. 

  288. 	   Sub GetNoLoginInfo()

    289. 

  289. 		   ShowInfoStr="对不起，你还没有登录，本" & KS.C_S(ChannelID,3) & "至少要求本站的注册会员才可下载!<br/>如果你还没有注册，请<a href=""" & DomainStr & "User/Reg/"">点此注册</a>吧!<br/>如果您已是本站注册会员，赶紧<a href=""" & domainstr & "User/Login/"">点此登录</a>吧！<br/>"

    290. 

  290. 	   End Sub

    291. 

  291. 	   Sub GetContent()

    292. 

  292. 		   TitleStr=RSObj("Title")

    293. 

  293. 		   DownUrlTF=True

    294. 

  294. 	   End Sub

    295. 

  295. 			

    296. 

  296. 	   Function ShowInfo()

    297. 

  297. 		   Response.Write "<wml>" &vbcrlf

    298. 

  298. 		   Response.Write "<head>" &vbcrlf

    299. 

  299. 		   Response.Write "<meta http-equiv=""Cache-Control"" content=""no-Cache""/>" &vbcrlf

    300. 

  300. 		   Response.Write "<meta http-equiv=""Cache-Control"" content=""max-age=0""/>" &vbcrlf

    301. 

  301. 		   Response.Write "</head>" &vbcrlf

    302. 

  302. 		   Response.Write "<card id=""main"" title=""" & TitleStr & """>" &vbcrlf

    303. 

  303. 		   Response.Write "<p align=""center"">" &vbcrlf

    304. 

  304. 		   Response.Write ""&ShowInfoStr&"" &vbcrlf

    305. 

  305. 		   Response.Write "<anchor>点击返回<go href=""Show.asp?ID="&ID&"&amp;ChannelID="&ChannelID&"&amp;"&KS.WapValue&""" method=""post""></go></anchor><br/>" &vbcrlf

    306. 

  306. 		   Response.Write "<anchor>返回首页<go href="""&KS.GetGoBackIndex&""" method=""post""></go></anchor><br/>" &vbcrlf

    307. 

  307. 		   Response.Write "</p>" &vbcrlf

    308. 

  308. 		   Response.Write "</card>" &vbcrlf

    309. 

  309. 		   Response.Write "</wml>"

    310. 

  310. 	   End Function

    311. 

  311. End Class

    312. 

  312. %>

    313. 

  313.  

    314. 

  314.