Imports System.IO
Module Arquivos_Texto
    'executa as funções de leitura e gravação de arquivos texto

Lê arquivo texto 1

#Region "LeituraArquivoTexto"
    ''' <summary>
    ''' Lê um arquivo texto até o fim e devolve num único string com as linhas separadas por vbcrlf
    ''' exige Imports System.IO
    ''' </summary>
    ''' <param name="arquivo"></param>
    ''' <returns></returns>
    Public Function LeArquivoTexto1(arquivo As String) As String
        Dim fileReader As StreamReader
        Dim LinhaDado As Integer
        Dim dados As String

        dados = ""
        Try
            fileReader = File.OpenText(arquivo) ' no win7 e 8 não pode-se utilizar a pasta c:\
            LinhaDado = fileReader.ReadLine ' converte texto para numérico sem problemas
            While Not IsDBNull(LinhaDado)
                dados = dados + LinhaDado + vbCrLf
            End While
            MsgBox("Leitura do dado feita com sucesso")
            fileReader.Close()
        Catch ex As Exception
            MsgBox("Ocorreu um erro no acesso ao arquivo : " + vbCrLf + Err.Description)
            ' fileReader.Close() dá erro
        End Try

        Return dados
    End Function

Lê arquivo texto 2

    ''' <summary>
    ''' le o arquivo de nome recebido por parametro e retorna uma string com seu conteudo
    ''' exige Imports System.IO
    ''' </summary>
    ''' <param name="NomeArquivo"></param>
    ''' <returns></returns>
    Public Function LeArquivoTexto2(NomeArquivo As String) As String
        Dim dado As String
        Dim a As String

        a = ""
        If File.Exists(NomeArquivo) Then
            Dim reader As New StreamReader(NomeArquivo)

            Do While Not reader.EndOfStream
                dado = reader.ReadLine
                a = a + dado + vbCrLf
            Loop
            reader.Close()

        Else
            Return Nothing
        End If
        Return a
    End Function

