Exemple de code du FileSystemObject

Microsoft VBScript

previous page next page
Bibliothèque d'exécution Microsoft® Scripting - FileSystemObject FileSystemObject
Exemple de code
   Précédent

L'exemple de code décrit dans cette section offre un exemple réaliste des nombreuses fonctionnalités offertes pas le modèle d'objet FileSystemObject. Ce code illustre l'emploi de ces fonctionnalités du modèle d'objet ainsi que leur mise en �uvre de façon efficace dans votre propre code.

Remarquez que ce code est relativement générique et que des adaptations mineures seront nécessaires pour qu'il puisse s'exécuter effectivement sur votre machine. Ces modifications sont requises en raison des différentes mises en �uvres des entrées et des sorties vers l'utilisateur entre les pages ASP et l'hôte Windows Scripting Host.

Pour exécuter ce code sur une page ASP, utilisez la procédure suivante :

  1. Créez une page Web standard avec une extension .asp.
  2. Copiez l'exemple de code suivant dans ce fichier, encadré de balises <BODY;>...</BODY>.
  3. Encadrez tout le code entre les balises <%...%>.
  4. Déplacez l'instruction Option Explicit de sa position actuelle dans le code vers le haut de votre page HTML, avant la balise d'ouverture <HTML>.
  5. Placez des balises <%...%> autour de l'instruction Option Explicit pour qu'elle soit exécutée du côté serveur.
  6. Ajoutez le code suivant à la fin de l'exemple de code : 
Sub Print(x)
  Response.Write "<PRE><FONT; FACE=""Courier New"" SIZE=""1"">"
  Response.Write x
  Response.Write "</FONT></PRE>"
End Sub
Main
Le code ci-dessus ajoute une procédure d'impression qui s'exécute du côté serveur mais affiche ses résultats du côté client. Pour exécuter ce code sur Windows Scripting Host, ajoutez le code suivant à la fin de l'exemple de code : 
Sub Print(x)
	WScript.Echo x
End Sub
Main

Le code est contenu dans la section suivante :


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Exemple de code du FileSystemObject
' 
' Copyright 1998 Microsoft Corporation.  Tous droits réservés. 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Remarques sur la qualité du code :
'
' 1) Ce code effectue de nombreuses manipulations de chaînes en 
'    concaténant de courtes chaînes à l'aide de l'opérateur "&". 
'    En raison du coût que représentent les opérations de concaténation, l'écriture de ce 
'    code selon cette méthode n'est pas très efficace.
'    Cette méthode facilite néanmoins 
'    la maintenance et, dans le cas présent, les nombreuses 
'    opérations disques effectuées sont de toute façon beaucoup 
'    plus lentes que les opérations de concaténation de chaînes. 
'    N'oubliez pas qu'il s'agit de code de démonstration, et non 
'    pas de production.
'
' 2) L'option "Option Explicit" permet d'accélérer légèrement 
'    l'accès aux variables. Elle permet également d'éviter 
'    certaines erreurs, notamment les fautes de frappes telles 
'    que DriveTypeCDORM à la place de DriveTypeCDROM.
'
' 3) Ce code ne comprend pas de gestion d'erreur afin de simplifier 
'    sa lecture. Malgré les précautions prises afin qu'il 
'    fonctionne dans les cas courants, les systèmes de fichiers 
'    restent imprévisibles. En production, utilisez On Error 
'    Resume Next et l'objet Err afin d'intercepter les erreurs 
'    éventuelles.
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Variables globales pratiques
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim TabStop
Dim NewLine

