Ver Mensaje Individual
  #3 (permalink)  
Antiguo 28/02/2005, 12:03
Avatar de Muzztein
Muzztein
 
Fecha de Ingreso: agosto-2002
Ubicación: Hangar 18
Mensajes: 1.703
Antigüedad: 22 años, 8 meses
Puntos: 16
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
' GenerateFileInformation
' Objetivo:
' Genera una cadena que describe el estado actual de un archivo.
' Demuestra lo siguiente
' - File.Path
' - File.Name
' - File.Type
' - File.DateCreated
' - File.DateLastAccessed
' - File.DateLastModified
' - File.Size
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function GenerateFileInformation(File)

Dim S

S = NewLine & "Ruta de acceso:" & TabStop & File.Path
S = S & NewLine & "Nombre:" & TabStop & File.Name
S = S & NewLine & "Tipo:" & TabStop & File.Type
S = S & NewLine & "Atributos:" & TabStop & ShowFileAttr(File)
S = S & NewLine & "Creado:" & TabStop & File.DateCreated
S = S & NewLine & "Con acceso:" & TabStop & File.DateLastAccessed
S = S & NewLine & "Modificado:" & TabStop & File.DateLastModified
S = S & NewLine & "Tamaño" & TabStop & File.Size & NewLine

GenerateFileInformation = S

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' GenerateFolderInformation
' Objetivo:
' Genera una cadena que describe el estado actual de una carpeta.
' Demuestra lo siguiente
' - Folder.Path
' - Folder.Name
' - Folder.DateCreated
' - Folder.DateLastAccessed
' - Folder.DateLastModified
' - Folder.Size
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function GenerateFolderInformation(Folder)

Dim S

S = "Ruta de acceso:" & TabStop & Folder.Path
S = S & NewLine & "Nombre:" & TabStop & Folder.Name
S = S & NewLine & "Atributos:" & TabStop & ShowFileAttr(Folder)
S = S & NewLine & "Creado:" & TabStop & Folder.DateCreated
S = S & NewLine & "Con acceso:" & TabStop & Folder.DateLastAccessed
S = S & NewLine & "Modificado:" & TabStop & Folder.DateLastModified
S = S & NewLine & "Tamaño:" & TabStop & Folder.Size & NewLine

GenerateFolderInformation = S

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' GenerateAllFolderInformation
' Objetivo:
' Genera una cadena que describe el estado actual de una carpeta y
' todos los archivos y subcarpetas.
' Demuestra lo siguiente
' - Folder.Path
' - Folder.SubFolders
' - Folders.Count
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function GenerateAllFolderInformation(Folder)

Dim S
Dim SubFolders
Dim SubFolder
Dim Files
Dim File

S = "Carpeta:" & TabStop & Folder.Path & NewLine & NewLine
Set Files = Folder.Files

If 1 = Files.Count Then
S = S & "Hay 1 archivo" & NewLine
Else
S = S & "Hay " & Files.Count & " archivos" & NewLine
End If

If Files.Count <> 0 Then
For Each File In Files
S = S & GenerateFileInformation(File)
Next
End If

Set SubFolders = Folder.SubFolders

If 1 = SubFolders.Count Then
S = S & NewLine & "Hay 1 subcarpeta" & NewLine & NewLine
Else
S = S & NewLine & "Hay" & SubFolders.Count & " subcarpetas" & NewLine & NewLine
End If

If SubFolders.Count <> 0 Then
For Each SubFolder In SubFolders
S = S & GenerateFolderInformation(SubFolder)
Next
S = S & NewLine
For Each SubFolder In SubFolders
S = S & GenerateAllFolderInformation(SubFolder)
Next
End If

GenerateAllFolderInformation = S

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' GenerateTestInformation
' Objetivo:
' Genera una cadena que describe el estado actual de la carpeta
' C:\Test y todos los archivos y subcarpetas.
' Demuestra lo siguiente
' - FileSystemObject.DriveExists
' - FileSystemObject.FolderExists
' - FileSystemObject.GetFolder
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function GenerateTestInformation(FSO)

Dim TestFolder
Dim S

If Not FSO.DriveExists(TestDrive) Then Exit Function
If Not FSO.FolderExists(TestFilePath) Then Exit Function

Set TestFolder = FSO.GetFolder(TestFilePath)

GenerateTestInformation = GenerateAllFolderInformation(TestFolder)

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' DeleteTestDirectory
' Objetivo:
' Limpia el directorio de prueba.
' Demuestra lo siguiente
' - FileSystemObject.GetFolder
' - FileSystemObject.DeleteFile
' - FileSystemObject.DeleteFolder
' - Folder.Delete
' - File.Delete
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Sub DeleteTestDirectory(FSO)