Lê arquivo texto 3

    ''' <summary>
    ''' Lê todo um arquivo texto para um único string
    ''' </summary>
    ''' <param name="arquivo"></param>
    ''' <returns></returns>
    Private Function LeArquivoTexto3(arquivo As String) As String
        Dim objStream As New System.IO.FileStream(arquivo, IO.FileMode.OpenOrCreate)
        Dim Arq As New System.IO.StreamReader(objStream)
        Dim texto As String

        texto = Arq.ReadToEnd
        Arq.Close()
        Return texto
    End Function

Lê arquivo texto 4

    ''' <summary>
    ''' Le um arquivo texto e salva numa lista de strings
    ''' exige Imports System.IO
    ''' </summary>
    ''' <param name="arquivo"></param>
    ''' <returns></returns>
    Public Function LeArquivoTexto4(arquivo As String) As List(Of String)
        Dim fileReader As StreamReader
        Dim LinhaDado As Integer
        Dim lista As New List(Of String)

        lista.Clear()

        Try
            fileReader = File.OpenText(arquivo) ' no win7 e 8 não pode-se utilizar a pasta c:\
            lista.Add(fileReader.ReadLine) ' converte texto para numérico sem problemas
            While Not IsDBNull(LinhaDado)
                lista.Add(LinhaDado)
            End While
            MsgBox("Leitura do dado feita com sucesso")
            fileReader.Close()
        Catch ex As Exception
            MsgBox("Ocorreu um erro no acesso ao arquivo : " + vbCrLf + Err.Description)
            ' fileReader.Close() dá erro
        End Try

        Return lista
    End Function

#End Region

Grava arquivo texto 1

#Region "GravaçãoArquivoTexto"
    ''' <summary>
    '''    retorna true se salvou o dado no arquivo informado por parametro
    '''    exige Imports System.IO
    ''' </summary>
    ''' <param name="NomeArquivo"></param>
    ''' <param name="dado">é um array com os strings a serem gravados</param>
    ''' testar funcionamento
    ''' <returns></returns>
    Public Function GravaArquivoTexto1(NomeArquivo As String, dado() As String) As Boolean
        'Dim linha As String
        Try

            Dim escrita As New StreamWriter(NomeArquivo)

            'For a = 0 To dado.Length - 1
            'linha = dado(a)
            'escrita.WriteLine(linha)
            'Next

            escrita.Write(dado)
            escrita.Close()

            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

Grava arquivo texto 2

    Public Function GravaArquivoTexto2(NomeArquivo As String, dado As String) As Boolean
        'Dim linha As String
        Try

            Dim escrita As New StreamWriter(NomeArquivo)

            escrita.Write(dado)
            escrita.Close()

            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

#End Region

Retorna o número de linhas do Arquivo texto

    Public Function Num_Linhas_Arquivo_Texto(ByVal nome_arquivo As String) As Integer
        Dim a As Integer
        Dim fileReader As StreamReader
        Dim Dado As String

        Try
            fileReader = File.OpenText(nome_arquivo)
            a = 0
            While fileReader.EndOfStream = False
                Dado = fileReader.ReadLine
                a = a + 1
            End While
            fileReader.Close()
        Catch ex As Exception
            MsgBox("Ocorreu um erro de acesso ao arquivo:" + vbCrLf + Err.Description, vbCritical, "Function Num_Linhas_Arquivo_Texto")
        End Try

        Return a

    End Function


End Module
-----------------------------------------------------------------------------------------
Arquivos

Imports System.IO

Public Module Arquivos

Conta o número de arquivos que estão entre uma faixa de tamanhos

    ''' <summary>
    ''' Conta o número de arquivos da pasta que estão entre o tamanho máximo e mínimo
    ''' Conta os arquivos apenas da pasta recebida por parametro - não inclui arquivos sub-pastas
    ''' </summary>
    '''
    Public Function Contar(pasta As String, tamMin As Double, tamMax As Double) As ArrayList
        Dim files() As String
        Dim i, fileCount As Integer
        Dim MaxSize, MinSize As Integer
        Dim Arqs As New ArrayList

        If pasta = "" Then
            MsgBox("Pasta inválida")
            Return Nothing
            Exit Function
        End If

        'se o valor vier de um textbox
        'If Form1.TextBox2.Text <> "" Then
        'tamMin = Val(Form1.TextBox2.Text)
        'Else
        'tamMin = 0
        'End If

        'se o valor vier de um textbox
        'If Form1.TextBox3.Text <> "" Then
        'tamMax = Val(Form1.TextBox3.Text)
        'Else
        'MsgBox("Tamanho máximo inválido")
        'Exit Sub
        'End If

        'Form1.ListBox1.Items.Clear()
        files = System.IO.Directory.GetFiles(pasta)
        For i = 0 To files.GetUpperBound(0)
            Dim FI As New System.IO.FileInfo(files(i))
            If FI.Length >= MinSize And FI.Length <= MaxSize Then
                fileCount = fileCount + 1
                Arqs.Add(Convert.ToString(fileCount) + " - " + FI.Name + " - " + Convert.ToString(FI.Length))
            End If
        Next
        'arqs.add("Foram encontrados " + Convert.ToString(fileCount) + " arquivos entre o tamanho " + Convert.ToString(MinSize) + " e " + Convert.ToString(MaxSize) + " bytes")
        Return Arqs
    End Function

