%@ Language=VBScript %>
<%
'Script para envio de e-mail em formulário
Dim vErro,vSucesso,vErr
vErro = ""
vSucesso = "obrigado.html"
vErr = "erro.html"
if Request.Form.Count + Request.QueryString.Count > 0 then
Call Respform
Call Resp
end if
'-----------------------------------------------------------
Sub Respform()
On Error Resume Next
Dim msg,vData,vHora,vPara,vNomeform,vFrom,vAssunto,vCc,vDom
vNomeForm = "cadastro"
vPara = "acgsilva.iplan@pcrj.rj.gov.br"
vFrom = "lasts@ig.com.br"
vCc = "lasts@ig.com.br"
vAssunto = "CADASTRO"
vData = Date()
vData = day(vData) & "/" & month(vData) & "/" & year(vData)
vHora = Time()
vHora = hour(vHora) & "h" & minute(vHora) & "min" & second(vHora) & "s"
msg = "Formulário " & vNomeForm
msg = msg & " submetido em " & vData & " às " & vHora & VbCrLf & VbCrLf
if Request.ServerVariables("REQUEST_METHOD") = "POST" then
for each campo in Request.Form
if campo <> "B1" and campo <> "B2" and campo <> "B3" and campo <> "B4" then
msg = msg & string(60,"-") & vbcrlf
msg = msg & campo & " : " & Request.Form(campo) & VbCrLf
end if
next
else
for each campo in Request.QueryString
if campo <> "B1" and campo <> "B2" and campo <> "B3" and campo <> "B4" then
msg = msg & string(60,"-") & vbcrlf
msg = msg & campo & " : " & Request.QueryString(campo) & VbCrLf
end if
next
end if
msg = msg & string(60,"*") & vbcrlf
EnviaEmail msg,vFrom,vPara,vCc,vAssunto
If Err then
vErro = Err.number & " : "
vErro = Err.description
Err.Clear
End if
End Sub
'-----------------------------------------------------------
Function EnviaEmail(ByVal p_body, Byval p_from, ByVal p_to, ByVal p_cc, Byval p_subject)
On Error Resume Next
Dim iMsg, Flds, iConf, status
Const SERVIDOR_SMTP = "sharedrelay.dominal.com"
status = true
Set iMsg = Server.CreateObject("CDO.Message")
Set iConf = Server.CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Flds("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SERVIDOR_SMTP
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Flds.Update
With iMsg
Set .Configuration = iConf
.To = p_to
.CC = p_cc
.From = p_from
.Sender = p_from
.Subject = p_subject
.TextBody = p_body
.Send
End With
If Err.number <> 0 Then
status = false
End If
If IsObject(iMsg) Then Set iMsg = Nothing
If IsObject(Flds) Then Set Flds = Nothing
If IsObject(iConf) Then Set iConf = Nothing
EnviaEmail = status
End Function
'-----------------------------------------------------------
Sub Resp()
if vErro = "" then
Response.Redirect(vSucesso)
else
Response.Redirect(vErr)
end if
End Sub
%>
COLEGIADO NACIONAL DE GESTORES MUNICIPAIS DA ASSISTÊNCIA SOCIAL