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
Comments