Retorna true se o arquivo existe

    ''' <summary>
    ''' retorna true se o arquivo existe
    ''' </summary>
    ''' <param name="nomeArquivo"></param>
    ''' <returns></returns>
    Public Function ArquivoExiste(nomeArquivo As String) As Boolean
        If File.Exists(nomeArquivo) Then
            Return True
        Else
            Return False
        End If
    End Function

Retorna true se os arquivos são iguais

    ''' <summary>
    ''' retorna true se os arquivos são iguais
    ''' </summary>
    ''' <param name="Arq1"></param>
    ''' <param name="Arq2"></param>
    ''' <returns></returns>
    Public Function ComparaArquivos(Arq1 As String, Arq2 As String) As Boolean
        Dim file1byte As Integer
        Dim file2byte As Integer
        Dim fs1 As FileStream
        Dim fs2 As FileStream

        ' verificando se foi dado o mesmo arquivo como parametro
        If Arq1 = Arq2 Then ' verificando Then se os dois nomes apontam para o mesmo arquivo
            Return False 'não eliminar se é o mesmo arquivo
        End If

        'verificando se ambos os arquivos existem
        If (Not System.IO.File.Exists(Arq1)) Or (Not System.IO.File.Exists(Arq2)) Then
            Return False 'um dos arquivos não foi encontrado
        End If

        Dim f1 As FileInfo = New FileInfo(Arq1)
        Dim f2 As FileInfo = New FileInfo(Arq2)
        If f1.Length <> f2.Length Then
            Return False 'arquivos com tamanho diferente
        End If

        ' abrindo os dois arquivos.
        fs1 = New FileStream(Arq1, FileMode.Open)
        fs2 = New FileStream(Arq2, FileMode.Open)

        ' verificando novamente o tamanho dos arquivos
        If fs1.Length <> fs2.Length Then

            ' fechando os arquivos
            fs1.Close()
            fs2.Close()

            ' Retornando falso para indicar que são de tamanhos diferentes
            Return False
        End If

        ' Lendo e comparando os arquivo byte a byte
        Do
            ' Lendo um byte de cada arquivo
            file1byte = fs1.ReadByte()
            file2byte = fs2.ReadByte()
        Loop While (file1byte = file2byte) And (file1byte <> -1)

        ' fechando os arquivos
        fs1.Close()
        fs2.Close()

        ' retornando o resultado da comparação

        Application.DoEvents()

        Return ((file1byte - file2byte) = 0)

    End Function

Retirando atributos de arquivos

Se você deseja, por exemplo, eliminar um arquivo com o atributo read-only precisa primeiro retirar o atributo para depois eliminar.

    ''' Retira o atributo selecionado do arquivo selecionado
    Public Function RemoveAtributo(ByVal arquivo As String, ByVal atributosARemover As FileAttributes) As Boolean
        'Return atributo And (Not atributosARemover)
        Dim atributos As FileAttributes
        Try
            atributos = File.GetAttributes(arquivo)
            atributos = atributos And (Not atributosARemover)
            File.SetAttributes(arquivo, atributos)
            Return True
        Catch ex As Exception
            Return False
        End Try

    End Function

Eliminar arquivo

    ''' <summary>
    ''' Elimina um arquivo
    ''' Devolve true se o arquivo foi eliminado ou false se não for.
    ''' </summary>
    ''' <param name="arquivo"></param>
    ''' <returns></returns>
    Public Function EliminarArquivo(ByVal arquivo As String) As Boolean
        Dim atributos As FileAttributes

        EliminarArquivo = False

        'retirando os atributos especiais do arquivo
        ' atributos = File.GetAttributes(arquivo)
        'atributos = RemoveAtributo(atributos, FileAttributes.ReadOnly)
        atributos = RemoveAtributo(arquivo, System.IO.FileAttributes.ReadOnly)
        'attributes = RemoveAttribute(attributes, FileAttributes.Hidden)

        Try
            File.Delete(arquivo)
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

