[Resolvido] Validação de Dados

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>