VB_CLS_FSO

Imports Scripting
Imports System.IO
Imports System.String

Public Class FSO

    Private oFSO As New Scripting.FileSystemObject
    Private Carp As Scripting.Folder, oDir As Scripting.Files, Fic As Scripting.File, Txt As Scripting.TextStream
    Public Ficheros() As String
    Dim ForReading As IOMode
    Dim ForAppending As IOMode

    Public Function ExisteFichero(RutaFic As String) As Boolean
        If oFSO.FileExists(RutaFic) Then Return True Else Return False
    End Function

    Public Sub CopiarFichero(Origen, Destino, Reescribir)
        If oFSO.FileExists(Origen) Then oFSO.CopyFile(Origen, Destino, Reescribir)
    End Sub

    Public Sub MoverFichero(Origen As String, Destino As String)
        If oFSO.FileExists(Origen) Then oFSO.MoveFile(Origen, Destino)
    End Sub

    Public Sub BorrarFichero(Fichero As String)
        If oFSO.FileExists(Fichero) Then oFSO.DeleteFile(Fichero)
    End Sub

    Public Function ExisteCarpeta(Carpeta As String) As Boolean
        If oFSO.FolderExists(Carpeta) Then Return True Else Return False
    End Function

    Public Sub CrearCarpeta(Carpeta As String)
        If Not oFSO.FolderExists(Carpeta) Then oFSO.CreateFolder(Carpeta)
    End Sub

    Public Sub MoverCarpeta(Origen As String, Destino As String)
        If oFSO.FolderExists(Origen) Then oFSO.MoveFolder(Origen, Destino)
    End Sub

    Public Sub CopiarCarpeta(Origen As String, Destino As String, Reescribir As Boolean)
        If oFSO.FolderExists(Origen) Then oFSO.CopyFolder(Origen, Destino, Reescribir)
    End Sub

    Public Sub BorrarCarpeta(Carpeta As String)
        If oFSO.FolderExists(Carpeta) Then oFSO.DeleteFolder(Carpeta)
    End Sub

    'Public Function Directorio(Carpeta) As String()

    '    Dim x As Integer

    '    If oFSO.FolderExists(Carpeta) Then
    '        Carp = oFSO.GetFolder(Carpeta)
    '        oDir = Carp.Files
    '        x = 0
    '        For Each Item In oDir
    '            ReDim Preserve Ficheros(x)
    '            Ficheros(x) = Item
    '            x = x + 1
    '        Next
    '    End If

    '    Directorio = Ficheros

    'End Function

    Public Function Directorio(Carpeta As String, bRecursivo As Boolean) As List(Of String)

        Dim Lista As New List(Of String)
        Dim Stack As New Stack(Of String)

        Directorio = Nothing

        Stack.Push(Carpeta)

        If oFSO.FolderExists(Carpeta) Then
            Do While (Stack.Count > 0)
                ' Get top directory string
                Dim dir As String = Stack.Pop
                Try
                    ' Add all immediate file paths
                    Lista.AddRange(Directory.GetFiles(dir, "*.*"))

                    If bRecursivo Then
                        ' Loop through all subdirectories and add them to the stack.
                        Dim directoryName As String
                        For Each directoryName In Directory.GetDirectories(dir)
                            Stack.Push(directoryName)
                        Next
                    End If

                Catch ex As Exception
                End Try
            Loop

            Directorio = Lista
        End If

    End Function

    Public Function NombreFichero(Ruta As String) As String

        If oFSO.FileExists(Ruta) Then
            Fic = oFSO.GetFile(Ruta)
            NombreFichero = Fic.Name
        Else
            NombreFichero = "Fichero Desconocido"
        End If

        Fic = Nothing

    End Function

    Public Function TamannoFichero(Ruta As String) As Long

        If oFSO.FileExists(Ruta) Then
            Fic = oFSO.GetFile(Ruta)
            TamannoFichero = Fic.Size
        Else
            TamannoFichero = 0
        End If

        Fic = Nothing

    End Function

    Function sTamanno(iTamanno As Long, iDecimales As Integer) As String

        If iTamanno < 1000 Then
            sTamanno = iTamanno & " bytes"
        ElseIf iTamanno > 999 And iTamanno < 1000000 Then
            sTamanno = Math.Round(iTamanno / 1000, iDecimales) & " Kb"
        ElseIf iTamanno > 999000 Then
            sTamanno = Math.Round(iTamanno / 1000000, iDecimales) & " Mb"
        Else
            sTamanno = iTamanno & " ?"
        End If

    End Function

    Public Function FechaModifFichero(Ruta As String) As Date

        FechaModifFichero = "01/01/1800"

        If oFSO.FileExists(Ruta) Then
            Fic = oFSO.GetFile(Ruta)
            FechaModifFichero = Fic.DateLastModified
            '  FechaModifFichero = CDate(Format(Fic.DateLastModified, "dd/mm/yyyy"))
        End If

        Fic = Nothing

    End Function


    Public Function FicheroFechaHoy(Ruta As String) As Boolean

        Dim Fecha As Date, strfecha As String

        Fecha = FechaModifFichero(Ruta)
        strfecha = Left(CStr(Fecha), 10)

        If Left(CStr(Date.Today), 10) <> strfecha Then Return False

        Return True

    End Function



    Public Sub CrearEscribirTxt(Fichero As String, Reescribir As Boolean, Texto As String)

        If Reescribir Then
            Txt = oFSO.OpenTextFile(Fichero, 2, True)
            Txt.Write(Texto)
            Txt.Close()
        ElseIf Not Reescribir Then
            If oFSO.FileExists(Fichero) Then
                Txt = oFSO.OpenTextFile(Fichero, 8, True)
                Txt.Write(Texto)
                Txt.Close()
            ElseIf Not oFSO.FileExists(Fichero) Then
                Txt = oFSO.OpenTextFile(Fichero, 2, True)
                Txt.Write(Texto)
                Txt.Close()
            End If
        End If
        Txt = Nothing

    End Sub

    Public Sub EscribirLineaTxt(Fichero As String, Texto As String, Optional Crear As Boolean = False)

        Txt = oFSO.OpenTextFile(Fichero, 8, Crear)
        Txt.WriteLine(Texto)
        Txt.Close() : Txt = Nothing

    End Sub

    Public Function LeerTxt(Fichero As String) As String

        Txt = oFSO.OpenTextFile(Fichero, 1, False)
        LeerTxt = Txt.ReadAll
        Txt.Close()
        Txt = Nothing : Txt = Nothing

    End Function

    Public Function LineasFichero(Fichero As String) As Integer

        Dim StrFic As String, Arr_Lineas() As String

        oFSO = CreateObject("Scripting.FileSystemObject")

        Try
            StrFic = oFSO.OpenTextFile(Fichero, IOMode.ForReading).ReadAll
            Arr_Lineas = Strings.Split(StrFic, vbCrLf)
            LineasFichero = UBound(Arr_Lineas) + 1
        Catch ex As Exception
            LineasFichero = -1
        End Try

        StrFic = "" : Arr_Lineas = Nothing

    End Function

    Public Sub RecorreLineas(Fichero As String)

        Dim s As String, ifila As Integer

        Txt = oFSO.OpenTextFile(Fichero, IOMode.ForReading, False)

        ifila = 1

        While Not Txt.AtEndOfStream
            s = Txt.ReadLine

            If s = "" Then
                ' Txt.WriteLine("XXXXXXXXX    ")
            End If
            ifila = ifila + 1
        End While

        Txt.Close()
        Txt = Nothing : Txt = Nothing

    End Sub

    '*************** UNIR DOS FICHEROS DE TEXTO

    Public Sub UnirTxt(Txt1 As String, Txt2 As String, TxtUnion As String)

        Dim ts1 As TextStream
        Dim ts2 As TextStream
        Dim tsUnion As TextStream

        CrearEscribirTxt(TxtUnion, True, "")

        ts1 = oFSO.OpenTextFile(Txt1, IOMode.ForReading)
        ts2 = oFSO.OpenTextFile(Txt2, IOMode.ForReading)
        tsUnion = oFSO.OpenTextFile(TxtUnion, IOMode.ForAppending)

        tsUnion.Write(ts1.ReadAll) : tsUnion.Write(ts2.ReadAll)
        ts1.Close() : ts2.Close() : tsUnion.Close()
        ts1 = Nothing : ts2 = Nothing : tsUnion = Nothing

    End Sub

    '*************** UNIR VARIOS FICHEROS DE TEXTO
    Public Sub UnirTxts(Arr_TxtOrigen() As String, TxtUnion As String)

        Dim ts1 As TextStream
        Dim tsUnion As TextStream

        CrearEscribirTxt(TxtUnion, True, "")
        tsUnion = oFSO.OpenTextFile(TxtUnion, IOMode.ForAppending)

        For Each item As String In Arr_TxtOrigen
            ts1 = oFSO.OpenTextFile(item, IOMode.ForReading)
            tsUnion.Write(ts1.ReadAll)
            ts1.Close() : ts1 = Nothing
        Next

        tsUnion.Close()
        ts1 = Nothing : tsUnion = Nothing

    End Sub

    'Public Sub UnirTxt(Txt1 As String, Txt2 As String, TxtUnion As String)

    '    Dim strRead1 As New IO.StreamReader(Txt1)   'aqui abro un lector de stream del primer archivo

    '    Dim strRead2 As New IO.StreamReader(Txt2)  'aqui abro un lector de stream del segundo archivo

    '    Dim strbuild As New System.Text.StringBuilder    'este objeto sirve para acumular textos

    '    While strRead2.Peek <> -1 Or strRead1.Peek <> -1 'hago un ciclo mientras  en cualquiera de los dos me queden lineas

    '        If strRead1.Peek <> -1 Then   'pregunto si llegue al final del archivo 1

    '            strbuild.Append(strRead1.ReadLine.Replace(vbCrLf, "")) 'no he llegado al final, leo la linea, elimino el enter final y la pego

    '        End If

    '        If strRead2.Peek <> -1 Then 'lo mismo con el segundo archivo

    '            strbuild.Append(" " & strRead2.ReadLine.Replace(vbCrLf, "")) ' esta linea la pego junto a la anterior, y dejo un espacio

    '        End If

    '        strbuild.Append(vbCrLf) 'le pego un enter al final de la linea

    '    End While

    '    strRead1.Close() 'cierro el primer archivo

    '    strRead2.Close() 'cierro el segundoarchivo

    '    Dim StrWriter As New IO.StreamWriter(TxtUnion) 'abro un stream para escritura

    '    StrWriter.Write(strbuild.ToString) 'escribo el stringbuilder completo (un solo string)

    '    StrWriter.Close() 'cierro el stream.
    'End Sub

End Class