Escolhendo a pasta do arquivo a ser trabalhada 1

    ''' <summary>
    ''' Escolhe a pasta do disco a ser processada
    ''' Não gosto do FolderBrowserDialog porque ele não é amigável
    ''' </summary>
    ''' <returns></returns>
    Public Function EscolherPasta() '_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEscolherPasta.Click
        Dim fbd As New FolderBrowserDialog

        fbd.Description = "Selecione a pasta onde o arquivo se encontra"
        fbd.RootFolder = Environment.SpecialFolder.MyComputer
        fbd.ShowNewFolderButton = True

        If fbd.ShowDialog = DialogResult.OK Then
            Return fbd.SelectedPath
        End If
        Return Nothing
    End Function

Escolhendo a pasta do arquivo a ser trabalhada 2

    ''' <summary>
    ''' Escolhe o arquivo de uma pasta ou da pasta corrente
    ''' </summary>
    ''' <param name="pasta"></param>
    ''' <returns></returns>
    Public Function EscolherArquivo(pasta As String) As String '_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEscolherArquivo.Click
        Dim ofd As New OpenFileDialog

        ofd.Multiselect = True
        ofd.Title = "Escolha o arquivo a ser trabalhado"

        If pasta <> "" Then
            ofd.InitialDirectory = pasta
        Else
            ofd.InitialDirectory = "C:\"
        End If

        'filtra para exibir somente arquivos de imagens
        ofd.Filter = "Texts (*.txt;*.csv)|*.txt;*.csv|" & "All files (*.*)|*.*"
        ofd.CheckFileExists = True
        ofd.CheckPathExists = True
        ofd.FilterIndex = 2
        ofd.RestoreDirectory = True
        ofd.ReadOnlyChecked = True
        ofd.ShowReadOnly = True

        Dim dr As DialogResult = ofd.ShowDialog()

        If dr = System.Windows.Forms.DialogResult.OK Then
            Return ofd.FileName
        Else
            Return Nothing
        End If
    End Function

