<%
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 = "
"
'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, "[;(]", "")
String= replace(String, "[:P]", "")
String= replace(String, "[:(]", "")
String= replace(String, "[:)2]", "")
String= replace(String, "[:)3]", "")
String= replace(String, "[:)4]", "")
String= replace(String, "[:)5]", "")
String= replace(String, "[:)6]", "")
String= replace(String, "[:)7]", "")
String= replace(String, "[:)8]", "")
String= replace(String, "[:)9]", "")
String= replace(String, "[:)10]", "")
String= replace(String, "[:)11]", "")
String= replace(String, "[:)12]", "")
String= replace(String, "[:)13]", "")
String= replace(String, "[:)14]", "")
String= replace(String, "[:)15]", "")
String= replace(String, "[:)16]", "")
String= replace(String, "[:)17]", "")
String= replace(String, "[:)18]", "")
String= replace(String, "[:)19]", "")
String= replace(String, "[:)20]", "")
String= replace(String, "[:)21]", "")
String= replace(String, "[:)22]", "")
String= replace(String, "[:)23]", "")
String= replace(String, "[:)24]", "")
String= replace(String, "[:)25]", "")
String= replace(String, "[:)26]", "")
String= replace(String, "[:)27]", "")
String= replace(String, "[:)28]", "")
String= replace(String, "[:)29]", "")
String= replace(String, "[:)30]", "")
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 = "supermarket[www.i2off.org]::respuesta a su mensaje"
msg = "//:hola " & user_name & vbcrlf & vbcrlf & " "
msg = msg & "su producto en supermarket[www.i2off.org] esta ampliandose "
msg = msg & "se encuentra en la gondola - " & Request.Form("topic_title") & "." & vbcrlf & vbcrlf & " "
msg = msg & "puede verlo en " & " " & "" & Request.Form("refer") & "" & vbcrlf & " " & " "
msg = msg & "ivan ivanoff" & " "
msg = msg & "flash avatar" & " "
msg = msg & "rector de superMarket" & " "
msg = msg & "http://www.i2off.org" & " "
msg = msg & "http://www.i2off.org/superMarket" & " "
msg = msg & " ++ la comunidad para que desarrolles" & " "
msg = msg & " ++ tus proyectos experimentales" & " "
msg = msg & " "
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]", "
")
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
%>