Dim TestFolder
Dim SubFolder
Dim File

' Dos formas de eliminar un archivo:

FSO.DeleteFile(TestFilePath & "\Beatles\OctopusGarden.txt")

Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
File.Delete

' Dos formas de eliminar una carpeta:
FSO.DeleteFolder(TestFilePath & "\Beatles")
FSO.DeleteFile(TestFilePath & "\ReadMe.txt")
Set TestFolder = FSO.GetFolder(TestFilePath)
TestFolder.Delete

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' CreateLyrics
' Objetivo:
' Genera un par de archivos de texto en una carpeta.
' Demuestra lo siguiente
' - FileSystemObject.CreateTextFile
' - TextStream.WriteLine
' - TextStream.Write
' - TextStream.WriteBlankLines
' - TextStream.Close
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Sub CreateLyrics(Folder)

Dim TextStream

Set TextStream = Folder.CreateTextFile("OctopusGarden.txt")

' Note que esto no agrega una línea al archivo.
TextStream.Write("Octopus' Garden ")
TextStream.WriteLine("(por Ringo Starr)")
TextStream.WriteBlankLines(1)
TextStream.WriteLine("I'd like to be under the sea in an octopus' garden in the shade,")
TextStream.WriteLine("He'd let us in, knows where we've been -- in his octopus' garden in the shade.")
TextStream.WriteBlankLines(2)

TextStream.Close

Set TextStream = Folder.CreateTextFile("BathroomWindow.txt")
TextStream.WriteLine("She Came In Through The Bathroom Window (por Lennon/McCartney)")
TextStream.WriteLine("")
TextStream.WriteLine("She came in through the bathroom window protected by a silver spoon")
TextStream.WriteLine("But now she sucks her thumb and wanders by the banks of her own lagoon")
TextStream.WriteBlankLines(2)
TextStream.Close

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' GetLyrics
' Objetivo:
' Muestra los contenidos de los archivos de letras.
' Demuestra lo siguiente
' - FileSystemObject.OpenTextFile
' - FileSystemObject.GetFile
' - TextStream.ReadAll
' - TextStream.Close
' - File.OpenAsTextStream
' - TextStream.AtEndOfStream
' - TextStream.ReadLine
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function GetLyrics(FSO)

Dim TextStream
Dim S
Dim File

' Hay varias formas de abrir un archivo de texto y varias formas de
' leer los datos de un archivo. Aquí hay dos formas para hacer cada
' una de ellas:

Set TextStream = FSO.OpenTextFile(TestFilePath & "\Beatles\OctopusGarden.txt", OpenFileForReading)

S = TextStream.ReadAll & NewLine & NewLine
TextStream.Close

Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
Set TextStream = File.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = S & TextStream.ReadLine & NewLine
Loop
TextStream.Close

GetLyrics = S

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' BuildTestDirectory
' Objetivo:
' Genera una jerarquía de directorio para demostrar FileSystemObject.
' Construimos una jerarquía en este orden:
' C:\Test
' C:\Test\ReadMe.txt
' C:\Test\Beatles
' C:\Test\Beatles\OctopusGarden.txt
' C:\Test\Beatles\BathroomWindow.txt
' Demuestra lo siguiente
' - FileSystemObject.DriveExists
' - FileSystemObject.FolderExists
' - FileSystemObject.CreateFolder
' - FileSystemObject.CreateTextFile
' - Folders.Add
' - Folder.CreateTextFile
' - TextStream.WriteLine
' - TextStream.Close
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''

Function BuildTestDirectory(FSO)


Dim TestFolder
Dim SubFolders
Dim SubFolder
Dim TextStream

' Salir si (a) la unidad no existe, o si (b) ya existe el directorio
' generado.

If Not FSO.DriveExists(TestDrive) Then
BuildTestDirectory = False
Exit Function
End If

If FSO.FolderExists(TestFilePath) Then
BuildTestDirectory = False
Exit Function
End If

Set TestFolder = FSO.CreateFolder(TestFilePath)

Set TextStream = FSO.CreateTextFile(TestFilePath & "\ReadMe.txt")
TextStream.WriteLine("Mi colección de letras de canciones")
TextStream.Close

Set SubFolders = TestFolder.SubFolders
Set SubFolder = SubFolders.Add("Beatles")
CreateLyrics SubFolder
BuildTestDirectory = True

End Function