[Resolvido] Validação de Dados

[jrcardozo 4]

Funçãozinha que faz tratamento dos dados. Dê fim as inumeras funções de validação e atribua a chamada das mesmas em uma única função.

 

Sabem aquelas validações de replaces, se o e-mail-cpf-cnpj é valido, fazer uma mascara de formatação, converter dados, atribuir valor default, verificar se o campo realmente está preenchido, se o tamanho da string compete ao campo do banco, trocar os vbCrlf por <br /> e outras coisas que fazemos nos requests, variaveis, sessões e uso do objeto de upload!? Essas funções são bem úteis e amarrei todas em uma. Parece inutil, mas depois de usar algumas vezes veremos que é mais simples que ficar copiando códigos de outras páginas. Sem contar que desta forma a manutenção é feita em uma págia enquanto da forma mais "bruta" quando precisamos corrigir um bug temos que catar no código onde pode ter o furo.

 

Coloquei alguns exemplos de utilização.

 

Desculpem não ter comentado, mas não tive mais tempo pra tocar essa idéia, ainda tenho outras funções pra amarrar nesta e tenho a um bom tempo usado outras versoes similares a esta. Criticas, sugestões e porque não elogios são bem vindos.

 

PS: Bom testar pois eu não coloquei essa função em produção, atualmente tenho usado uma versão mais antiga que também fiz, mas a base e a lógica é a mesma

 

Abraços

 

'Autor: Jonathan R. Cardozo(jonathandj)
'Data: 25/08/2009

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit

Response.Charset = "UTF-8"

