<% set my_conn= Server.CreateObject("ADODB.Connection") set rs = server.CreateObject("ADODB.RecordSet") function doCode(str, oTag, cTag, roTag, rcTag) tx = split(str, cTag) t = "" for i = 0 to ubound(tx) if lcase(oTag) = "[a]" then p = instr(1, tx(i), "[a]", 1) if p <> 0 then tmp = mid(tx(i), p) url = mid(tmp, 4) if lcase(left(url, 5)) = "http:" then tmp1 = Replace(tmp, "[a]"&url, "Link", 1, -1, 1) else tmp1 = Replace(tmp, "[a]"&url, "Link" , 1, -1, 1) end if t =t & Replace(tx(i), tmp, tmp1) else t = t & tx(i) end if else cnt = instr(1,tx(i), oTag,1) select case cnt case 0 t=t&tx(i) & " " case else t = t & Replace(tx(i), oTag, roTag,1,1,1) t = t & " " & rcTag & " " end select end if next doCode = t end function Function Smile(string) String = replace(String, "[:)]", "") String = replace(String, "[:P]", "") String = replace(String, "[:(]", "") String = replace(String, "[;)]", "") Smile = String End function Sub DoCookies ' ### Sets cookies for the post form if asked for Response.Cookies("User")("Name")= Request.Form("UserName") Response.Cookies("User")("Pword")= Request.Form("Password") Response.Cookies("User")("sig")= Request.Form("sig") Response.Cookies("User")("cookies")= Request.Form("cookies") Response.Cookies("User").Expires= dateAdd("d", 30, now) End Sub Sub ClearCookies ' ### Sets cookies for the post form if asked for Response.Cookies("User") ="" Response.Cookies("User").Expires= dateadd("d", -2, now) End Sub Sub DoCount ' ### Updates the totals Table strSQl ="Update totals set totals.P_Count=totals.P_Count + 1" my_conn.Execute (strSQL) End Sub Sub UpdateUCount(user_name) ' ### Update Total Post for user StrSQL = "Update members set members.M_Posts=members.M_Posts + 1 where M_name = '" & user_name & "'" my_conn.Execute (StrSQL) End sub Sub DoEmail(email, user_name) ' ### Emails Topic Author if Requested. ' ### This needs to be edited to use your own email component ' ### if you don't have one, try the w3Jmail component from www.dimac.net it's free! Set Mailer = Server.CreateObject("SMTPsvg.Mailer") Mailer.RemoteHost = "" & mailsrv & "" Mailer.AddRecipient "","" & email & "" Mailer.FromName = "Forum" & nomesrv & "" Mailer.FromAddress = "" & emailsrv & "" Subject = "" & nomesrv & " Fórum - Resposta à sua mensagem" msg = "Olá " & user_name & vbcrlf & vbcrlf msg = msg & "Tem uma resposta à mensagem que colocou no fórum " & nomesrv & " ." msg = msg & "Relativa ao tema - " & Request.Form("topic_title") & "." & vbcrlf & vbcrlf msg = msg & "Pode ver essa mensagem em " & Request.Form("refer") & vbcrlf Mailer.BodyText = msg if Mailer.SendMail then Response.Write " " else Response.Write "Ocorreu um erro, contacte " & emailsrv & ". O erro foi "& Mailer.Response end if End Sub Function ChkString(str) if str = "" then str = " " Else if BadWordFiler = "true" then bwords = split(BadWords, "|") for i = 0 to ubound(bwords) str= replace(str, bwords(i), string(len(bwords(i)),"*"), 1,-1,1) next End if End If ' Do ASP Forum Code str = doCode(str, "[b]", "[/b]", "", "") str = doCode(str, "[i]", "[/i]", "", "") str = doCode(str, "[quote]", "[/quote]", "
quote:
", "
") str = doCode(str, "[a]", "[/a]", "", "") str = doCode(str, "[code]", "[/code]", "
", "
") if smiles = "true" then str= smile(str) str = Replace(str, "'", "''") str = Replace(str, "|", "/") ChkString = str End Function my_Conn.Open ConnString err_msg ="" ok="" Function ForumModerator(Forum_ID, M_Name) strSQL = "SELECT Members.M_Name, Forum.Forum_ID FROM Members INNER JOIN " & _ " Forum ON Members.Member_id = Forum.F_Moderator WHERE Forum.Forum_ID = " & cint(Forum_ID) & _ " and Members.M_Name = '" & M_Name & "'" set rsChk = my_conn.Execute (strSQL) if rsChk.bof or rsChk.eof then ForumModerator = "False" Else ForumModerator = "true" End if rsChk.close set rsChk = nothing End function ' This functio will return the permissions of the user or 0 if not a registered user! ' 0 = No User, 1=Author of post, 2=Normal User, 3=Moderator, 4=Admin Function ChkUser(strName, StrPasswd) strSql ="SELECT Member_id, M_level, M_Name, M_Password from Members where M_Name = '" & strName & "' and M_Password = '" & StrPasswd &"'" 'Response.Write StrSql set rs_chk = my_conn.Execute (StrSql) if rs_chk.BOF or rs_chk.EOF then '# Invalid Password ChkUser = 0 Else if cint(rs_chk("Member_ID"))= cint(Request.Form("Author")) then ChkUser = 1 ' Author Else Select case cint(rs_chk("M_Level")) case 1 ChkUser = 2' Normal User case 2 ChkUser = 3' Moderator case 2 ChkUser = 4' Admin case else ChkUser = cint(rs_chk("M_Level")) End Select End If End if rs_chk.close set rs_chk = nothing End Function Function GetSig(User_Name) strSQL = "Select M_Sig from members where M_Name = '" & Request.Form("UserName") & "'" set rsSig = my_conn.Execute (strSQL) GetSig = rsSig("M_Sig") rsSig.close set rsSig = nothing End Function Sub GO_Result(str_err_msg, boolOk) %> <% if boolOk = true then DoCount UpdateUCount Request.Form("username") %>

