JESUS ESTÁ VOLTANDO: PRISMA BRASIL NO TELETON 2013 HOSPEDANDO ANJOS SEM SABER

terça-feira, 29 de outubro de 2013

PRISMA BRASIL NO TELETON 2013 HOSPEDANDO ANJOS SEM SABER

Nenhum comentário:

Postar um comentário

<% '------------------------------------------ UF = "ES" inscricao = "080233880" valida = ChecaInscrE(UF,inscricao) response.write(valida) '------------------------------------------ function IIf(condicao,verdadeiro,falso) if(condicao) then IIF = verdadeiro else IIF = falso end if end function Function ChecaInscrE (pUF, pInscr) ChecaInscrE = False Dim strBase Dim strBase2 Dim strOrigem Dim strDigito1 Dim strDigito2 Dim intPos Dim intValor Dim intSoma Dim intResto Dim intNumero Dim intPeso Dim intDig strBase = "" strBase2 = "" strOrigem = "" If Trim(pInscr) = "ISENTO" or Trim(pInscr) = "EX" Then ChecaInscrE = True Exit Function End If For intPos = 1 To Len(Trim(pInscr)) If Instr(1, "0123456789P", Mid(pInscr, intPos, 1), vbTextCompare) > 0 Then strOrigem = strOrigem & Mid(pInscr, intPos, 1) End If Next Select Case pUF Case "AC" 'Acre strBase = Left(Trim(strOrigem) & "000000000", 13) d01 = Cint(mid(strBase,1,1)) d02 = Cint(mid(strBase,2,1)) d03 = Cint(mid(strBase,3,1)) d04 = Cint(mid(strBase,4,1)) d05 = Cint(mid(strBase,5,1)) d06 = Cint(mid(strBase,6,1)) d07 = Cint(mid(strBase,7,1)) d08 = Cint(mid(strBase,8,1)) d09 = Cint(mid(strBase,9,1)) d10 = Cint(mid(strBase,10,1)) d11 = Cint(mid(strBase,11,1)) dv01 = Cint(mid(strBase,12,1)) dv02 = Cint(mid(strBase,13,1)) if d01 <> 0 or d02 <> 1 then ChecaInscrE = false Exit Function end if ds = 4*d01 + 3*d02 + 2*d03 + 9*d04 + 8*d05 + 7*d06 + 6*d07 + 5*d08 + _ 4*d09 + 3*d10 + 2*d11 aux1 = Fix(ds / 11) aux1 = aux1 * 11 aux2 = ds - aux1 ' aux2 é o resto, ou mod digverificador1 = 11 - aux2 if digverificador1 = 10 or digverificador1 = 11 then digverificador1 = 0 'primeiro digito end if ds = 5*d01 + 4*d02 + 3*d03 + 2*d04 + 9*d05 + 8*d06 + 7*d07 + 6*d08 + _ 5*d09 + 4*d10 + 3*d11 + 2*digverificador1 aux1 = Fix(ds / 11) aux1 = aux1 * 11 aux2 = ds - aux1 ' aux2 é o resto, ou mod digverificador2 = 11 - aux2 if digverificador2 = 10 or digverificador2 = 11 then digverificador2 = 0 'primeiro digito end if if digverificador1 = dv01 and digverificador2 = dv02 then ChecaInscrE = true end if Case "AL" ' Alagoas strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "24" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intSoma = intSoma * 10 intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto = 10, "0", Cstr(intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "AM" ' Amazonas strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next If intSoma < 11 Then strDigito1 = Right(Cstr(11 - intSoma), 1) Else intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) End If strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "AP" ' Amapa strBase = Left(Trim(strOrigem) & "000000000", 9) intPeso = 0 intDig = 0 If Left(strBase, 2) = "03" Then intNumero = Fix(Left(strBase, 8)) If intNumero >= 3000001 And intNumero <= 3017000 Then intPeso = 5 intDig = 0 ElseIf intNumero >= 3017001 And intNumero <= 3019022 Then intPeso = 9 intDig = 1 ElseIf intNumero >= 3019023 Then intPeso = 0 intDig = 0 End If intSoma = intPeso For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor = 10 Then intValor = 0 ElseIf intValor = 11 Then intValor = intDig End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "BA" ' Bahia strBase = Left(Trim(strOrigem) & "00000000", 8) If Instr(1, "0123458", Left(strBase, 1), vbTextCompare) > 0 Then intSoma = 0 For intPos = 1 To 6 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (8 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 10 strDigito2 = Right(IIf(intResto = 0, "0", Cstr(10 - intResto)), 1) strBase2 = Left(strBase, 6) & strDigito2 intSoma = 0 For intPos = 1 To 7 intValor = Cint(Mid(strBase2, intPos, 1)) intValor = intValor * (9 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 10 strDigito1 = Right(IIf(intResto = 0, "0", Cstr(10 - intResto)), 1) Else intSoma = 0 For intPos = 1 To 6 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (8 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito2 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 6) & strDigito2 intSoma = 0 For intPos = 1 To 7 intValor = Cint(Mid(strBase2, intPos, 1)) intValor = intValor * (9 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) End If strBase2 = Left(strBase, 6) & strDigito1 & strDigito2 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "CE" ' Ceara strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor > 9 Then intValor = 0 End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "DF" ' Distrito Federal strBase = Left(Trim(strOrigem) & "0000000000000", 13) If Left(strBase, 3) = "073" Then intSoma = 0 intPeso = 2 For intPos = 11 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 9 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 11) & strDigito1 intSoma = 0 intPeso = 2 For intPos = 12 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 9 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito2 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 12) & strDigito2 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "ES" ' Espirito Santo strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "GO" ' Goias strBase = Left(Trim(strOrigem) & "000000000", 9) If Instr(1, "10,11,15", Left(strBase, 2), vbTextCompare) > 0 Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 If intResto = 0 Then strDigito1 = "0" ElseIf intResto = 1 Then intNumero = Cint(Left(strBase, 8)) strDigito1 = Right(IIf(intNumero >= 10103105 And intNumero <= 10119997, "1", "0"), 1) Else strDigito1 = Right(Cstr(11 - intResto), 1) End If strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "MA" ' Maranhão strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "12" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "MT" ' Mato Grosso while len(strOrigem) < 11 strOrigem = "0" & strOrigem wend strBase = Left(Trim(strOrigem) & "000000000", 11) d01 = Cint(mid(strBase,1,1)) d02 = Cint(mid(strBase,2,1)) d03 = Cint(mid(strBase,3,1)) d04 = Cint(mid(strBase,4,1)) d05 = Cint(mid(strBase,5,1)) d06 = Cint(mid(strBase,6,1)) d07 = Cint(mid(strBase,7,1)) d08 = Cint(mid(strBase,8,1)) d09 = Cint(mid(strBase,9,1)) d10 = Cint(mid(strBase,10,1)) dfinal = Cint(mid(strBase,11,1)) ds = 3*d01 + 2*d02 + 9*d03 + 8*d04 + 7*d05 + 6*d06 + 5*d07 + 4*d08 + _ 3*d09 + 2*d10 aux1 = Fix(ds / 11) aux1 = aux1 * 11 aux2 = ds - aux1 if aux2 = 0 or aux2 = 1 then digVerificador = 0 else digVerificador = 11 - aux2 end if if dfinal = digVerificador then ChecaInscrE = true end if Case "MS" ' Mato Grosso do Sul strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "28" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "MG" ' Minas Gerais, aki onde tem FormatNumber ante era format strBase = Left(Trim(strOrigem) & "0000000000000", 13) strBase2 = Left(strBase, 3) & "0" & Mid(strBase, 4, 8) intNumero = 2 For intPos = 1 To 12 intValor = Cint(Mid(strBase2, intPos, 1)) intNumero = IIf(intNumero = 2, 1, 2) intValor = intValor * intNumero If intValor > 9 Then strDigito1 = FormatNumber(intValor, "00") intValor = Cint(Left(strDigito1, 1)) + Cint(Right(strDigito1, 1)) End If intSoma = intSoma + intValor Next intValor = intSoma While Right(FormatNumber(intValor, "000"), 1) <> "0" intValor = intValor + 1 Wend strDigito1 = Right(FormatNumber(intValor - intSoma, "00"), 1) strBase2 = Left(strBase, 11) & strDigito1 intSoma = 0 intPeso = 2 For intPos = 12 To 1 Step -1 intValor = Cint(Mid(strBase2, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 11 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito2 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = strBase2 & strDigito2 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "PA" ' Para strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "15" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "PB" ' Paraiba strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor > 9 Then intValor = 0 End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "PE" ' Pernambuco strBase = Left(Trim(strOrigem) & "00000000000000", 14) intSoma = 0 intPeso = 2 For intPos = 13 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 9 Then intPeso = 1 End If Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor > 9 Then intValor = intValor - 10 End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 13) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "PI" ' Piaui strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "PR" ' Parana strBase = Left(Trim(strOrigem) & "0000000000", 10) intSoma = 0 intPeso = 2 For intPos = 8 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 7 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 intSoma = 0 intPeso = 2 For intPos = 9 To 1 Step -1 intValor = Cint(Mid(strBase2, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 7 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito2 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = strBase2 & strDigito2 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "RJ" ' Rio de Janeiro strBase = Left(Trim(strOrigem) & "00000000", 8) intSoma = 0 intPeso = 2 For intPos = 7 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 7 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 7) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "RN" ' Rio Grande do Norte strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "20" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intSoma = intSoma * 10 intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto > 9, "0", Cstr(intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "RO" ' Rondonia, estado alterado strBase = Left(Trim(strOrigem) & "000000000", 14) d01 = Cint(mid(strBase,1,1)) d02 = Cint(mid(strBase,2,1)) d03 = Cint(mid(strBase,3,1)) d04 = Cint(mid(strBase,4,1)) d05 = Cint(mid(strBase,5,1)) d06 = Cint(mid(strBase,6,1)) d07 = Cint(mid(strBase,7,1)) d08 = Cint(mid(strBase,8,1)) d09 = Cint(mid(strBase,9,1)) d10 = Cint(mid(strBase,10,1)) d11 = Cint(mid(strBase,11,1)) d12 = Cint(mid(strBase,12,1)) d13 = Cint(mid(strBase,13,1)) dfinal = Cint(mid(strBase,14,1)) ds = 6*d01 + 5*d02 + 4*d03 + 3*d04 + 2*d05 + 9*d06 + 8*d07 + 7*d08 + _ 6*d09 + 5*d10 + 4*d11 + 3*d12 + 2*d13 aux1 = Fix(ds / 11) aux1 = aux1 * 11 aux2 = ds - aux1 digVerificador = 11 - aux2 if digVerificador > 9 then resto_do_calculo = digVerificador - 10 else resto_do_calculo = digVerificador end if if dfinal <> resto_do_calculo then ChecaInscrE = false else ChecaInscrE = true end if Case "RR" ' Roraima strBase = Left(Trim(strOrigem) & "000000000", 9) If Left(strBase, 2) = "24" Then intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPos intSoma = intSoma + intValor Next intResto = intSoma Mod 9 strDigito1 = Right(Cstr(intResto), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "RS" ' Rio Grande do Sul strBase = Left(Trim(strOrigem) & "0000000000", 10) intNumero = Cint(Left(strBase, 3)) If intNumero > 0 And intNumero < 468 Then intSoma = 0 intPeso = 2 For intPos = 9 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 9 Then intPeso = 2 End If Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor > 9 Then intValor = 0 End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 9) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If Case "SC" ' Santa Catarina strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "SE" ' Sergipe strBase = Left(Trim(strOrigem) & "000000000", 9) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 intValor = 11 - intResto If intValor > 9 Then intValor = 0 End If strDigito1 = Right(Cstr(intValor), 1) strBase2 = Left(strBase, 8) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If Case "SP" ' São Paulo If Left(strOrigem, 1) = "P" Then strBase = Left(Trim(strOrigem) & "0000000000000", 13) strBase2 = Mid(strBase, 2, 8) intSoma = 0 intPeso = 1 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso = 2 Then intPeso = 3 End If If intPeso = 9 Then intPeso = 10 End If Next intResto = intSoma Mod 11 strDigito1 = Right(Cstr(intResto), 1) strBase2 = Left(strBase, 8) & strDigito1 & Mid(strBase, 11, 3) Else strBase = Left(Trim(strOrigem) & "000000000000", 12) intSoma = 0 intPeso = 1 For intPos = 1 To 8 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso = 2 Then intPeso = 3 End If If intPeso = 9 Then intPeso = 10 End If Next intResto = intSoma Mod 11 strDigito1 = Right(Cstr(intResto), 1) strBase2 = Left(strBase, 8) & strDigito1 & Mid(strBase, 10, 2) intSoma = 0 intPeso = 2 For intPos = 11 To 1 Step -1 intValor = Cint(Mid(strBase, intPos, 1)) intValor = intValor * intPeso intSoma = intSoma + intValor intPeso = intPeso + 1 If intPeso > 10 Then intPeso = 2 End If Next intResto = intSoma Mod 11 strDigito2 = Right(Cstr(intResto), 1) strBase2 = strBase2 & strDigito2 End If If strBase2 = strOrigem Then ChecaInscrE = True End If Case "TO" ' Tocantins strBase = Left(Trim(strOrigem) & "00000000000", 11) If Instr(1, "01,02,03,99", Mid(strBase, 3, 2), vbTextCompare) > 0 Then strBase2 = Left(strBase, 2) & Mid(strBase, 5, 6) intSoma = 0 For intPos = 1 To 8 intValor = Cint(Mid(strBase2, intPos, 1)) intValor = intValor * (10 - intPos) intSoma = intSoma + intValor Next intResto = intSoma Mod 11 strDigito1 = Right(IIf(intResto < 2, "0", Cstr(11 - intResto)), 1) strBase2 = Left(strBase, 10) & strDigito1 If strBase2 = strOrigem Then ChecaInscrE = True End If End If End Select End Function %>