Function Validar (ByVal pValidate, ByVal pParam)
    'On Error Resume Next
    '"{valor}{L:10,E:G,D:50,R:1,T:S,M:###.TT}"
    'Definições dos  Parametros:
    '    L => "Limite de Caracter" : Recebe um inteiro
    '    E => "Entrada" : Char(1) [P=Post, G=Get, S=Session, U=Objeto Upload, V=Variavel]
    '    D => "Default" : Se Null ou Empty atribui um valor padrão diferente de : e ,
    '    R => "Requerido" : 0 = False, 1 = True
    '    T => "Tipo" : Tipo de dado a ser validado
            'M = Money
            'T = Text(Quebra de linha vbCrlf por <br />)
            'S = String
            'N = Number (Inteiro ou Inteiro Longo)
            'E = Email
    '    M => "Mascara de saída" : ###.S = 333.A (Três números, ponto e 1 Letra/Número)
    '    F => "Eval": F:(Cint(0&[this.value])=1)

    Dim vValidate
    
    Dim vCont
    Dim vTemp
    
    Dim vL
    Dim vR
    Dim vE
    Dim vD
    Dim vT
    Dim vH
    Dim vM
    Dim você
    Dim vF
    
    Dim vError
    
    vError    =    ""
        
    'Entrada
    vE    =    ReturnValue(pParam, "E;ENTRADA")
    If vE <> "" Then
        Select Case Trim(Ucase(vE))
            Case "POST", "GET", "SESSION", ""
                Select Case Trim(Ucase(vE))
                    Case    "P", "POST"            :    vValidate    =    Request.Form(pValidate)
                    Case    "G", "GET"            :    vValidate    =    Request.QueryString(pValidate)
                    Case    "S", "SESSION"    :    vValidate    =    Session(pValidate)
                    Case Else    :    vValidate    =    pValidate
                End Select
            Case Else
                On Error Resume Next
                If (VarType(Eval(vE)) = 9) Then
                    vValidate = Eval(vE).Form(pValidate)        
                End If
                On Error GoTo 0
        End Select
    Else
        vValidate    =    pValidate
    End If
    vValidate    =    Trim(vValidate    &    "")

    vF    =    ReturnValue(pParam, "F;FUNCTION;FUNCAO;EVAL")
    vF    =    Cstr(Replace(vF, "[this.value]", vValidate, 1, -1, 1))
    If (vF <> "") Then
        On Error Resume Next
        vValidate    =    Eval(vF)
        If Err.Number <> 0 Then
            If vError <> "" Then vError    =    vError & "<br />"
            vError    =    vError &_
                "Error Number: " & Err.Number & " <br />"&_
                "Description: " & Err.Description
        End If
        On Error GoTo 0
    End If

    'Html
    vH    =    ReturnValue(pParam, "H;HTML")
    If (vH <> "1") Then
        vH    =    0
    Else
        vH    =    1
    End If

    'Tipo
    vT    =    ReturnValue(pParam, "T;TYPE;TIPO")
    If vT <> "" And vValidate <> "" Then
        Select Case Trim(Ucase(vT))
            Case    "M", "MONEY"                :    vValidate    =    ReturnMoney(vValidate)
            Case    "T", "TEXT"                    :    If (vH = 1) Then : vValidate = replaceVbcrlf(vValidate) : Else : vValidate = replaceVbcrlf(replaceTagsHtml(vValidate)) : End If
            Case    "S", "STRING"                :    vValidate    =    ReturnBreakInjection(vValidate)
            Case    "D", "DATA", "DATE"    :    If (Not IsDate(vValidate)) Then : vValidate = ""
            Case    "E", "EMAIL"                :    If (Not IsEmail(vValidate)) Then : vValidate = ""
            Case    "N", "NUMBER"                :    If (Not IsNumeric(vValidate)) Then : vValidate = ""
            Case    "CNPJ"                            :    If (Not IsCnpj(vValidate)) Then : vValidate = ""
            Case    "CPF"                                :    If (Not IsCpf(vValidate)) Then : vValidate = ""
            Case Else
                If vError <> "" Then vError    =    vError & "<br />"
                vError    =    "Tipo inválido em <strong>""" & pValidate & """</strong>. Value: <strong>" & vValidate & "</strong>"
        End Select
    End If

    'Limite de Caracteres
    vL    =    ReturnInteger(ReturnValue(pParam, "L;MAXCHAR;LIMIT"))    
    If    (IsNumeric(vL))    Then
        vValidate    =    Left(vValidate, vL)
    End If

    'Default    
    If (vValidate = "") Or (IsNull(vValidate)) Then
        vD    =    ReturnValue(pParam, "D;DEFAULT;PADRAO")
        vValidate    =    vD
    End If
    
    'Mascara
    vM    =    ReturnValue(pParam, "M;MASCARA;MASCARAR")
    If vM <> "" Then
        vTemp = vValidate
        If Len(vValidate) > Len(vM) Then
            For vCont = 1 To (Len(vValidate) - Len(vM))
                vM    = "#" & vM
            Next
        Else
            For vCont = 1 To Len(vM) - Len(vTemp)
                vValidate    = "0" & vValidate
            Next
        End If
        vTemp = ""
        For vCont = Len(Trim(vM)) To 1 Step - 1
            If (Mid(vM, vCont, 1) = "#") Then
                vTemp = vTemp & Mid(vValidate & "", vCont, 1)
            Else
                vTemp = vTemp & Mid(vM, vCont, 1) & Mid(vValidate & "", vCont, 1)
            End If
        Next
        vValidate    = ""
        For vCont = Len(vTemp) To 1 Step - 1
            vValidate = vValidate & Mid(vTemp, vCont, 1)
        Next
    End If

    'Conversão
    você    =    ReturnValue(pParam, "C;CONVERTER;CONVERT")
    If você <> "" And vValidate <> "" Then
        'On Error Resume Next
        Select Case Trim(Ucase(você))
            Case    "I", "INT", "INTEGER", "INTEIRO", "CINT"    :    If IsNumeric(vValidate) Then vValidate = Eval("Cint(vValidate)")
            Case    "L", "LONG", "LONGO", "CLNG"                            :    If IsNumeric(vValidate) Then vValidate = Eval("Clng(vValidate)")
            Case    "D", "DATA", "DATE", "CDATE"                            :    If IsDate(vValidate) Then vValidate = Eval("Cdate(vValidate)")
            Case    "S", "STRING", "CSTR"                                            :    vValidate = Eval("Cstr(vValidate)")
            Case    "DOUBLE", "DUPLO", "CDBL"                                    :    If IsNumeric(vValidate) Then vValidate = Eval("Cdbl(vValidate)")
            Case    "M", "MONEY", "$", "CCUR"                                    :    If IsNumeric(vValidate) Then vValidate = Eval("Ccur(vValidate)")
            Case    "B", "BOLEANO", "BOOLEAN", "CBOOL"                :    If IsNumeric(vValidate) Then vValidate = Eval("Cbool(vValidate)")
            Case    "FORMATNUMBER"                                                        :    If IsNumeric(vValidate) Then vValidate = Eval("FormatNumber(vValidate)")
            Case Else    
                If vError <> "" Then vError    =    vError & "<br />"
                vError    =    "Conversão inválida em ""<strong>" & pValidate & "</strong>"". Recebeu <strong>" & você & "</strong>. Valor: <strong>" & vValidate & "</strong>"
        End Select
        'If (Err.Number <> 0 And (Ucase(você) <> "S" Or Ucase(você) <> "STRING" OR Ucase(você) <> "CSTR")) Then
        '    If vError <> "" Then vError    =    vError & "<br />"
        '    vError    =    "Conversão inválida em ""<strong>" & pValidate & "</strong>""(Era esperado um número ou data). Recebeu <strong>" & você & "</strong>. Valor: <strong>" & vValidate & "</strong>"        
        'End If
        'On Error GoTo 0
    End If
    
    'Requerido
    vR    =    ReturnValue(pParam, "R;REQUERIDO;OBRIGATORIO")
    If Lcase(vR & "") = "true" Then
        vR    =    1
    End If
    vR    = ReturnInteger(vR)
    If (IsNumeric(vR)) Or vR = False Then
        If (Cint(vR) = 1) Or vR = False Then
            If (vValidate = "") Or (IsNull(vValidate)) Then
                If vError <> "" Then vError    =    vError & "<br />"
                vError    =    vError & "Entrada Requerida em ""<strong>" & pValidate & "</strong>"""
            End If
        End If
    End If

    If Err.Number <> 0 Then
        If vError <> "" Then vError    =    vError & "<br />"
        vError    =    vError &_
            "Error Number: " & Err.Number & " <br />"&_
            "Description: " & Err.Description
    End If
    
    If vError <> "" Then
        Response.Write vError
        Response.End()
    End If
    
    On Error GoTo 0
    Validar = vValidate

