www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\postask.asp

    <!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/ubbcode.asp"-->
<!--#include file="inc/cls_keyword.asp"-->
<%
'TotalUseTable,NowUsePosts,NowUseTable
Dim Tempstring
Dim HtmlContent,XMLDom
Dim Action,AskTopic,searchmode,Keyword,islock
Dim UserPoints,AnonymPoints,BroadPoints
UserPoints = NewAsp.CheckNumeric(NewAsp.UserPoint)
AnonymPoints = NewAsp.CheckNumeric(NewAsp.Point_Setting(18))
BroadPoints = NewAsp.CheckNumeric(NewAsp.Point_Setting(19))
searchmode = 0 : islock = 0

Action = NewAsp.CheckBadstr(Request("action"))
AskTopic = Trim(Request("q"))
If Len(AskTopic) < 2 Then AskTopic = Trim(Request("word"))
If Len(AskTopic) < 2 Then AskTopic = ""
If AskTopic = "请输入关键字" Then AskTopic = ""
Keyword = Trim(AskTopic)

Select Case LCase(Action)
	Case "save"
		Call saveQuestion()
	Case Else
		Call showmain()
End Select

NewAsp.CloseConn()

Function BytesToBstr(ByVal body)
	On Error Resume Next
	Dim ObjStream
	Set ObjStream = CreateObject("ADODB.Stream")
	With ObjStream
		.type = 1
		.mode = 3
		.Open
		.Write body
		.Position = 0
		.type = 2
		.CharSet = "GB2312"
		BytesToBstr = .ReadText
		.Close
	End With
	Set ObjStream = Nothing
	If Err.Number <> 0 Then Err.Clear
End Function

Sub showmain()
	Dim FindSolved,SolvedQuestion
	If NewAsp.Posts_Setting(0) = "0" Then
		Response.Write "<script>alert('友情提示!\n\n本问吧暂时禁止提问!');history.go(-1);</script>"
		Exit Sub
	End If
	HtmlContent = NewAsp.LoadTemplate("postask")
	HtmlContent = Replace(HtmlContent, "{$IndexMenulist}", NewAsp.IndexMenulist)
	HtmlContent = Replace(HtmlContent, "{$HeadTitle}", "提问中")
	HtmlContent = Replace(HtmlContent, "{$AskTopic}", Server.HTMLEncode(AskTopic))
	HtmlContent = Replace(HtmlContent, "{$FindSolved}", FindSolved)
	HtmlContent = Replace(HtmlContent, "{$SolvedQuestion}", SolvedQuestion)
	HtmlContent = Replace(HtmlContent, "{$UserPoints}", UserPoints)
	HtmlContent = Replace(HtmlContent, "{$AnonymPoints}", AnonymPoints)
	HtmlContent = Replace(HtmlContent, "{$BroadPoints}", BroadPoints)
	HtmlContent = Replace(HtmlContent, "{$UserID}", NewAsp.UserID)
	HtmlContent = Replace(HtmlContent, "{$ClassID}", 0)
	Response.Write NewAsp.ArchiveHtml(HtmlContent)
End Sub

