开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > WEB源码(ASP,PHP,...) > 查看源码
Ubb_cls.Asp
资源名称：shop2.rar　[点击查看]
上传用户：btntkt
上传日期：2021-04-16
资源大小：5296k
文件大小：19k
源码类别：

WEB源码(ASP,PHP,...)

开发平台：

DOS

Ubb_cls.Asp：源码内容
  1. <%Const MaxLoopcount=100%>
  2. <script language=vbscript runat=server>
  3. Class YxBBsubb_Cls
  4. Public UbbString,Re
  5. Private Sub Class_Initialize()
  6. End Sub
  7. Rem 入口(内容，1=帖子|2=留言公告等)
  8. Public Function Ubb(Str,PostType)
  9. If isNull(Str) or Str="" then
  10. Ubb=""
  11. Exit function
  12. End if
  13. If UbbString="" Or IsNull(UbbString) Then
  14. UbbString=YxBBs.Fun.UbbString(Str)
  15. End If
  16. If instr(UbbString,",41,")>0 And PostType=1 Then
  17. Str=YxBBs_Code(Str,PostType)
  18. Else
  19. Str=YxBBs_UBB(str,postType)
  20. End If
  21. UBB=Str
  22. End Function
  24. Private Function YxBBs_UBB(Str,PostType)
  25. If isNull(Str) or Str="" then
  26. YxBBs_UBB=""
  27. Exit function
  28. End if
  29. Str=Html_Code(Str)
  30. Set re=new RegExp
  31. re.IgnoreCase =True
  32. re.Global=True
  33. If InStr(UbbString,",0,")>0 Then
  34. re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
  35. str=re.replace(str,"<font color=#000000>$1</font>")
  36. End If
  37.                 If InStr(UbbString,",35,")>0 Then Str=YxBBs_Ubb_Login(Str,PostType)
  38. If InStr(UbbString,",36,")>0 Then Str=YxBBs_Ubb_Sex(Str,PostType)
  39. If InStr(UbbString,",37,")>0 Then Str=YxBBs_Ubb_Name(Str,PostType)
  40. If InStr(UbbString,",38,")>0 Then Str=YxBBs_Ubb_Date(Str,PostType)
  41. If InStr(UbbString,",39,")>0 Then Str=YxBBs_Ubb_Reply(Str,PostType)
  42. If InStr(UbbString,",40,")>0 Then Str=YxBBs_Ubb_Buy(Str,PostType)
  43. If InStr(UbbString,",24,")>0 Then Str=YxBBs_Ubb2(Str,"[img]","[/img]","<img src=$1>","",YxBBs.BBSSetting(22)) 
  44. If InStr(UbbString,",25,")>0 Then
  45. If YxBBs.BBSSetting(22)="0" Then
  46. If Not YxBBs.FoundUser and YxBBs.BBSSetting(55)="0" Then 
  47. Str=YxBBs_Ubb3(Str,"[upload=(txt|zip|rar|mdb|swf),*(#*[0-9.]*),*(#*[0-9.]*),*(#*[0-9.]*),*(#*[0-9.]*)]","[/upload]","<fieldset><legend>上传的附件</legend><br>&nbsp;&nbsp;<font color=gray>抱歉,您所在的组无权下载附件,请<a href=register.asp>注册</a>或<a href=login.asp>登陆</a>.</font><br><br></fieldset>")
  48. Str=YxBBs_Ubb2(Str,"[upload=(gif|jpg|jpeg|bmp|png),*(#*[0-9.]*),([0-9]{1,3}),*(#*[0-9.]*),*(#*[0-9.]*)]","[/upload]","<fieldset><legend>上传的图片</legend><br>&nbsp;&nbsp;<font color=gray>抱歉,您所在的组无权下载附件,请<a href=register.asp>注册</a>或<a href=login.asp>登陆</a></font></fieldset>","",YxBBs.BBSSetting(22))
  49.                 Else
  50.         Str=YxBBs_Ubb3(Str,"[upload=(txt|zip|rar|mdb|swf),*(#*[0-9.]*),*(#*[0-9.]*),*(#*[0-9.]*),*(#*[0-9.]*)]","[/upload]","<fieldset><legend>上传的附件</legend><br>&nbsp;&nbsp;<IMG SRC=INc/Editor/images/common.gif align=absmiddle> <a href=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]<br><br></fieldset>")
  51. Str=YxBBs_Ubb2(Str,"[upload=(gif|jpg|jpeg|bmp|png),*(#*[0-9.]*),([0-9]{1,3}),*(#*[0-9.]*),*(#*[0-9.]*)]","[/upload]","<fieldset><legend>上传的图片</legend><br>&nbsp;&nbsp;<img src=INc/Editor/images/image.gif align=absmiddle> <A HREF=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB <font color=blue>$4</font>×<font color=blue>$5</font> ] <font color=#999999>(缩略时请点击查看原图)</font><br><br>&nbsp;&nbsp;<IMG SRC=""ViewFile.Asp?FileName=$6"" border=0><br><br></fieldset>","<A HREF=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a>",YxBBs.BBSSetting(22)) 
  52. End If
  53. End If
  54. End If
  55. If InStr(UbbString,",31,")>0 Then Str=UbbCode_Q(Str)
  56. If InStr(UbbString,",32,")>0 Then Str=YxBBs_GetUBB(Str,"[coin=*([0-9]*)]","[/coin]","$1<hr noshade size=1><font color=gray>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyCoin)
  57. If InStr(UbbString,",33,")>0 Then Str=YxBBs_GetUBB(Str,"[mark=*([0-9]*)]","[/mark]","$1<hr noshade size=1><font color=gray>以下内容需要积分数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要积分数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyMark)
  58. If InStr(UbbString,",34,")>0 Then Str=YxBBs_GetUBB(Str,"[grade=*([0-9]*)]","[/grade]","$1<hr noshade size=1><font color=gray>以下内容需要等级为 <b>$3</b> 或更高的等级以及作者才能浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要等级为<B>$3</B>或更高的等级以及作者才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyGradeNum)
  59.                 re.Pattern="[cc](.*?)[/cc]"
  60.                         str= re.Replace(str,"<embed src=""http://union.bokecc.com/$1"" width=""438"" height=""387"" type=""application/x-shockwave-flash""></embed>") 
  61.                 re.Pattern="<img(.[^>]*)>"
  62. str=re.replace(str,"<img$1 onmousewheel=""return bbimg(this)"" onload=""javascript:if(this.width>screen.width-500) this.style.width=screen.width-500;"" border=0>")
  63. Set re=Nothing
  64. YxBBs_UBB=Str
  65. End function
  67. Private Function Html_Code(byval Str)
  68. If IsNull(Str) then
  69.  Html_code=""
  70. Else
  71. Str=replace(Str,chr(39),"&#39;")
  72. Str=replace(Str,chr(36),"&#36;")
  73.                         str = Replace(str, "SCRIPT", "&#115cript")
  74. Str = Replace(Str, chr(10) &chr(10), "<br><br> ")
  75.                         Html_Code = Replace(Str, chr(10), "<p></p>")
  76. End if
  77. End Function
  79. Public Function Sign_Code(byval Str)
  80. If IsNull(Str) or Str="" Then
  81. Sign_Code=""
  82. Exit Function
  83. End If
  84. Str=Html_Code(Str)
  85. Set re=new regExp
  86. re.IgnoreCase=true
  87. re.Global=true
  88. re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
  89. str=re.replace(str,"<font color=#000000>$1</font>")
  90. If InStr(Lcase(Str),"[/b]")>0 Then Str=YxBBs_Ubb1(Str,"[b]","[/b]","<b>$1</b>")
  91. If InStr(Lcase(Str),"[/i]")>0 Then Str=YxBBs_Ubb1(Str,"[i]","[/i]","<i>$1</i>")
  92. If InStr(Lcase(Str),"[/u]")>0 Then Str=YxBBs_Ubb1(Str,"[u]","[/u]","<u>$1</u>")
  93.                 If InStr(Lcase(Str),"[/fly]")>0 Then Str=YxBBs_Ubb1(Str,"[fly]","[/fly]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>") 
  94.                 If InStr(Lcase(Str),"[/url]")>0 Then Str=YxBBs_Ubb1(Str,"[url=(.{5,}?)]","[/url]","<a href=""$1"" target='_blank'>$2</a>")
  95.                 If InStr(Lcase(Str),"[/color]")>0 Then Str=YxBBs_Ubb1(Str,"[color=((#.{6})|.{3,6})]","[/color]","<font color=#$1>$3</font>") 
  96. If InStr(Lcase(Str),"[/img]")>0 Then Str=YxBBs_Ubb2(Str,"[img]","[/img]","<img src=$1 border=0 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333"" >","",YxBBs.BBSSetting(22)) 
  97. Set re=nothing
  98. Sign_Code=Str
  99. End Function
  101. Private Function UbbCode_Q(strText)
  102. Dim s
  103. Dim Test
  104. Dim LoopCount
  105. LoopCount=0
  106. s=strText
  107. re.Pattern="[QUOTE]"
  108. Test=re.Test(s)
  109. If Test Then
  110. re.Pattern="[/QUOTE]"
  111. Test=re.Test(s)
  112. If Test Then
  113. re.Pattern="[QUOTE]"
  114. s=re.replace(s, chr(1) & "QUOTE" & chr(2))
  115. re.Pattern="[/QUOTE]"
  116. s=re.replace(s, chr(1) & "/QUOTE" & chr(2))
  117. Do
  118. re.Pattern="x01QUOTEx02x01/QUOTEx02"
  119. s=re.Replace(s,"")
  120. re.Pattern="x01QUOTEx02(.[^x01]*)x01/QUOTEx02"
  121. s=re.Replace(s,"<table cellpadding=0 cellspacing=0 border=1 WIDTH='90%' style='border-collapse: collapse' bordercolor=#CCCCCC align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'>$1</p></td></tr></table><br>")
  122. Test=re.Test(s)
  123. LoopCount=LoopCount+1
  124. If LoopCount>MaxLoopCount Then Exit Do
  125. Loop While(Test)
  126. re.Pattern="x02"
  127. s=re.replace(s, "]")
  128. re.Pattern="x01"
  129. s=re.replace(s, "[")
  130. End If 
  131. End If
  132. UbbCode_Q=s
  133. End Function
  135. Private Function YxBBs_Ubb1(Str,uCodeL,uCodeR,tCode)
  136. Dim s
  137. s=str
  138. re.Pattern=uCodeL&uCodeR
  139. s=re.Replace(s,"")
  140. re.Pattern=uCodeL&"(.+?)"&uCodeR
  141. s=re.Replace(s,tCode)
  142. re.Pattern=uCodeL
  143. s=re.Replace(s,"")
  144. re.Pattern=uCodeR
  145. s=re.Replace(s,"")
  146. YxBBs_Ubb1=s
  147. End Function
  149. Private Function YxBBs_Ubb2(Str,uCodeL,uCodeR,tCode1,tCode2,BBSCheck)
  150. Dim s
  151. s=str
  152. re.Pattern=uCodeL&uCodeR
  153. s=re.Replace(s,"")
  154. re.Pattern=uCodeL&"(.+?)"&uCodeR
  155. If BBScheck="0" Then
  156. s=re.Replace(s,tCode1)
  157. Else
  158. s=re.Replace(s,tCode2)
  159. End If
  160. re.Pattern=uCodeL
  161. s=re.Replace(s,"")
  162. re.Pattern=uCodeR
  163. s=re.Replace(s,"")
  164. YxBBs_Ubb2=s
  165. End Function
  167. Private Function YxBBs_Ubb3(Str,uCodeL,uCodeR,tCode)
  168. Dim s
  169. s=str
  170. re.Pattern=uCodeL&uCodeR
  171. s=re.Replace(s,"")
  172. re.Pattern=uCodeL&"(.+?)"&uCodeR
  173. s=re.Replace(s,tCode)
  174. YxBBs_Ubb3=s
  175. End Function
  177. Private Function YxBBs_Code(Str,PostType)
  178. dim ary_String,i,n,n_pos
  179. ary_String=split(Str,"[code]")
  180. n=ubound(ary_String)
  181. If n<1 then
  182. YxBBs_Code=YxBBs_UBB(Str,PostType)
  183. Exit function
  184. End If
  185. ary_String(0)=YxBBs_UBB(ary_String(0),postType)
  186. for i=1 to n
  187. n_pos=inStr(ary_String(i),"[/code]")
  188. If n_pos>0 then
  189.                                    ary_String(i)="<table cellpadding=0 cellspacing=0 border=1 WIDTH='98%' style='border-collapse: collapse' bordercolor=#CCCCCC align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'><b>本贴相关代码：</b><br>" & left(ary_String(i),n_pos-1) & "</p></td></tr></table><br>" & YXBBS_UBB(right(ary_String(i),len(ary_String(i))-n_pos-6),PostType)
  190. Else
  191. ary_String(i)="[code]" & YxBBs_UBB(ary_String(i),PostType)
  192. End if
  193. next
  194. YxBBs_Code=join(ary_String,"")
  195. End Function
  197. Rem 入口（内容,开始的UBB，结束的UBB，显示允许，显示不允许，标记：1=帖子/2=留言公告，用户的信息）
  198. Rem (Str,"[grade=*([0-9]*)]","[/grade]","$1<hr noshade size=1><font color=gray>以下内容需要等级为 <b>$3</b> 或更高的等级以及作者才能浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要等级为<B>$3</B>或更高的等级以及作者才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyGrade)
  199. Private Function YxBBs_GetUBB(Str,uCodeL,uCodeR,tCode1,tCode2,postType,MyInfo)
  200. Dim Test
  201. Dim po,ii
  202. Dim LoopCount
  203. LoopCount=0
  204. Do While True
  205. re.Pattern=uCodeL
  206. Test=re.Test(Str)
  207. If Test Then
  208. re.Pattern=uCodeR
  209. Test=re.Test(Str)
  210. If Test Then
  211. If PostType=1 Then
  212. re.Pattern="(^.*)("&uCodeL&")(.+?)("&uCodeR&")(.*)"
  213. po=re.Replace(Str,"$3")
  214. If  IsNumeric(po) Then
  215. ii=int(po) 
  216. Else
  217. ii=0
  218. End If 
  219. If YxBBs.Founduser and (Lcase(YxBBs.MyName)=Lcase(UserName) or int(MyInfo)>=int(ii) or YxBBs.ClassID<=2 or YxBBs.IsBoardAdmin) Then
  220. Str=re.Replace(str,tCode1)
  221. Else
  222. Str=re.Replace(str,tCode2)
  223. End If
  224. Else
  225. re.Pattern="("&uCodeL&")(.+?)("&uCodeR&")"
  226. s=re.Replace(s,"$3")
  227. End If 
  228. Else
  229. Exit Do
  230. End If 
  231. Else
  232. Exit Do
  233. End If
  234. LoopCount=LoopCount + 1
  235. If LoopCount>MaxLoopCount Then Exit Do
  236. Loop
  237. YxBBs_GetUBB=Str
  238. End Function
  240. Private Function YxBBs_Ubb_Login(Str,PostType)
  241. Dim Test
  242. Dim LoopCount
  243. LoopCount=0
  244. Do While True
  245. re.Pattern="[login]"
  246. Test=re.Test(Str)
  247. If Test Then
  248. re.Pattern="[/login]"
  249. Test=re.Test(Str)
  250. If Test Then
  251. re.Pattern="(^.*)([login])(.+?)([/login])(.*)"
  252. If YxBBs.FoundUser Then
  253. Str=re.Replace(str,"$1<hr height=1><font color=#A2A2A2>此帖内容<b>必须登陆</b>后才能浏览</font><BR>$3</font><hr size=1>$5")
  254. Else
  255. Str=re.Replace(str,"$1<hr height=1><font color=Red>此帖内容<b>必须<a href=login.Asp>登陆</a></b>后才能浏览<BR></font><hr size=1>$5")
  256. End if
  257. Else
  258. Exit Do
  259. End If 
  260. Else
  261. Exit Do
  262. End If
  263. LoopCount=LoopCount + 1
  264. If LoopCount>MaxLoopCount Then Exit Do
  265. Loop
  266. YxBBs_Ubb_Login=Str
  267. End Function
  269. Private Function YxBBs_Ubb_Sex(Str,PostType)
  270. Dim Test
  271. Dim LoopCount
  272. Dim Tmp_Str,po
  273. LoopCount=0
  274. Do While True
  275. re.Pattern="[sex=*([0-1]*)]"
  276. Test=re.Test(Str)
  277. If Test Then
  278. re.Pattern="[/sex]"
  279. Test=re.Test(Str)
  280. If Test Then
  281. re.Pattern="(^.*)([sex=*([0-1]*)])(.+?)([/sex])(.*)"
  282. If PostType=1 Then
  283. po=re.replace(str,"$3")
  284. If isnumeric(po) then
  285. If int(po)=0 then Tmp_Str="女"
  286. If int(po)=1 then Tmp_Str="男"
  287. If Not YxBBs.FoundUser Then
  288. str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
  289. Else
  290. If (YxBBs.MySex And int(po)=1) or (Not YxBBs.MySex And int(po)=0) or Lcase(YxBBs.MyName)=Lcase(UserName) Then
  291. str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR>$4<hr size=1>$6")
  292. Else
  293. str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
  294. End If
  295. End If
  296. End if
  297. Else
  298. Str=re.Replace(str,"$4")
  299. End If
  300. Else
  301. Exit Do
  302. End If 
  303. Else
  304. Exit Do
  305. End If
  306. LoopCount=LoopCount + 1
  307. If LoopCount>MaxLoopCount Then Exit Do
  308. Loop
  309. YxBBs_Ubb_Sex=Str
  310. End Function
  312. Private Function YxBBs_Ubb_Name(Str,PostType)
  313. Dim Test
  314. Dim LoopCount
  315. Dim Tmp_My,tmp_str,I
  316. LoopCount=0
  317. Do While True
  318. re.Pattern="[username=(.[^[]*)]"
  319. Test=re.Test(Str)
  320. If Test Then
  321. re.Pattern="[/username]"
  322. Test=re.Test(Str)
  323. If Test Then
  324. re.Pattern="(^.*)([username=(.[^[]*)])(.+?)([/username])(.*)"
  325. If PostType=1 Then
  326. Tmp_Str=re.replace(str,"$3")
  327. Tmp_Str=split(Tmp_Str,",")
  328. Tmp_My=False
  329. For i=0 to ubound(Tmp_Str)
  330. If lcase(YxBBs.MyName)=lcase(Tmp_Str(i)) then Tmp_My=True:Exit For
  331. Next
  332. If Tmp_My or Lcase(YxBBs.MyName)=Lcase(UserName) Then
  333. Str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容只有作者和 <b>$3</b> 能浏览：</font><BR>$4<hr size=1>$6")
  334. Else
  335. Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和 <b>$3</b> 能浏览：</font><BR><hr size=1>$6")
  336. End if
  337. Else
  338. Str=re.Replace(str,"$4")
  339. End If
  340. Else
  341. Exit Do
  342. End If 
  343. Else
  344. Exit Do
  345. End If
  346. LoopCount=LoopCount + 1
  347. If LoopCount>MaxLoopCount Then Exit Do
  348. Loop
  349. YxBBs_Ubb_Name=Str
  350. End Function
  352. Private Function YxBBs_Ubb_Reply(Str,PostType)
  353. Dim Test
  354. Dim LoopCount
  355. LoopCount=0
  356. Do While True
  357. re.Pattern="[reply]"
  358. Test=re.Test(Str)
  359. If Test Then
  360. re.Pattern="[/reply]"
  361. Test=re.Test(Str)
  362. If Test Then
  363. re.Pattern="(^.*)([reply])((.|n)+?)([/reply])(.*)"
  364. IF PostType=1 Then
  365. If YxBBs.ClassID=1 or Not(YxBBs.execute("select BbsID From[YX_bbs"&YxBBs.TB&"] where ReplyTopicID="&ID&" and name='"&YxBBs.MyName&"'").eof) or Lcase(YxBBs.MyName)=Lcase(UserName) then
  366. str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR>$3<hr size=1>$6")
  367. Else
  368. str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR><hr size=1>$6")
  369. End if
  370. Else
  371. str=re.Replace(str,"$3")
  372. End If
  373. Else
  374. Exit Do
  375. End If 
  376. Else
  377. Exit Do
  378. End If
  379. LoopCount=LoopCount + 1
  380. If LoopCount>MaxLoopCount Then Exit Do
  381. Loop
  382. YxBBs_Ubb_Reply=Str
  383. End Function
  385. Private Function YxBBs_Ubb_Date(Str,PostType)
  386. Dim Tmp_int,Tmp_My,tmp_str
  387. Dim Test
  388. Dim LoopCount
  389. LoopCount=0
  390. Do While True
  391. re.Pattern="[date=(.[^[]*)]"
  392. Test=re.Test(Str)
  393. If Test Then
  394. re.Pattern="[/date]"
  395. Test=re.Test(Str)
  396. If Test Then
  397. re.Pattern="(^.*)([date=(.[^[]*)])(.[^[]*)([/date])(.*)"
  398. IF PostType=1 Then
  399. Tmp_Str=re.replace(str,"$3")
  400. If IsDate(Tmp_Str) Then Tmp_Int=Datediff("d",cdate(Tmp_Str),cdate(YxBBs.NowBbsTime)) Else Tmp_Int=-1
  401. If int(Tmp_Int)>0 Then
  402. Str=re.Replace(Str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR>$4<hr size=1>$6")
  403. Else
  404. Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR><hr size=1>$6")
  405. End If
  406. Else
  407. Str=re.Replace(str,"$1")
  408. End If
  409. Else
  410. Exit Do
  411. End If 
  412. Else
  413. Exit Do
  414. End If
  415. LoopCount=LoopCount + 1
  416. If LoopCount>MaxLoopCount Then Exit Do
  417. Loop
  418. YxBBs_Ubb_Date=Str
  419. End Function
  421. Private Function YxBBs_Ubb_Buy(Str,PostType)
  422. Dim Tmp_int,Tmp_My,tmp_str,i
  423. Dim Test
  424. Dim LoopCount
  425. LoopCount=0
  426. Do While True
  427. re.Pattern="[buypost=*([0-9]*)]"
  428. Test=re.Test(Str)
  429. If Test Then
  430. re.Pattern="[/buypost]"
  431. Test=re.Test(Str)
  432. If Test Then
  433. re.Pattern="(^.*)([buypost=*([0-9]*)])(.+?)([/buypost])(.*)"
  434. If PostType=1 Then
  435. If Not YxBBs.FoundUser Then
  436. Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到$3以上才可以购买并浏览</font><hr noshade size=1>$6")
  437. Else
  438. Tmp_My="<Form action='VoteSubmit.Asp?Action=buy' method='Get'><input type=hidden value="&BbsID&" name='ID'><input type=hidden value="&YxBBs.TB&" name='TB'><input type=submit  value='好黑啊…我…我买了！'></form>"
  439. Tmp_Int=re.Replace(str,"$3")
  440. If isnumeric(Tmp_Int) Then Tmp_Int=int(Tmp_Int) Else Tmp_Int=0
  441. If BBSID=0 Then
  442. Tmp_Str=""
  443. Else
  444. Tmp_Str=YxBBs.execute("select Buyer From[YX_bbs"&YxBBs.TB&"] where BbsID="&BbsID&"")(0)
  445. End If
  446. If Lcase(YxBBs.MyName)=Lcase(UserName) or YxBBs.ClassID<=2 Or YxBBs.IsBoardAdmin Then
  447. Dim PostBuyUser
  448. If (not isnull(Tmp_Str)) and Tmp_Str<>"" then
  449. Tmp_Str=split(Tmp_Str,"|")
  450. PostBuyUser=""
  451. For i=0 to ubound(Tmp_Str)
  452. PostBuyUser=PostBuyUser & "<option value="&i&">"&Tmp_Str(i)&"</option>"
  453. Next
  454. PostBuyUser="<select name=buyuser size=1><option value=0>共有"&ubound(Tmp_Str)&"位用户购买</option>"&PostBuyUser & "</select>"
  455. Else
  456. PostBuyUser="<select name=buyuser size=1><option value=0>还没有用户购买</option></select>"
  457. End if
  458. If YxBBs.MyName<>UserName Then PostBuyUser=Tmp_My&PostBuyUser
  459. Str=re.Replace(str,"$1<hr size=1><font color=Red>以下为需要金钱数达到<B>$3</B>才能浏览的内容</font>&nbsp;&nbsp;"&PostBuyUser&"<BR>$4<hr size=1>$6")
  460. Else
  461. If instr("|"&Tmp_Str&"|","|"&YxBBs.MyName&"|")>0 then
  462. Str=re.Replace(str,"$1<hr noshade size=1>以下为需要花 <del><B>$3</B></del> 金钱才能购买并浏览的内容，您已经购买本帖<BR>$4<hr noshade size=1>$6")
  463. Else
  464. If Int(YxBBs.MyCoin)>Tmp_Int then
  465. str=re.Replace(str,"$1<hr size=1><font color=Red>此帖子内容需要您花 <B>$3</B> 金钱来购买浏览&nbsp;&nbsp;"&Tmp_My&"</font><hr size=1>$6")
  466. Else
  467. str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到 <B>$3</B> 以上才可以购买并浏览</font><hr size=1>$6")
  468. end if
  469. End if
  470. End if
  471. End if
  472. Else
  473. Str=re.Replace(str,"$4")
  474. End If
  475. Else
  476. Exit Do
  477. End If 
  478. Else
  479. Exit Do
  480. End If
  481. LoopCount=LoopCount + 1
  482. If LoopCount>MaxLoopCount Then Exit Do
  483. Loop
  484. YxBBs_Ubb_Buy=Str
  485. End Function
  486. End Class
  487. </script>