End Function

Function GetParam(pParam, pValue)
    Dim vPosition
    Dim aTemp
    Dim vCont

    pParam        =    Trim(pParam)
    pParam        =    Replace(pParam, "{", "")
    pParam        =    Replace(pParam, "}", "")
    pParam        =    ";" & pParam & ";"
    aTemp            =    Split(pValue , ";")
    For vCont = Lbound(aTemp) To Ubound(aTemp)
        pValue    =    aTemp(vCont)
        vPosition    = InStr( 1, pParam, pValue & ":", 1 )
        If vPosition > 0 Then
            GetParam = Mid( pParam, vPosition, InStr(vPosition, pParam, ";", 1) - vPosition )
            Exit Function
        End If
    Next
    GetParam = ""
End Function

Function ReturnValue (pParam, pValue)
    Dim aParam
    Dim vTemp
    
    ReturnValue = ""    
    vTemp    =    GetParam(pParam, pValue)
    If Not IsNull(vTemp) Then
        aParam    =    Split(vTemp, ":")
        If Ubound(aParam) > 0 Then
            ReturnValue    = Trim("" & aParam(1))
        End If
    End If    
End Function

Function ReturnParam (pParam, pValue)
    Dim aParam
    Dim vTemp
    
    ReturnParam = ""    
    vTemp    =    GetParam(pParam, pValue)    
    If Not IsNull(vTemp) Then
        aParam    =    Split(vTemp, ":")
        If Ubound(aParam) > 0 Then
            ReturnParam    = Trim("" & aParam(0))
        End If
    End If    
End Function

Function ReturnInteger(pValue)
    ReturnInteger    =    ""
    If IsNumeric(pValue) Then
        ReturnInteger    =    Fix(pValue)
    End If
End Function

Function ReturnMoney(pValue)
    ReturnMoney    =    ""
    If IsNumeric(pValue) And Not IsNull(pValue) Then
        pValue            =    Replace(pValue, ".", "")
        pValue            =    Replace(pValue, ",", ".")
        ReturnMoney    =    pValue
    End If
