Windows Forms - Funções Utilitárias
Carregar Arquivo de Opções
''' <summary>
''' Esta sub Carrega as opçoes do programa do arquivo opcoes.txt
''' </summary>
Public Function CarregarOpcoes() As List(Of String)
Dim ArquivoTexto As IO.StreamReader
Dim DadoArqTexto As String
Dim pasta As String
Dim b As New List(Of String)
'Environment.SystemDirectory
'Environment.CurrentDirectory
'pasta = Environment.GetFolderPath(Environment.SpecialFolder.System)
pasta = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)
If Right(pasta, 1) <> "\" Then
pasta = pasta + ""
End If
If IO.File.Exists(pasta + "opcoes.Text") Then
b.Clear()
ArquivoTexto = New IO.StreamReader(pasta + "opcoes.Text")
'primeira linha : Pasta de Arquivos de Origem
DadoArqTexto = ArquivoTexto.ReadLine
b.Add(DadoArqTexto) 'PastaOrigem
'segunda linha : Pasta de Arquivos de Destino
DadoArqTexto = ArquivoTexto.ReadLine
b.Add(DadoArqTexto) 'PastaDestino
'terceira linha : Número de horas para repetir processo
DadoArqTexto = ArquivoTexto.ReadLine
b.Add(DadoArqTexto) 'NumHoras
'quarta linha : Incluir subpastas
DadoArqTexto = ArquivoTexto.ReadLine
If DadoArqTexto = "SIM" Then
b.Add("True") 'IncluirSubPastas
Else
b.Add("False") 'IncluirSubPastas
End If
ArquivoTexto.Close()
Return b
Else
Return Nothing
End If
End Function
Salvar o Arquivo de Opções
''' <summary>
''' Esta rotina salva as opções do usuário sobre o programa no arquivo opcoes.txt
''' </summary>
Public Sub SalvarOpcoes(a As List(Of String))
Dim ArquivoTexto As IO.StreamWriter
Dim pasta As String
pasta = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)
If Right(pasta, 1) <> "\" Then
pasta = pasta + ""
End If
ArquivoTexto = New IO.StreamWriter(pasta + "opcoes")
'primeira linha : Pasta de Arquivos de Origem
ArquivoTexto.WriteLine(a(0))
'segunda linha : Pasta de Arquivos de Destino
ArquivoTexto.WriteLine(a(1))
'terceira linha : Número de horas para repetir processo
ArquivoTexto.WriteLine(a(2))
'quarta linha : Pasta de Arquivos de Destino
If a(3) = "True" Then
ArquivoTexto.WriteLine("SIM")
Else
ArquivoTexto.WriteLine("NAO")
End If
ArquivoTexto.Close()
End Sub
End Module
Função que limpa separadores de campos
Public Function limpa(ByVal dado As Object) As String
Dim dia, mes, ano As Integer
Dim data As DateTime
Dim saida As String
If IsDBNull(dado) Then
Return "'NULL'"
End If
If IsDate(dado) Then
data = CDate(dado)
dia = data.Day
mes = data.Month
ano = data.Year
If dia < 10 Then
saida = "0" + CStr(dia)
Else
saida = CStr(dia)
End If
saida = saida + "/"
If mes < 10 Then
saida = saida + "0" + CStr(mes)
Else
saida = saida + CStr(mes)
End If
saida = saida + "/" + CStr(ano)
Return saida
End If
If IsNumeric(dado) Then
saida = Trim(CStr(dado))
saida = Replace(saida, ",", ".")
Return saida
End If
saida = Trim(dado)
saida = Replace(saida, "'", "´")
Return saida
End Function
Função que valida um CNPJ
Public Function E_CNPJ(ByVal ID As String) As Boolean
' validando se CGC ou CNPJ
'o campo deve vir com 14 caracteres numéricos completados com zeros a esquerda
'a validação é feita com o formato xxx.xxx.xxx-xx
Dim a As Integer
Dim j As Integer
Dim d1 As Integer
Dim i As Integer
Dim d2 As Integer
Dim b As String
E_CNPJ = True
If ID = "" Then
E_CNPJ = False
Exit Function
End If
b = Limpa_CPF_CNPJ(ID)
While (Left(b, 1) = "0") And (Len(b) > 8)
b = Mid$(b, 2, 2000)
End While
If (Len(b) > 8) And (Len(b) < 14) Then
While Len(b) < 14
b = "0" + b
End While
End If
If Len(b) = 8 And Val(b) > 0 Then
a = 0
j = 0
d1 = 0
For i = 1 To 7
a = Val(Mid(b, i, 1))
If (i Mod 2) <> 0 Then
a = a * 2
End If
If a > 9 Then
j = j + Int(a / 10) + (a Mod 10)
Else
j = j + a
End If
Next i
d1 = IIf((j Mod 10) <> 0, 10 - (j Mod 10), 0)
If d1 = Val(Mid(b, 9, 1)) Then
E_CNPJ = True
Else
E_CNPJ = False
End If
Else
If Len(b) = 14 And Val(b) > 0 Then
a = 0
i = 0
d1 = 0
d2 = 0
j = 5
For i = 1 To 12 Step 1
a = a + (Val(Mid(b, i, 1)) * j)
j = IIf(j > 2, j - 1, 9)
Next i
a = a Mod 11
d1 = IIf(a > 1, 11 - a, 0)
a = 0
i = 0
j = 6
For i = 1 To 13 Step 1
a = a + (Val(Mid(b, i, 1)) * j)
j = IIf(j > 2, j - 1, 9)
Next i
a = a Mod 11
d2 = IIf(a > 1, 11 - a, 0)
If (d1 = Val(Mid(b, 13, 1)) And d2 = Val(Mid(b, 14, 1))) Then
E_CNPJ = True
Else
E_CNPJ = False
End If
Else
E_CNPJ = False
End If
End If
Return E_CNPJ
End Function
Função valida um CPF
Public Function E_CPF(ByVal ID As String) As Boolean
' valida se cpf
Dim soma As Integer
Dim Resto As Integer
Dim i As Integer
Dim b As String
E_CPF = True
If ID = "" Then
E_CPF = False
Exit Function
End If
If Len(ID) < 5 Then
E_CPF = False
Exit Function
End If
b = Limpa_CPF_CNPJ(ID)
If Not IsNumeric(b) Then
E_CPF = False
Exit Function
End If
While (Strings.Left(b, 1) = "0") And (Len(b) > 11)
b = Mid$(b, 2, 2000)
End While
While Len(b) < 11
b = "0" + b
End While
'Valida argumento
If Len(b) <> 11 Then
E_CPF = False
Exit Function
End If
soma = 0
For i = 1 To 9
soma = soma + Val(Mid$(b, i, 1)) * (11 - i)
Next i
Resto = 11 - (soma - (Int(soma / 11) * 11))
If (Resto = 10) Or (Resto = 11) Then Resto = 0
If Resto <> Val(Mid$(b, 10, 1)) Then
E_CPF = False
Exit Function
End If
soma = 0
For i = 1 To 10
soma = soma + Val(Mid$(b, i, 1)) * (12 - i)
Next i
Resto = 11 - (soma - (Int(soma / 11) * 11))
If (Resto = 10) Or (Resto = 11) Then Resto = 0
If Resto <> Val(Mid$(b, 11, 1)) Then
E_CPF = False
Exit Function
End If
Return E_CPF
End Function
Função que valida um CEI
Public Function E_CEI(cei As String) As Boolean
'CEI = Código Específico do INSS
'O CEI são 11 digitos mais 1 digito verificador
Try
Dim numcei As String
Dim Pesos = New Integer() {7, 4, 1, 8, 5, 2, 1, 6, 3, 7, 4}
Dim soma As Integer = 0
Dim SOMA_CEI(11) As Integer
Dim dv As String = ""
Dim Total As Integer = 0
Dim CEI1(11) As Integer
Dim i As Integer
Dim j As Integer
'retirando os zeros não significativos a esquerda
numcei = cei
While (Left(numcei, 1) = "0") And (Len(numcei) > 12)
numcei = Mid(numcei, 2, 100)
End While
If (numcei.Length < 12) Then
Return False
End If
'Convertendo os caracteres do CEI para inteiro e criando um array
For i = 0 To Len(numcei) - 2
CEI1(i) = CInt(Mid(numcei, i + 1, 1))
SOMA_CEI(i) = CEI1(i) * Pesos(i)
Next
soma = 0
For j = 0 To 10
soma = soma + SOMA_CEI(j)
Next
j = Int(soma / 10)
j = soma Mod 10 + j
j = (Math.Abs(10 - j) Mod 10)
dv = CStr(j)
If (numcei.Substring(11, 1) = dv) Then
Return True
Else
Return False
End If
Catch ex As Exception
MsgBox("Ocorreu um Erro : " + Err.Description, vbCritical, "Function E_CEI")
Return False
End Try
End Function
Função que retira acentuação de caracteres portugueses
Public Function RetiraAcentuacao(ByVal dado As String) As String
Dim a As String
a = dado
'substutuição de acentuação - minúsculas
a = Replace(a, "á", "a")
a = Replace(a, "à", "a")
a = Replace(a, "ã", "a")
a = Replace(a, "â", "a")
a = Replace(a, "ä", "a")
a = Replace(a, "é", "e")
a = Replace(a, "è", "e")
a = Replace(a, "ê", "e")
a = Replace(a, "ë", "e")
a = Replace(a, "í", "i")
a = Replace(a, "ì", "i")
a = Replace(a, "î", "i")
a = Replace(a, "ï", "i")
a = Replace(a, "ó", "o")
a = Replace(a, "ò", "o")
a = Replace(a, "õ", "o")
a = Replace(a, "ô", "o")
a = Replace(a, "ö", "o")
a = Replace(a, "ú", "u")
a = Replace(a, "ù", "u")
a = Replace(a, "û", "u")
a = Replace(a, "ü", "u")
a = Replace(a, "ç", "c")
'substutuição de acentuação - maiúsculas
a = Replace(a, "Á", "A")
a = Replace(a, "À", "A")
a = Replace(a, "Ã", "A")
a = Replace(a, "Â", "A")
a = Replace(a, "Ä", "A")
a = Replace(a, "É", "E")
a = Replace(a, "È", "E")
a = Replace(a, "Ê", "E")
a = Replace(a, "Ë", "E")
a = Replace(a, "Í", "I")
a = Replace(a, "Ì", "I")
a = Replace(a, "Î", "I")
a = Replace(a, "Ï", "I")
a = Replace(a, "Ó", "O")
a = Replace(a, "Ò", "O")
a = Replace(a, "Õ", "O")
a = Replace(a, "Ô", "O")
a = Replace(a, "Ö", "O")
a = Replace(a, "Ú", "U")
a = Replace(a, "Ù", "U")
a = Replace(a, "Û", "U")
a = Replace(a, "Ü", "U")
a = Replace(a, "Ç", "C")
Return a
End Function
End Module