[Tópico Único] - Funções úteis

[Marcos Guedes]

Função que tira todos os acentos das palavras

Código:

function TiraAcento(StrAcento)

 for i = 1 to len(StrAcento)

  Letra = mid(StrAcento, i, 1)

  Select Case Letra

  Case "á","Á","à","À","ã","Ã","â","Â","â","ä","Ä"

  Letra = "A"

  Case "é","É","ê","Ê","Ë","ë","È","è"

  Letra = "E"

  Case "í","Í","ï","Ï","Ì","ì"

  Letra = "I"

  Case "ó","Ó","ô","Ô","õ","Õ","ö","Ö","ò","Ò"

  Letra = "O"

  Case "ú","Ú","Ù","ù","ú","û","ü","Ü","Û"

  Letra = "U"

  Case "ç","Ç"

  Letra = "C"

  Case "ñ"

  Letra = "N"

  End Select

  texto = texto & Letra

 next

 TiraAcento = texto

end function


Clique aqui para acessar a fonte.

[Marcos Guedes]

Retornando o endereço absoluto do servidor:

Código:

request.servervariables("APPL_PHYSICAL_PATH")

[Marcos Guedes]

Escrevendo arquivos:

Código:

dim fs,fname
set fs=Server.CreateObject("Scripting.FileSystemObject")
set fname=fs.CreateTextFile("C:\suaPasta\teste.txt",true)
fname.WriteLine("Hello World!")
fname.Close
set fname=nothing
set fs=nothing

[Marcos Guedes]

Números randômicos:

Código:

function geraNumeros(menor, maior)
   Dim menor, maior
   RANDOMIZE
   
   geraSenha10Numeros = Int((maior-menor+1)*Rnd+menor)
end function

[Marcos Guedes]

Email x CDO.Message

Segue um ótimo exemplo para envio de email's com o CDO.Message:

Código:

<% 
Dim Sch : Sch = "www.schemas.microsoft.com/cdo/configuration/" 
Dim TedkConfig, TedkMessage, Erro, Sucesso, Msg_HTML 
    Set TedkConfig = Server.CreateObject("CDO.Configuration") 
 
        ' Dodos principais de envio, coloque os dados de seu dominio aqui! 
        With (TedkConfig) 
            .Fields.Item(Sch & "sendusing") = 2 
            .Fields.Item(Sch & "smtpauthenticate") = 1 
            .Fields.Item(Sch & "smtpserver") = "smtp.dominio.com.br" 
            .Fields.Item(Sch & "sendusername") = "contato=dominio.com.br" 
            .Fields.Item(Sch & "sendpassword") = "contatosenha" 
            .Fields.Update 
        End With 
 
    Set TedkMessage = Server.CreateObject("CDO.Message") 
    Set TedkMessage.Configuration = TedkConfig 
 
    With (TedkMessage) 
        .From = """"&Request.Form("Nome")&""" <"&Request.Form("EMail")&">" ' Quem envio a mensagem, com nome e e-mail 
        .To = "contato@dominio.com.br" ' Quem Vai receber a mensagem 
        .BCC = "administrador@dominio.com.br" ' Caso queira uma cópia oculta 
        .Subject = "Mensagem enviada de Exemplo" ' Assunto da Mensagem 
        .ReplyTo = Request.Form("EMail") ' Retorna mensagem de erro para o e-mail do rementente 
    End With 
 
    ' Enviado o Corpo da Mensagem 
        Msg_HTML = "<table width='279' border='0' cellspacing='2' cellpadding='0'><tr>" 
        Msg_HTML = Msg_HTML& "<td width='87'>Nome:</td><td width='186'>"&Request.Form("Nome")&"</td>" 
        Msg_HTML = Msg_HTML& "</tr><tr><td>E-Mail:</td><td>"&Request.Form("EMail")&"</td></tr><tr><td valign='top'>Mensagem:</td>" 
        Msg_HTML = Msg_HTML& "<td valign='top'>"&Request.Form("Mensagem")&"</td></tr></table>" 
 
    TedkMessage.HTMLBody = Msg_HTML 
 
    ' Caso a mensagem seja diferente de vazio envia como Texto 
    If Msg_HTML <> "" Then 
        TedkMessage.AutoGenerateTextBody = False 
        TedkMessage.TextBody = Msg_HTML 
    End If     
 
    Erro = "" 
    Sucesso = False 
    On Error Resume Next ' Forçando a não aparecer a linha do erro 
 
    TedkMessage.Send 
 
    ' Finalizando os Recordset's 
    Set TedkMessage = Nothing 
    Set TedkConfig = Nothing 
 
    ' Verificando algum erro existente e colocando na página 
    If Err <> 0 Then : Erro = Err.Description : Else : Sucesso = True : End If 
 
' Mensagem de Resposta 
Response.Write("<script>alert('Mensagem Enviada com Sucesso');location='Default.html'</script>") 
%> 

Segue o link de onde encontrei o código fonte:
http://tedk.com.br/blog/index.php/2008/03/17/cdomessage-enviado-e-mail/