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 %>