Const TestDrive = "C"
Const TestFilePath = "C:\Test"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Constantes renvoyées par Drive.DriveType
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const DriveTypeRemovable = 1
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4
Const DriveTypeRAMDisk = 5

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Constantes renvoyées par File.Attributes
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const FileAttrNormal  = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32 
Const FileAttrAlias = 64
Const FileAttrCompressed = 128

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Constantes d'ouverture de fichiers
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const OpenFileForReading = 1 
Const OpenFileForWriting = 2 
Const OpenFileForAppending = 8 


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' ShowDriveType
'
' Objet :
'
' Génère une chaîne décrivant le type d'un objet Drive donné.
'
' Présente 
'
' - Drive.DriveType
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function ShowDriveType(Drive)

	Dim S
  
	Select Case Drive.DriveType
	Case DriveTypeRemovable
		S = "Amovible"
	Case DriveTypeFixed
		S = "Fixe"
	Case DriveTypeNetwork
		S = "Réseau"
	Case DriveTypeCDROM
		S = "CD-ROM"
	Case DriveTypeRAMDisk
		S = "Disque virtuel"
	Case Else
		S = "Inconnu"
	End Select

	ShowDriveType = S

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' ShowFileAttr
'
' Objet :
'
' Génère une chaîne décrivant les attributs d'un fichier ou d'un dossier.
'
' Présente  
'
' - File.Attributes
' - Folder.Attributes
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function ShowFileAttr(File) ' File représente un fichier ou un dossier

	Dim S
  	Dim Attr
	
	Attr = File.Attributes

	If Attr = 0 Then
		ShowFileAttr = "Normal"
		Exit Function
	End If

	If Attr And FileAttrDirectory  Then S = S & "Répertoire "
	If Attr And FileAttrReadOnly   Then S = S & "En lecture seule "
	If Attr And FileAttrHidden     Then S = S & "Caché "
	If Attr And FileAttrSystem     Then S = S & "Système "
	If Attr And FileAttrVolume     Then S = S & "Volume "
	If Attr And FileAttrArchive    Then S = S & "Archive "
	If Attr And FileAttrAlias      Then S = S & "Alias "
	If Attr And FileAttrCompressed Then S = S & "Compressé "

	ShowFileAttr = S

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' GenerateDriveInformation
'
' Objet :
'
' Génère une chaîne décrivant l'état actuel des lecteurs disponibles.
'
' Présente 
'
' - FileSystemObject.Drives 
' - L'itération dans la collection Drives
' - Drives.Count
' - Drive.AvailableSpace
' - Drive.DriveLetter
' - Drive.DriveType
' - Drive.FileSystem
' - Drive.FreeSpace
' - Drive.IsReady
' - Drive.Path
' - Drive.SerialNumber
' - Drive.ShareName
' - Drive.TotalSize
' - Drive.VolumeName
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateDriveInformation(FSO)

	Dim Drives
	Dim Drive
	Dim S

	Set Drives = FSO.Drives

	S = "Nombre de lecteurs:" & TabStop & Drives.Count & NewLine & NewLine

	' Construit la première ligne du compte-rendu.
	S = S & String(2, TabStop) & "Lecteur" 
	S = S & String(3, TabStop) & "Fichier" 
	S = S & TabStop & "Total"
	S = S & TabStop & "Libre"
	S = S & TabStop & "Disponible" 
	S = S & TabStop & "Série" & NewLine

	' Construit la seconde ligne de l'état.
	S = S & "Lettre"
	S = S & TabStop & "Chemin"
	S = S & TabStop & "Type"
	S = S & TabStop & "Prêt?"
	S = S & TabStop & "Nom"
	S = S & TabStop & "Système"
	S = S & TabStop & "Espace"
	S = S & TabStop & "Espace"
	S = S & TabStop & "Espace"
	S = S & TabStop & "Numéro" & NewLine	

	' Ligne de séparation.
	S = S & String(105, "-") & NewLine

	For Each Drive In Drives

		S = S & Drive.DriveLetter
		S = S & TabStop & Drive.Path
		S = S & TabStop & ShowDriveType(Drive)
		S = S & TabStop & Drive.IsReady

		If Drive.IsReady Then
    		If DriveTypeNetwork = Drive.DriveType Then
				S = S & TabStop & Drive.ShareName 
			Else
				S = S & TabStop & Drive.VolumeName 
			End If    

			S = S & TabStop & Drive.FileSystem
			S = S & TabStop & Drive.TotalSize
			S = S & TabStop & Drive.FreeSpace
			S = S & TabStop & Drive.AvailableSpace
			S = S & TabStop & Hex(Drive.SerialNumber)

		End If

		S = S & NewLine

	Next  
	
	GenerateDriveInformation = S

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' GenerateFileInformation
'
' Objet :
'
' Génère une chaîne décrivant l'état actuel d'un fichier.
'
' Présente 
'
' - File.Path
' - File.Name
' - File.Type
' - File.DateCreated
' - File.DateLastAccessed
' - File.DateLastModified
' - File.Size
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateFileInformation(File)

	Dim S

	S = NewLine & "Chemin:" & TabStop & File.Path
	S = S & NewLine & "Nom:" & TabStop & File.Name
	S = S & NewLine & "Type:" & TabStop & File.Type
	S = S & NewLine & "Attribs:" & TabStop & ShowFileAttr(File)
	S = S & NewLine & "Créé le:" & TabStop & File.DateCreated
	S = S & NewLine & "Accès le:" & TabStop & File.DateLastAccessed
	S = S & NewLine & "Modif:" & TabStop & File.DateLastModified
	S = S & NewLine & "Taille" & TabStop & File.Size & NewLine

	GenerateFileInformation = S

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' GenerateFolderInformation
'
' Objet :
'
' Génère une chaîne décrivant l'état actuel d'un dossier.
'
' Présente 
'
' - Folder.Path
' - Folder.Name
' - Folder.DateCreated
' - Folder.DateLastAccessed
' - Folder.DateLastModified
' - Folder.Size
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateFolderInformation(Folder)

	Dim S

	S = "Chemin:" & TabStop & Folder.Path
	S = S & NewLine & "Nom:" & TabStop & Folder.Name
	S = S & NewLine & "Attribs:" & TabStop & ShowFileAttr(Folder)
	S = S & NewLine & "Créé le:" & TabStop & Folder.DateCreated
	S = S & NewLine & "Accès le:" & TabStop & Folder.DateLastAccessed
	S = S & NewLine & "Modif:" & TabStop & Folder.DateLastModified
	S = S & NewLine & "Taille:" & TabStop & Folder.Size & NewLine

	GenerateFolderInformation = S

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' GenerateAllFolderInformation
'
' Objet :
'
' Génère une chaîne décrivant l'état actuel d'un
' dossier et de ses fichiers et sous-dossiers.
'
' Présente 
'
' - Folder.Path
' - Folder.SubFolders
' - Folders.Count
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateAllFolderInformation(Folder)

	Dim S
	Dim SubFolders
	Dim SubFolder
	Dim Files
	Dim File

	S = "Dossier:" & TabStop & Folder.Path & NewLine & NewLine

	Set Files = Folder.Files

	If 1 = Files.Count Then
		S = S & "Il y a 1 fichier" & NewLine
	Else
		S = S & "Il y a " & Files.Count & " fichiers" & 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 & "Il y a 1 sous-dossier" & NewLine & NewLine
	Else
		S = S & NewLine & "Il y a " & SubFolders.Count & " sous-dossiers" & 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
