Idade()

Calculo da idade

Function Idade(ByVal datanascimento)
    Dim n1, n2, dataatual
    dataatual = Now()
    If Month(dataatual) >= Month(datanascimento) Then
        If Day(dataatual) >= Day(datanascimento) Then
            n1 = Year(dataatual)
            n2 = Year(datanascimento)
            idade = n1-n2
        Else
            n1 = Year(dataatual)
            n2 = Year(datanascimento)
            idade = n1-n2-1
        End If
    Else
        n1 = Year(dataatual)
        n2 = Year(datanascimento)
        idade = n1-n2-1
    End If
End Function

limpalogin()

Função para previnir sql injection

Function limpalogin(str)
    str = trim(str)
    str = lcase(str)
    str = replace(str,"=","")
    str = replace(str,"'","")
    str = replace(str,"""""","")
    str = replace(str," or ","")
    str = replace(str," and ","")
    str = replace(str,"(","")
    str = replace(str,")","")
    str = replace(str,"<","[")
    str = replace(str,">","]")
    str = replace(str,"update","")
    str = replace(str,"-shutdown","")
    str = replace(str,"--","")
    str = replace(str,"'","")
    str = replace(str,"#","")
    str = replace(str,"$","")
    str = replace(str,"%","")
    str = replace(str,"¨","")
    str = replace(str,"&","")
    str = replace(str,"'or'1'='1'","")
    str = replace(str,"--","")
    str = replace(str,"insert","")
    str = replace(str,"drop","")
    str = replace(str,"delet","")
    str = replace(str,"xp_","")
    str = replace(str,"select","")
    str = replace(str,"*","")
    limpalogin = str
End Function

Maiuscula()

Função que deixa somente as iniciais da string em maiúsculo.

Function maiuscula(str)
    MeuArray = Split(str," ")
    For i = LBound(MeuArray) To UBound(MeuArray)
        resultado = resultado & UCase(LEFT(MeuArray(i),1)) & LCase(RIGHT(MeuArray(i),Len(MeuArray(i))-1)) & " "
    Next
    maiuscula = resultado
End Function

ValidarMail()

Validar email com expressões regulares.

Function ValidarMail(myEmail)
    dim isValidE
    dim regEx

    isValidE = True
    set regEx = New RegExp

    regEx.IgnoreCase = False

    regEx.Pattern = "^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$"
    isValidE = regEx.Test(myEmail)

    ValidarMail = isValidE
End Function

WriteFile()

Salva uma string em um arquivo, sobrescrevendo o arquivo se ele existir.
O FileName pode ser um caminho absoluto ou relativo.

Function WriteFile(ByVal FileName, ByRef Varn)      
    On Error Resume Next
      
    If Mid(FileName, 2, 1) <> ":" Then
        FileName = Server.MapPath(FileName)
    End If
    If Err Then Err.Clear
      
    On Error GoTo 0
       
    Dim F
    Set F = OpenFile(FileName, 2, True)
        
    If F Is Nothing Then
        WriteFile = False
        Exit Function
    End If
        
    On Error Resume Next
        
    F.Write Varn
    If Err Then
        Err.Clear
        F.Close
        On Error GoTo 0
        WriteFile = False
        Exit Function
    End If
        
    On Error GoTo 0
        
    F.Close
    Set F = Nothing
    WriteFile = True        
End Function