<% 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, "" & url & "", 1, -1, 1) else tmp1 = Replace(tmp, "[a]"&url, "" & url & "" , 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 buscaSWF(str) p =instr(1, str, "[swf]", 1) 'busca si esta el tag de swf f =instr(1, str, "[/swf]", 1) 'marca el final poffset = p + 5 'para que comienze bien la busqueda (despues que termina el tag foffset = f - 1 nombre = "" ancho = "275" alto = "200" fondo = "ffffff" colTemp = "" estado = 1 marca1= 0 marca2= 0 marca3= 0 for i = poffset to foffset test = mid(str, i, 1) if test = ":" then if mid(str, i , 3) = "://" then 'o sea que son los 2 puntos de un http://www etc else Select case estado case 1 marca1 = i estado = 2 case 2 marca2 = i estado = 3 case 3 marca3 = i estado = 4 end Select end if end if next if marca1 > 0 then nombre = mid(str, poffset, marca1 - poffset) end if if marca2 > 0 then ancho = int(mid(str, marca1 + 1, marca2 - marca1 - 1)) end if if marca3 > 0 then alto = int(mid(str, marca2 + 1, marca3 - marca2 - 1)) colTemp = mid(str, marca3 + 1, foffset - marca3) end if if colTemp <> "" then fondo = colTemp end if if ancho > 700 then ancho = 700 end if if alto > 500 then alto = 500 end if objeto = "
" objeto = objeto & " " objeto = objeto & "
" 'response.write (str & " -- ") 'response.write (f - p) if p > 0 then borrar = mid(str, p, f - p + 6) 'response.write (str) str = replace(str, borrar, objeto, 1, -1, 1) end if buscaSWF = str 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 if Request.Form("anonim") = "yes" then Response.Cookies("User")("Name")= "anonimo" Response.Cookies("User")("Pword")= "anonimo" else Response.Cookies("User")("Name")= Request.Form("UserName") Response.Cookies("User")("Pword")= Request.Form("Password") end if Response.Cookies("User")("Anonim")= Request.Form("anonim") 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! Dim objCDO Set objCDO = Server.CreateObject("CDONTS.NewMail") objCDO.To = email objCDO.From = ForoMail objCDO.Subject = "Foro Origenes[Base de Conocimiento]::respuesta a su mensaje" msg = "Hola " & user_name & vbcrlf & vbcrlf msg = msg & "Su pregunta en el Foro Origenes[Base de Conocimiento] a recivido una respuesta." msg = msg & "Acerca del topico - " & Request.Form("topic_title") & "." & vbcrlf & vbcrlf msg = msg & "Usted puede verla en " & Request.Form("refer") & vbcrlf objCDO.BodyFormat = 0 objCDO.MailFormat = 0 objCDO.Body = msg on error resume next ' Ignore Errors objCDO.Send set objCDO = nothing 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, "[img]", "[/img]", "") str = doCode(str, "[i]", "[/i]", "", "") str = doCode(str, "[quote]", "[/quote]", "
cita:
", "
") str = doCode(str, "[a]", "[/a]", "", "") str = doCode(str, "[code]", "[/code]", "
", "
") str = buscaSWF(str) if smiles = "true" then str= smile(str) str = Replace(str, "'", "''") str = Replace(str, "|", "/") ChkString = str End Function ' response.write(Request.Form("Message")) 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) if Request.Form("anonim") = "yes" then strSQL = "Select M_Sig from members where M_Name = '" & "anonimo" & "'" else strSQL = "Select M_Sig from members where M_Name = '" & Request.Form("UserName") & "'" end if 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 if Request.Form("anonim") = "yes" then UpdateUCount "anonimo" else UpdateUCount Request.Form("username") end if %>

Mensaje Enviado!

Gracias por su contribucion

">Volver al Foro
<% Response.End Else %>

Hubo un problema :-

<%= str_err_msg %>

Vuelva atras para corregir el problema.
<% Response.End End If End Sub if Request.Form("cookies") = "yes" then DoCookies Else ClearCookies End if if Request.Form("method_type") = "edit" then if Request.Form("anonim") = "yes" then member = 2 else member = cint(ChkUser(Request.Form("username"), Request.Form("password"))) end if 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 "Solo el administrador, moderador o usario registrado que crea el mensaje puede editarlo", 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 "Solo el administrador, moderador o usario registrado que crea el mensaje puede editarlo", false end if case 4 ' Admin so OK case Else GO_Result cstr(Member), false Response.End End Select '# Do DB Update if Request.Form("anonim") = "yes" then txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& "anonimo" & " on " & now() else txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& Request.Form("UserName") & " on " & now() end if 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 "Este fue el error = " & Err.description, false Response.End Else Go_Result "Updated OK", 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 "Este fue el error = " & Err.description, false Response.End Else Go_Result "Updated OK", true Response.End End If End if '#### if Request.Form("method_type") = "editTopic" then if Request.Form("anonim") = "yes" then member = 2 else member = cint(ChkUser(Request.Form("username"), Request.Form("password"))) end if 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 "Only Admins, Moderators and the Author can change this post", false Response.End case 3 ' Moderator so if ForumModerator(Request.Form("Forum_id"), Request.Form("username")) = "False" then GO_Result "Only Admins, Moderators and the Author can change this post", false end if case 4 ' Admin so OK case Else GO_Result cstr(Member), false Response.End End Select '# Do DB Update if Request.Form("anonim") = "yes" then txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& "anonimo" & " on " & now() else txtMessage = Request.Form("Message") & vbcrlf & vbcrlf & "Edited by - "& Request.Form("UserName") & " on " & now() end if 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 "There was an error = " & Err.description, false Response.End Else Go_Result "Updated OK", true End If End if ' ##### if lcase(Request.Form("method_type")) = "topic" then if Request.Form("anonim") = "yes" then strSql ="SELECT Member_id, M_level,M_Email, M_Name, M_Password from Members where M_Name = '" & "anonimo" & "' and M_Password = '" & "anonimo" &"'" else 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") &"'" end if set rs = my_conn.Execute (StrSql) if rs.BOF or rs.EOF then '# Invalid Password GO_Result "Invalid UserName or Password", false Response.End Else if Request.Form("Message") = "" then GO_Result "You must post a message!", false Response.End End if if Request.Form("TopicSubject") = "" then GO_Result "You must post a subject!", false Response.End End if Strmsg = chkString(server.htmlencode(Request.Form("Message"))) if Request.Form("sig") = "yes" then if Request.Form("anonim") = "yes" then strmsg = strmsg & vbcrlf & vbcrlf & GetSig("anonimo") else strmsg = strmsg & vbcrlf & vbcrlf & GetSig(Request.Form("UserName")) end if 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 = "There was an error = " & Err.description Else err_msg = "Updated OK" 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 if Request.Form("anonim") = "yes" then strSql ="SELECT Member_id, M_level, M_Name, M_Email, M_Password from Members where M_Name = '" & "anonimo" & "' and M_Password = '" & "anonimo" &"'" else 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") &"'" end if set rs = my_conn.Execute (StrSql) if rs.BOF or rs.EOF then '# Invalid Password err_msg = "Invalid Password or User Name" GO_Result(err_msg), false Response.End Else if Request.Form("Message") = "" then GO_Result "You must post a message!", false Response.End End if Strmsg = chkString(server.htmlencode(Request.Form("Message"))) if Request.Form("sig") = "yes" then if Request.Form("anonim") = "yes" then strmsg = strmsg & vbcrlf & vbcrlf & GetSig("anonimo") else strmsg = strmsg & vbcrlf & vbcrlf & GetSig(Request.Form("UserName")) end if 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 %>