Obter a lista de todos os arquivos de uma pasta

    Public Function Pegar_Arquivos(Pasta As String) As List(Of String)
        Dim pastaOrigem As String
        Dim a As New List(Of String)

        'Dim DirDiretorio As DirectoryInfo = New DirectoryInfo(frmPrincipal.txtPastaOrigem.Text)
        Dim arqs As System.Collections.ObjectModel.ReadOnlyCollection(Of String)

        'Dim i As Integer


        pastaOrigem = Pasta
        If Right(pastaOrigem, 1) <> "\" Then
            pastaOrigem = pastaOrigem + "\"
        End If

        pastaOrigem = pastaOrigem.Replace("\", "\\")

        Try

            'arqs = My.Computer.FileSystem.GetFiles("C:\Users\bonito_laptop_i7\Documents\Visual Studio 2010\Projects", FileIO.SearchOption.SearchAllSubDirectories, "*.txt")
            'arqs = My.Computer.FileSystem.GetFiles("C:\Users\AntonioCarlos\.VirtualBox", FileIO.SearchOption.SearchAllSubDirectories, "*.*")


            '### Preenche o FileCollection com um Array de objetos FileInfo
            arqs = My.Computer.FileSystem.GetFiles(pastaOrigem, FileIO.SearchOption.SearchAllSubDirectories, "*.*")

            '### Podemos utilizar os objetos da coleção oFileCollection para preencher um ListBox por exemplo
            'msg1("Adicionando arquivos encontrados....")

            a.clear
            For Each arq In arqs
                a.Add(arq)
            Next
            'frmArquivosPastaOrigem.ListBox1.Refresh()
            Application.DoEvents()

            Return a
        Catch ex As Exception
            'FrmRelatorio.ListBox1.Items.Add("Falha na obtenção dos nomes dos arquivos na pasta origem")
            'FrmRelatorio.ListBox1.Items.Add(" " + ex.Message)
            'Pegar_Arquivos_Pasta_Origem = False
            Return Nothing
        End Try

    End Function

Verificando se o arquivo existe numa determinada pasta

    Public Function ArquivoExistePasta(Arquivo As String) As Boolean
        'verifica se o arquivo existe na pasta de destino - True se existe
        'nota : Vem o path completo e eu troco o path de origem pelo de destino

        'arquivo2 = Arquivo.Replace(frmPrincipal.txtPastaOrigem.Text, frmPrincipal.txtPastaDestino.Text)


        If Not System.IO.File.Exists(Arquivo) Then
            Return False
        Else
            Return True
        End If

        Return Nothing
    End Function

Gerando um novo nome para o arquivo

É o caso de quando vamos copiar um arquivo de uma pasta de origem para uma pasta de destino e ele já existe na pasta de destino. Esta função gera um nome novo para o arquivo de maneira que ele possa ser copiado ou movido sem problemas.

    ''' <summary>
    ''' Este arquivo gera um nome novo para o arquivo que vai ser copiado/movido
    ''' para não apagar o que já existe
    ''' </summary>
    ''' <param name="NomeArquivo"></param>
    ''' <returns></returns>
    Public Function RetornaSufixoAnexarArquivo(NomeArquivo As String) As String
        'separando as partes do nome do arquivo antigo para compor o nome do arquivo novo
        Dim posPto As Integer
        Dim Horario As String
        Dim Extensao As String
        Dim NomeAntigo As String
        Dim NomeNovo As String

        posPto = InStr(NomeArquivo, ".")
        NomeArquivo = Left(NomeArquivo, posPto - 1)
        NomeArquivo = Mid(NomeArquivo, InStrRev(NomeArquivo, "\") + 1)
        Extensao = Mid(NomeArquivo, posPto + 1, 2000)
        Horario = CStr(Now.Day) + "_" + CStr(Now.Month) + "_" + CStr(Now.Year) + "_" + CStr(Now.Hour) + "_" + CStr(Now.Minute) + "_" + CStr(Now.Second) + "_" + CStr(Now.Millisecond)

        NomeAntigo = NomeArquivo
        NomeNovo = NomeArquivo + "_" + Horario + "." + Extensao
        Return NomeNovo
    End Function

Renomeando o arquivo

    Public Function RenomeiaArquivo(NomeArquivoVelho As String, NomeArquivoNovo As String) As Boolean
        'renomeia arquivo na pasta de destino
        Try

            'ArqNovo = Arquivo.Replace(frmPrincipal.txtPastaOrigem.Text, frmPrincipal.txtPastaDestino.Text)


            My.Computer.FileSystem.RenameFile(NomeArquivoVelho, NomeArquivoNovo)

            Return True
        Catch ex As Exception
            'FrmRelatorio.ListBox1.Items.Add("Falha ao renomear arquivo : " + frmPrincipal.txtPastaDestino.Text + Arquivo)
            'FrmRelatorio.ListBox1.Items.Add(" " + ex.Message)
            Return False
        End Try

    End Function

Copiando o arquivo

    Public Function CopiarArquivo(ByVal ArquivoOrigem As String, ByVal ArquivoDestino As String) As Boolean

        Try
            My.Computer.FileSystem.CopyFile(ArquivoOrigem, ArquivoDestino)
            Return True
        Catch ex As Exception
            'FrmRelatorio.ListBox1.Items.Add("Falha na cópia do arquivo : " + frmPrincipal.txtPastaOrigem.Text + Arquivo)
            Return False
        End Try
    End Function

Criando uma nova pasta

    Public Function CriarNovaPasta(Pasta As String)
        Dim a As String

        If Pasta = "" Then
            MsgBox("Escolha o disco primeiramente")
            Return False
        End If

        a = Pasta
        If Right(a, 1) <> "\" Then
            a = a + "\" + a
        Else
            a = a + a
        End If
        My.Computer.FileSystem.CreateDirectory(a)
        Return True
    End Function

Retornando apenas a pasta do nome completo do arquivo

    ''' <summary>
    ''' Recebe o nome do arquivo inteiro (pasta + arquivo) e retorna só a pasta
    ''' com o \ no final do nome da pasta
    ''' </summary>
    ''' <param name="Arquivo"></param>
    ''' <returns></returns>
    Public Function PegaPasta(Arquivo As String) As String
        Dim a As String

        a = Arquivo
        If InStr(a, "\") = -1 Then
            Return Nothing
        End If
        a = Left(a, InStrRev(a, "\"))
        Return a
    End Function

Retornando apenas o nome do arquivo do nome completo do arquivo - Remove a pasta

    ''' <summary>
    ''' Recebe o nome doo arquivo completo ( Pasta + Nome Arquivo) e retorna só o nome do arquivo
    ''' </summary>
    ''' <param name="NomeArquivo"></param>
    ''' <returns></returns>
    Public Function PegaNomeArquivo(NomeArquivo As String) As String
        Dim a As String

        a = NomeArquivo
        If InStr(a, "\") = -1 Then
            Return Nothing
        End If
        a = Mid(a, InStrRev(a, "\") + 1, 2000)
        Return a
    End Function
End Module