'
' Objet :
'
' Génère une chaîne décrivant l'état actuel du dossier C:\Test 
' et de ses fichiers et sous-dossiers.
'
' Présente 
'
' - 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
'
' Objet :
'
' Nettoie le répertoire de test.
'
' Présente 
'
' - FileSystemObject.GetFolder
' - FileSystemObject.DeleteFile
' - FileSystemObject.DeleteFolder
' - Folder.Delete
' - File.Delete
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub DeleteTestDirectory(FSO)

	Dim TestFolder
	Dim SubFolder
	Dim File
	
	' Deux façons de supprimer un fichier:

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

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



	' Deux façons de supprimer un dossier:

	FSO.DeleteFolder(TestFilePath & "\Beatles")

	FSO.DeleteFile(TestFilePath & "\ReadMe.txt")

	Set TestFolder = FSO.GetFolder(TestFilePath)
	TestFolder.Delete

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CreateLyrics
'
' Objet :
'
' Crée deux fichiers texte dans un dossier.
'
'
' Présente 
'
' - FileSystemObject.CreateTextFile
' - TextStream.WriteLine
' - TextStream.Write
' - TextStream.WriteBlankLines
' - TextStream.Close
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CreateLyrics(Folder)

	Dim TextStream
	
	Set TextStream = Folder.CreateTextFile("OctopusGarden.txt")
	
	TextStream.Write("Octopus' Garden ") ' Remarquez que ceci n'ajoute pas de saut de ligne dans le fichier.
	TextStream.WriteLine("(par 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 (par 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
'
' Objet :
'
' Affiche le contenu des fichiers des paroles.
'
'
' Présente 
'
' - FileSystemObject.OpenTextFile
' - FileSystemObject.GetFile
' - TextStream.ReadAll
' - TextStream.Close
' - File.OpenAsTextStream
' - TextStream.AtEndOfStream
' - TextStream.ReadLine
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GetLyrics(FSO)

	Dim TextStream
	Dim S
	Dim File

	' Il existe plusieurs moyens d'ouvrir un fichier texte et 
	' plusieurs moyens de lire les données d'un fichier. 
	' Voici deux façons d'effectuer chaque opération:

	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
'
' Objet :
'
' Crée une hiérarchie de répertoires pour exposer le FileSystemObject.
'
' Nous construirons une hiérarchie dans l'ordre suivant :
'
' C:\Test
' C:\Test\ReadMe.txt
' C:\Test\Beatles
' C:\Test\Beatles\OctopusGarden.txt
' C:\Test\Beatles\BathroomWindow.txt
'
'
' Présente 
'
' - 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

	' Quitte si (a) le lecteur n'existe pas ou, (b) si le répertoire construit existe déjà.

	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("Ma collection de paroles de chansons")
	TextStream.Close

	Set SubFolders = TestFolder.SubFolders

	Set SubFolder = SubFolders.Add("Beatles")

	CreateLyrics SubFolder	

	BuildTestDirectory = True

End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Routine principale
'
' Elle commence par créer un répertoire de test avec des sous-dossiers 
' et des fichiers.  
' Ensuite, elle affiche des informations relatives aux lecteurs de 
' disque disponibles et au répertoire de test, puis elle efface tout.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Main

	Dim FSO

	' Définit les données globales.
	TabStop = Chr(9)
	NewLine = Chr(10)
	
	Set FSO = CreateObject("Scripting.FileSystemObject")

	If Not BuildTestDirectory(FSO) Then 
		Print "Le répertoire de test existe déjà ou ne peut pas être créé.  Impossible de continuer."
		Exit Sub
	End If
	
	Print GenerateDriveInformation(FSO) & NewLine & NewLine

	Print GenerateTestInformation(FSO) & NewLine & NewLine

	Print GetLyrics(FSO) & NewLine & NewLine

	DeleteTestDirectory(FSO)
	
End Sub

previous page start next page