Sub saveQuestion()
	Dim Rs,SQL
	Dim AskTopic,classid,AskContent,RewardPoints,Anonymous,Broadcast,UserNowPoint,NeedPoint
	Dim TopicID,classname,parentid,parentstr,TextLength,TitleLength
	'--检测是否代理服务器提交
	NewAsp.ChcekProxy(NewAsp.Asked_Setting(21))
	AskTopic = NewAsp.RequestForm("topic",220)
	classid = NewAsp.ChkNumeric(Request.Form("classid"))
	RewardPoints = NewAsp.ChkNumeric(Request.Form("points"))
	Anonymous = NewAsp.ChkNumeric(Request.Form("anonym"))
	Broadcast = NewAsp.ChkNumeric(Request.Form("broadcast"))
	AskContent = Request.Form("askcontent")
	AskContent = UBB2Html(AskContent)
	TitleLength = NewAsp.strLength(AskTopic)
	TextLength = NewAsp.strLength(AskContent)
	If NewAsp.Posts_Setting(0) = "0" Then
		Response.Write "<script>alert('友情提示!\n\n本问吧暂时禁止提问!');</script>"
		Exit Sub
	End If
	If TitleLength < CLng(NewAsp.Posts_Setting(10)) Or AskTopic = "" Then
		Response.Write "<script>alert('友情提示!\n\n问题标题不能小于 " & NewAsp.Posts_Setting(10) & " 个字节或为空!');</script>"
		Exit Sub
	End If
	If TitleLength > CLng(NewAsp.Posts_Setting(11)) Then
		Response.Write "<script>alert('友情提示!\n\n问题标题不能大于 " & NewAsp.Posts_Setting(11) & " 个字节!');</script>"
		Exit Sub
	End If
	If TextLength < CLng(NewAsp.Posts_Setting(12)) Then
		Response.Write "<script>alert('友情提示!\n\n问题描述不能小于 " & NewAsp.Posts_Setting(12) & " 个字节!');</script>"
		Exit Sub
	End If
	If TextLength > CLng(NewAsp.Posts_Setting(13)) Then
		Response.Write "<script>alert('友情提示!\n\n问题描述不能大于 " & NewAsp.Posts_Setting(13) & " 个字节!');</script>"
		Exit Sub
	End If
	If classid = 0 Then
		Response.Write "<script>alert('友情提示!\n\n请选择正确的问题分类!');</script>"
		Exit Sub
	End If
	If NewAsp.ChkRefresh Then
		Response.Write "<script>alert('友情提示!\n\n本页面起用了防刷新机制,请不要连续刷新本页面!');</script>"
		Exit Sub
	End If
	Set Rs = Newasp.Execute("SELECT classid,classname,parentid,parentstr FROM NC_Ask_Class WHERE classid="&classid)
	If Rs.BOF And Rs.EOF Then
		Response.Write "<script>alert('友情提示!\n\n找不到分类,请正确选择您的问题分类!');</script>"
		Exit Sub
	Else
		classname = Rs(1)
		parentid = Rs(2)
		parentstr = Rs(3)
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Newasp.Execute("SELECT TopicID FROM NC_Ask_Topic WHERE userid="&NewAsp.UserID&" And title='"&NewAsp.Checkstr(AskTopic)&"'")
	If Not (Rs.BOF And Rs.EOF) Then
		Response.Write "<script>alert('友情提示!\n\n问题已经提交过.请不要重复提交问题!');</script>"
		Exit Sub
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Newasp.Execute("SELECT userid,Username,Password,Points FROM NC_Ask_Users WHERE userid="& NewAsp.UserID &" And Userlock=0")
	If Rs.BOF And Rs.EOF Then
		Set Rs = Nothing
		Response.Write "<script>alert('亲爱的用户:\n\n您还没有登录,请先登录后再提交问题!');</script>"
		Exit Sub
	Else
		If Rs(1) <> NewAsp.UserName Or Rs(2) <> NewAsp.PassWord Then
			Response.Write "<script>alert('亲爱的用户:\n\n您的用户名或密码不正确,请重新登录后再提交问题!');</script>"
			Exit Sub
		End If
		UserNowPoint = Rs("Points")
	End If
	Set Rs = Nothing
	NeedPoint = 0
	If RewardPoints > 0 Then
		NeedPoint = RewardPoints
		If RewardPoints > UserNowPoint Then
			Response.Write "<script>alert('亲爱的用户:\n\n您的积分不够,不能设置悬赏分!');</script>"
			Exit Sub
		End If
	End If
	If Anonymous > 0 Then
		NeedPoint = NeedPoint + AnonymPoints
		If NeedPoint > UserNowPoint Then
			Response.Write "<script>alert('亲爱的用户:\n\n您的积分不够,不能设置匿名问题!\n\n设置匿名问题需要 " & AnonymPoints & "分');</script>"
			Exit Sub
		End If
	End If
	If Broadcast > 0 Then
		NeedPoint = NeedPoint + BroadPoints
		If NeedPoint > UserNowPoint Then
			Response.Write "<script>alert('亲爱的用户:\n\n您的积分不够,不能设置站内广播问题!\n\n设置广播问题需要 " & BroadPoints & "分');</script>"
			Exit Sub
		End If
	End If
	If NewAsp.ChkBadword(AskContent) Then
		islock=0
	Else
		islock=1
	End If
	UserNowPoint = UserNowPoint - NeedPoint
	UserNowPoint = UserNowPoint + NewAsp.ChkNumeric(NewAsp.Point_Setting(4))
	'主题模式(TopicMode: 0=待解决的问题,1=已解决的问题,2=投票中的问题,3=用户分享主题,4=过期问题)
	'帖子模式(PostsMode: 0=问,1=回) expiration
	Set Rs = NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT * FROM NC_Ask_Topic WHERE (TopicID is null)"
	Rs.Open SQL,Conn,1,3
	Rs.Addnew
		Rs("classid") = classid
		Rs("userid") = NewAsp.UserID
		Rs("classname") = classname
		Rs("title") = AskTopic
		Rs("PostUsername") = NewAsp.UserName
		Rs("Expired") = 0
		Rs("Closed") = 0
		Rs("PostTable") = NewAsp.NowUseTable
		Rs("DateAndTime") = Now()
		Rs("LastPostTime") = Now()
		Rs("ExpiredTime") = Now()+NewAsp.ExpiredDays
		Rs("LockTopic") = islock
		Rs("Reward") = RewardPoints
		Rs("Hits") = 0
		Rs("PostNum") = 0
		Rs("CommentNum") = 0
		Rs("TopicMode") = 0
		Rs("AskedMode") = 0
		Rs("Highlight") = 0
		Rs("Broadcast") = Broadcast
		Rs("Anonymous") = Anonymous
		Rs("IsTop") = 0
		Rs("supplement") = 0
	Rs.Update
	Rs.Close:Set Rs = Nothing
	Set Rs=NewAsp.Execute("SELECT TOP 1 TopicID FROM [NC_Ask_Topic] ORDER BY TopicID DESC")
		TopicID = Rs(0)
	Rs.Close
	Set Rs = Nothing
	Set Rs = NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT * FROM " & NewAsp.NowUseTable & " WHERE (postsid is null)"
	Rs.Open SQL,Conn,1,3
	Rs.Addnew
		Rs("classid") = classid
		Rs("TopicID") = TopicID
		Rs("userid") = NewAsp.UserID
		Rs("UserName") = NewAsp.UserName
		Rs("topic") = AskTopic
		Rs("content") = AskContent
		Rs("addText") = ""
		Rs("PostTime") = Now()
		Rs("DoneTime") = Now()
		Rs("length") = TextLength
		Rs("star") = 0
		Rs("satis") = 0
		Rs("LockTopic") = islock
		Rs("PostsMode") = 0
		Rs("VoteNum") = 0
		Rs("Plus") = 0
		Rs("Minus") = 0
		Rs("UserIDlist") = ""
		Rs("PostIP") = NewAsp.UserTrueIP
		Rs("Report") = 0
	Rs.Update
	Rs.Close:Set Rs = Nothing
	NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=" & UserNowPoint & ",Experience=Experience+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(5)) & ",RewardPoint=RewardPoint+" & RewardPoints & ",Asktotal=Asktotal+1,Askpend=Askpend+1 WHERE userid="& NewAsp.UserID)
	Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxPendNum=MaxPendNum+1")
	Newasp.Execute ("UPDATE NC_Ask_Class SET AskPendNum=AskPendNum+1 WHERE classid="& classid)
	NewAsp.ReloadSetupCache Clng(NewAsp.MaxPendNum)+1,7
	Dim strReturnURL,Direct
	Direct = NewAsp.ChkNumeric(Request.Form("direct"))
	strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "showlist.asp?classid=" & classid & "")
	Response.Write "<script language=""JavaScript"">"
	If Direct = 0 Then Response.Write "alert('恭喜您!问题提交成功');"
	Response.Write "try{top.location='" & strReturnURL & "';"
	Response.Write "}catch(e){}"
	Response.Write "</script>"
End Sub

%>