End Function

Function ReplaceVbcrlf(vValue)
    ReplaceVbcrlf    =    ReturnBreakInjection(Replace(vValue, vbCrlf, "<br />", 1, -1, 1))
End Function

Function replaceBr(pValor)
    ReplaceBr = Replace(Replace(pValor & "", "<br />", vbCrlf, 1, -1, 1), "<br>", vbCrlf, 1, -1, 1)
End Function

Function ReturnBreakInjection(pValue)
    pValue                                =    Replace(pValue, "  ", " ")
    pValue                                =    Replace(pValue, "'", "'")
    pValue                                =    Replace(pValue, """", """)
    ReturnBreakInjection    =    pValue
End Function

Function IsEmail(sEmail) 
    Dim objER
    isEmail                        =    False
    Set objER                    =    New RegExp 
    objER.Pattern            =    "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$" 
    objER.IgnoreCase    =    True
    If Not objER.Test(sEmail) Then
        Set objER = Nothing
        Exit Function 
    End If
    Set objER = Nothing
    IsEmail = True
End Function

Function ReturnNumber(pValor)
    Dim i
    Dim char
    Dim saida
    pValor = Trim("" & pValor)
    For i = 1 To Len(pValor)
        char = Mid(pValor, i, 1)
        If InStr("|48|49|50|51|52|53|54|55|56|57|", "|" & Asc(char) & "|") <> 0 Then
            saida = saida & char
        End If
    Next
    ReturnNumber = saida
End Function

Function IsCpf(pValor)
    pValor = ReturnNumber(pValor)
    Dim arrayCpf(9)
    Dim dig1
    Dim dig2
    Dim i
    pValor = trim(Cstr(pValor))
    IsCpf = True
    if Len(pValor) <> 11 then
        isCpf = False
    Else
        For i = 0 to 9
            If pValor = String(11, CStr(i)) Then validarCpf = False
        Next
        If validarCpf Then
            For i = 1 To 9
                arrayCpf(i-1) = Int(Mid(pValor, i, 1))
            Next
            For i = 1 To 9
                dig1 = dig1 + (arrayCpf(9-i)*(i+1))
            Next
            dig1 = 11 - (dig1 Mod 11)
            If dig1 >= 10 Then dig1 = 0
            dig2 = dig1 * 2
            For i = 1 to 9
                dig2 = dig2 + (arrayCpf(9-i)*(i+2))
            Next
            dig2 = 11 - (dig2 Mod 11)
            If dig2 >= 10 Then dig2 = 0
            If (CStr(dig1) & CStr(dig2)) <> Right(pValor, 2) Then IsCpf = False
        End If
    End If
End Function

Function IsCnpj(pValor)
    pValor = returnNumber(pValor)
    Dim arrayCnpj(14)
    Dim saida
    Dim sumCNPJ
    Dim res1
    Dim res2
    Dim i
    Dim valErro
    saida = False
    If isNumeric(pValor) and Len(pValor) = 14 Then
        If Len(pValor) <> 14 Then saida = True
            For i = 0 To 9
                valErro = i & i & i & i & i & i & i & i & i & i & i & i & i & i 
                If pValor = valErro Then saida = True
            Next
            If Not saida Then
            For i = 1 To 14
                arrayCnpj(i) = Cint(Mid(pValor,i,1))
            Next
            sumCNPJ = arrayCnpj(1) * 5 + arrayCnpj(2) * 4 + arrayCnpj(3) * 3 + arrayCnpj(4) * 2 + arrayCnpj(5) * 9 + arrayCnpj(6) * 8 + arrayCnpj(7) * 7 + arrayCnpj(8) * 6 + arrayCnpj(9) * 5 + arrayCnpj(10) * 4 + arrayCnpj(11) * 3 + arrayCnpj(12) * 2
            sumCNPJ = sumCNPJ -(11 * (int(sumCNPJ / 11)))
            If sumCNPJ = 0 Or sumCNPJ = 1 Then res1 = 0 Else res1 = 11 - sumCNPJ
            If res1 = arrayCnpj(13) Then
                sumCNPJ = arrayCnpj(1) * 6 + arrayCnpj(2) * 5 + arrayCnpj(3) * 4 + arrayCnpj(4) * 3 + arrayCnpj(5) * 2 + arrayCnpj(6) * 9 + arrayCnpj(7) * 8 + arrayCnpj(8) * 7 + arrayCnpj(9) * 6 + arrayCnpj(10) * 5 + arrayCnpj(11) * 4 + arrayCnpj(12) * 3 + arrayCnpj(13) * 2
                sumCNPJ = sumCNPJ - (11 * (int(sumCNPJ/11)))
                If sumCNPJ = 0 Or sumCNPJ = 1 Then res2 = 0 Else res2 = 11 - sumCNPJ
                If res2 = arrayCnpj(14) Then saida = False Else saida = True
            Else
                saida = True
            End If
        End If
    Else
        saida = True
    End If
    If Not saida Then IsCnpj = True Else IsCnpj = False