Mensagem colocada!

Obrigado pela sua colaboração

">Voltar ao fórum

Nota:

<%= str_err_msg %>

Use o botão "Back" ou "Retroceder".
<% Response.End Else %> <% Response.End End If End Sub if Request.Form("cookies") = "yes" then DoCookies Else ClearCookies End if if Request.Form("method_type") = "edit" then member = cint(ChkUser(Request.Form("username"), Request.Form("password"))) Select Case Member case 0 ' Invalid Pword GO_Result "Invalid Password or UserName", false Response.End case 1 ' Author of Post so OK case 2 ' Normal User - Not Authorised GO_Result "Só o Administrador, Moderador ou o Autor podem mudar esta mensagem", false Response.End case 3 ' Moderator so OK ' heck the moderator of this forum if ForumModerator(Request.Form("Forum_id"), Request.Form("username")) = "False" then GO_Result "Só o Administrador, Moderador ou o Autor podem mudar esta mensagem", false end if case 4 ' Admin so OK case Else GO_Result cstr(Member), false Response.End End Select '# Do DB Update txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& Request.Form("UserName") & " on " & now() strSql = "update reply set R_Message = '" & chkString(server.htmlencode(txtMessage)) & "' where Reply_ID=" & Request.Form("reply_id") my_conn.Execute (StrSql) '# Update Last Post strSql = "update forum set F_Last_Post = #" & now() & "# where Forum_ID = " & Request.Form("forum_id") my_conn.Execute (StrSql) err_msg= "" if Err.description <> "" then GO_Result "Ocorreu um erro = " & Err.description, false Response.End Else Go_Result "Actualização com sucesso", true End If strSql = "update topics set T_Last_Post = #" & now() & "# where Topic_ID = " & Request.Form("topic_id") my_conn.Execute (StrSql) err_msg= "" if Err.description <> "" then GO_Result "Ocorreu um erro = " & Err.description, false Response.End Else Go_Result "Actualização com sucesso", true Response.End End If End if '#### if Request.Form("method_type") = "editTopic" then member = cint(ChkUser(Request.Form("username"), Request.Form("password"))) Select Case Member case 0 ' Invalid Pword GO_Result "Password ou Username inválido", false Response.End case 1 ' Author of Post so OK case 2 ' Normal User - Not Authorised GO_Result "Só o Administrador, Moderador ou o Autor podem mudar esta mensagem", false Response.End case 3 ' Moderator so if ForumModerator(Request.Form("Forum_id"), Request.Form("username")) = "False" then GO_Result "Só o Administrador, Moderador ou o Autor podem mudar esta mensagem", false end if case 4 ' Admin so OK case Else GO_Result cstr(Member), false Response.End End Select '# Do DB Update txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& Request.Form("UserName") & " on " & now() strSql = "update Topics set T_Message = '" & chkString(server.htmlencode(txtMessage)) & "' where Topic_ID=" & Request.Form("reply_id") my_conn.Execute (StrSql) err_msg= "" if Err.description <> "" then GO_Result "Ocorreu um erro = " & Err.description, false Response.End Else Go_Result "Actualização com sucesso", true End If End if ' ##### if lcase(Request.Form("method_type")) = "topic" then strSql ="SELECT Member_id, M_level,M_Email, M_Name, M_Password from Members where M_Name = '" & Request.Form("UserName") & "' and M_Password = '" & Request.Form("Password") &"'" set rs = my_conn.Execute (StrSql) if rs.BOF or rs.EOF then '# Invalid Password GO_Result "UserName ou Password inválida", false Response.End Else if Request.Form("Message") = "" then GO_Result "Tem que colocar uma mensagem!", false Response.End End if if Request.Form("TopicSubject") = "" then GO_Result "Tem que colocar um assunto (Tema)!", false Response.End End if Strmsg = chkString(server.htmlencode(Request.Form("Message"))) if Request.Form("sig") = "yes" then strmsg = strmsg & vbcrlf & vbcrlf & GetSig(Request.Form("UserName")) End if if Request.Form("rmail") <> "true" then TF = "False" Else TF = "true" End if strSql = "insert into topics (forum_id, T_Subject, T_Message, T_Originator, T_Mail) Values (" strSql = StrSql & Request.Form("forum_id") & ", '" strSql = StrSql & trim(chkString(server.htmlencode(Request.Form("TopicSubject")))) & "', '" strSql = StrSql & Strmsg & "', " strSql = StrSql & rs("Member_ID") & ", " strSql = StrSql & TF & ")" my_conn.Execute (StrSql) if Err.description <> "" then err_msg = "Ocorreu um erro = " & Err.description Else err_msg = "Actualização com sucesso" End IF '# Update Last Post and count strSql = "update forum set F_Last_Post = #" & now() & "#, F_Count = F_Count +1 where Forum_ID = " & Request.Form("forum_id") my_conn.Execute (StrSql) GO_Result err_msg, true Response.End End If End if if Request.Form("method_type") = "reply" then strSql ="SELECT Member_id, M_level, M_Name, M_Email, M_Password from Members where M_Name = '" & Request.Form("UserName") & "' and M_Password = '" & Request.Form("Password") &"'" set rs = my_conn.Execute (StrSql) if rs.BOF or rs.EOF then '# Invalid Password err_msg = "Password ou User Name inválidos" GO_Result(err_msg), false Response.End Else if Request.Form("Message") = "" then GO_Result "Tem que colocar uma mensagem!", false Response.End End if Strmsg = chkString(server.htmlencode(Request.Form("Message"))) if Request.Form("sig") = "yes" then strmsg = strmsg & vbcrlf & vbcrlf & GetSig(Request.Form("UserName")) End if strSql = "insert into reply (topic_id, r_posted_by, r_message) Values (" strSql = StrSql & Request.Form("topic_id") & ", " strSql = StrSql & rs("Member_ID") & ", '" strSql = StrSql & Strmsg & "')" my_conn.Execute (StrSql) '# Update Last Post and count strSql = "update topics set T_Last_Post = #" & now() & "#, T_Replies = T_Replies +1 where Topic_ID = " & Request.Form("topic_id") my_conn.Execute (StrSql) strSql = "update forum set F_Last_Post = #" & now() & "#, F_Count = F_Count +1 where Forum_ID = " & Request.Form("forum_id") my_conn.Execute (StrSql) if Err.description <> "" then GO_Result "There was an error = " & Err.description, false Response.End Else if lcase(Request.Form("M")) = "true" then strSQL = " SELECT Members.M_Name, Members.M_Email FROM Members INNER JOIN " & _ " Topics ON Members.Member_id = Topics.T_Originator WHERE Topics.Topic_ID= " & Request.Form("topic_ID") set rs2 = my_conn.Execute (strSQL) DoEmail rs2("M_Email"), rs2("M_Name") rs2.close set rs2 = nothing End if GO_Result "Updated OK", True Response.End End if End if end if my_conn.Close set my_conn = nothing set rs = nothing %>