End Function

Function ReplaceTagsHtml(pValue)
    Dim objER
    pValue                        = replaceBr(pValue)
    Set objER                    = New RegExp
    objER.IgnoreCase    = True
    objER.Global            = True
    objER.Pattern            = "<[^>]*>"
    pValue                        = objER.Replace(pValue, "")
    Set objER                    = Nothing
    ReplaceTagsHtml                    = pValue
End Function

Function ReturnTotalChar(pValue, char)
    Dim vCont
    Dim vTotal
    ReturnTotalChar    =    ""
    vTotal    =    0
    For vCont = 1 To Len(Trim(pValue))
        If (Cstr(Mid(pValue, vCont, 1) = Cstr(char))) Then
            vTotal    =    vTotal + 1
        End If
    Next
    If (vTotal > 0) Then
        ReturnTotalChar    =    vTotal
    End If
End Function

Function Iif(pCondition, pTrue, pFalse)
    If pCondition = True Then
        Iif = pTrue
    Else
        Iif = pFalse
    End If
End Function

'Fim das funções

'************** EXEMPLO DE USO

Dim vRequest
Dim variavel

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
    Dim oUpload
    Set oUpload = Server.CreateObject("PERSITS.UPLOAD")
    oUpload.Save
    'Upload
    'Atribui o objeto de upload setado
    'Retornará no formato para gravar no banco com quebra de linha
    vRequest = Validar("vRequestText", "E:oUpload;T:T")
    Response.Write "<br><strong>Request</strong>: " & vRequest
    Response.Write "<br>Type: " & TypeName(vRequest) & "<br />"
    
    Set oUpload = Nothing
End If
'Get
'Method Get para resgatar o valor
'Retorna o valor já convertido em Inteiro Longo
vRequest = Validar("vQString", "E:GET;C:CLNG;T:N")
Response.Write "<br><strong>Request</strong>: " & vRequest
Response.Write "<br>Type: " & TypeName(vRequest) & "<br />"

'O valor da variavel deve ser numérico e é de preenchimento obrigatório
'O retorno terá a mascara declarada
variavel = "854548401"
vRequest = Validar(variavel, "M:####,##;T:N;R:1")
Response.Write "<br><strong>Request</strong>: " & vRequest
Response.Write "<br>Type: " & TypeName(vRequest) & "<br />"

'Devolve o retorno da função iif
Session.Abandon()
variavel = Session.SessionID Mod 2
vRequest = Validar(variavel, "F:iif([this.value] = 1, ""Verdade"", ""Falso"")")
Response.Write "<br><strong>Request</strong>: " & vRequest
Response.Write "<br>Type: " & TypeName(vRequest) & "<br />"

'O valor deve ser uma data, caso não tenha um valor de data válido ou seja vazio ou nulo atribui uma dat default
'O retorno será forçada a conversão de data
Session("DATA_TESTE") = "01/01/2005"
vRequest = Validar("DATA_TESTE", "T:D;E:SESSION;C:DATE;D:10/10/2008")
Response.Write "<br><strong>Request</strong>: " & vRequest
Response.Write "<br>Type: " & TypeName(vRequest) & "<br />"
%>
<br />
<form name="t" id="t" method="post" enctype="multipart/form-data" action="default.asp?vQString=668927465">
    <textarea name="vRequestText"></textarea>
    <input type="submit" value="Post">
</form>