Listing 1.1 : Script HelloWorld2.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: HelloWorld2.vbs $ $Revision: 3 $ $Date: 12/04/98 3:19p $
' $Archive: /Scripts/HelloWorld2.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Simple échantillon WSH "Hello World!"
Option Explicit
Wscript.Echo Wscript.ScriptName & " $Revision: 3 $"
Wscript.Echo "Copyright (c) 1998 Tim Hill. All Rights Reserved."
' Ouvre IE et affiche la page about:blank pour nous fournir un document vide
Dim oIE, oIEDoc
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
Set oIEDoc = oIE.Document
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.MenuBar = False
oIE.Visible = True
' Emet maintenant le code HTML vers IE
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
oIEDoc.WriteLn "Echantillon de script HelloWorld2"
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
oIEDoc.WriteLn "Bienvenue dans Windows Scripting Host."
oIEDoc.Write ""
If Hour(Now) < 12 Then
oIEDoc.Write "Bonjour"
ElseIf Hour(Now) < 17 Then
oIEDoc.Write "Bonjour"
Else
oIEDoc.Write "Bonsoir"
End If
oIEDoc.WriteLn " tout le monde, il est " & Time & ""
oIEDoc.WriteLn "Attendez SVP."
oIEDoc.WriteLn "La fenêtre se fermera dans 10 secondes."
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
' Attendre dix secondes
Dim vStart
vStart = Now
Do While DateDiff("s", vStart, Now) < 10
Wscript.Sleep 1000
Loop
Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
Wscript.Quit 0
'////////////////////////////////////////////////////////////////////////////
Listing 2.1 : Script ShowArgs1.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ShowArgs1.vbs $ $Révision: 1 $ $Date: 12/02/98 11:34a $
' $Archive: /Scripts/ShowArgs1.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche les quatre premiers arguments de ligne de commande
Wscript.Echo "Vous avez saisi", Wscript.Arguments.Count, "les arguments"
On Error Resume Next
Wscript.Echo "Argument 0:", Wscript.Arguments(0)
Wscript.Echo "Argument 1:", Wscript.Arguments(1)
Wscript.Echo "Argument 2:", Wscript.Arguments(2)
Wscript.Echo "Argument 3:", Wscript.Arguments(3)
'////////////////////////////////////////////////////////////////////////////
Listing 2.2 : Script SphereStats.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: SphereStats.vbs $ $Revision: 2 $ $Date: 4/18/99 3:39p $
' $Archive: /Scripts/SphereStats.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Calcule la surface et le volume d'une sphère, étant donné le rayon
Option Explicit
Dim fRadius, fSurface, fVolume, PI
PI = 3.1415926
fRadius = Wscript.Arguments(0)
fSurface = 4 * PI * fRadius^2
fVolume = (4 * PI * fRadius^3) / 3
Wscript.Echo "Rayon :", fRadius, "Aire de surface :", fSurface, "Volume:", fVolume
'////////////////////////////////////////////////////////////////////////////
Listing 2.3 : Script ShowArgs2.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ShowArgs2.vbs $ $Revision: 4 $ $Date: 4/24/99 11:20a $
' $Archive: /Scripts/ShowArgs2.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche tous les arguments de ligne de commande
Option Explicit
Dim nIndex, sArg
Wscript.Echo "Vous avez saisi",Wscript.Arguments.Count,"les arguments"
' Utilise une boucle pour afficher tous les arguments
nIndex = 0
Do While nIndex < Wscript.Arguments.Count
Wscript.Echo "Argument " & nIndex & ":", Wscript.Arguments(nIndex)
nIndex = nIndex + 1
Loop
' Utilise l'itération pour afficher tous les arguments
For nIndex = 0 To Wscript.Arguments.Count - 1
Wscript.Echo "Argument " & nIndex & ":", Wscript.Arguments(nIndex)
Next
' Utilise l'itération de collection pour afficher tous les arguments
For Each sArg In Wscript.Arguments
If sArg = "fantôme" Then
Wscript.Echo "Le fantôme dans la machine !"
Else
Wscript.Echo "Argument :", sArg
End If
Next
'////////////////////////////////////////////////////////////////////////////
Listing 2.4 : Script QuickCalc.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: QuickCalc.vbs $ $Revision: 3 $ $Date: 4/18/99 7:18p $
' $Archive: /Scripts/QuickCalc.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Evalue tous les args de ligne de commande en tant qu'exprs et affiche résultat
Option Explicit
Dim sCmdLine, sArg, sResult
' Tout d'abord, assemble la ligne de commande complète
sCmdLine = ""
For Each sArg In Wscript.Arguments
If sCmdLine = "" Then
sCmdLine = sArg
Else
sCmdLine = sCmdLine & " " & sArg
End If
Next
' Evalue maintenant la ligne de commande
sResult = Eval(sCmdLine)
Wscript.Echo sCmdLine & "=" & sResult
Wscript.Quit(CInt(sResult))
'////////////////////////////////////////////////////////////////////////////
Listing 3.1 : Script VarType1.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: TypeVar1.vbs $ $Revision: 1 $ $Date: 4/28/99 8:40p $
' $Archive: /Scripts/TypeVar1.vbs $
' Copyright (c)1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche les types des variables WSH
Option Explicit
' Déclare certaines variables et affecte diverses valeurs et types
Dim A(10), B(2), x
A(0) = Empty ' Valeur Empty
A(1) = Null ' Valeur Null
A(2) = 10 ' Un entier
A(3) = 14.5 ' Valeur à virgule flottante
A(4) = #14/3/1952# ' Une date
A(5) = "Salut là-dedans" ' Une chaîne
A(6) = False ' Une valeur booléenne
A(7) = B ' Un tableau
' Affiche maintenant les types de variables
For x = 0 To UBound(A)
Wscript.Echo "Le type de A(" & x & ") est " & NomType(A(x)) _
& " (" & TypeVar(A(x)) & ")"
Next
'////////////////////////////////////////////////////////////////////////////
Listing 4.1 : Script ParseArgs1.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ParseArgs1.vbs $ $Revision: 1 $ $Date: 5/08/99 3:21p $
' $Archive: /Scripts/ParseArgs1.vbs $
' Copyright 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Analyse les arguments de commandes de la forme =
Listing 5.1 : Script DayOfWeek1.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: DayOfWeek1.vbs $ $Revision: 1 $ $Date: 5/22/99 3:39p $
' $Archive: /Scripts/DayOfWeek1.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche le jour de la semaine
Option Explicit
Wscript.Echo String(40, "-")
Wscript.Echo "DayOfWeek version 1.0"
Wscript.Echo "Copyright (c) 1999 The Acme Software Co."
Wscript.Echo String(40, "-")
Dim sArg
For Each sArg In Wscript.Arguments
If IsDate(sArg) Then
Wscript.Echo sArg, "est un", WeekdayName(Weekday(DateValue(sArg)))
End If
Next
'////////////////////////////////////////////////////////////////////////////
Listing 5.2 : Script DayOfWeek2.vbs
1 '////////////////////////////////////////////////////////////////////////////
2 ' $Workfile: DayOfWeek2.vbs $ $Revision: 1 $ $Date: 5/22/99 3:39p $
3 ' $Archive: /Scripts/DayOfWeek2.vbs $
4 ' Copyright (c) 1998 Tim Hill. All Rights Reserved.
5 '////////////////////////////////////////////////////////////////////////////
6 ' Affiche le jour de la semaine
7 Option Explicit
8 ShowBanner
9 ProcessArgs
10 Sub ProcessArgs
11 Dim sArg
12 For Each sArg In Wscript.Arguments
13 If IsDate(sArg) Then
14 Wscript.Echo sArg, "est un", WeekdayName(Weekday(DateValue(sArg)))
15 End If
16 Next
17 End Sub
18 Sub ShowBanner
19 Wscript.Echo String(40, "-")
20 Wscript.Echo "DayOfWeek version 1.0"
21 Wscript.Echo "Copyright (c) 1999 The Acme Software Co."
22 Wscript.Echo String(40, "-")
23 End Sub
24 '////////////////////////////////////////////////////////////////////////////
Listing 5.3 : Script VarType2.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: VarType2.vbs $ $Revision: 2 $ $Date: 5/29/99 5:31p $
' $Archive: /Scripts/VarType2.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche les types de variables
Option Explicit
' Déclare certaines variables et affecte diverses valeurs et types
Dim a(5), b(5), c(5), x
For x = 0 To UBound(a)
a(x) = 0
b(x) = x
c(x) = x * x
Next
c(5) = Array(#1/1/99#, 12.5, True)
c(4) = "Cela est une chaîne"
b(2) = c
a(4) = b
a(2) = Empty
a(3) = Null
x = 100
ShowVar 0, "x", x
ShowVar 0, "a", a
' ShowVar : Montre type de var, avec prise en charge type d'élément de tableau
' Arguments : nLevel=niveau de récursivité, sName=nom var, X=variable
Sub ShowVar(ByVal nLevel, ByVal sName, ByRef x)
Dim s, ix
s = space(nLevel * 4) & "Type of " & Chr(34) & sName & Chr(34) & ": " & TypeName(x)
If IsObject(x) Then
Wscript.Echo s & " (objet)"
ElseIf IsNull(x) Then
Wscript.Echo s & " (null)"
ElseIf IsEmpty(x) Then
Wscript.Echo s & " (vide)"
ElseIf IsArray(x) Then
Wscript.Echo s & " (tableau)..."
For ix = 0 to Ubound(x)
ShowVar nLevel + 1, sName & "(" & ix & ")", x(ix)
Next
Else
Wscript.Echo s & " valeur=", x
End If
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 6.1 : Script HelloWorld2.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: HelloWorld2.vbs $ $Revision: 3 $ $Date: 12/04/98 3:19p $
' $Archive: /Scripts/HelloWorld2.vbs $
' Copyright (c)1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Simple échantillon WSH "Hello World!"
Option Explicit
Wscript.Echo Wscript.ScriptName & " $Revision: 3 $"
Wscript.Echo "Copyright (c)1998 Tim Hill. All Rights Reserved."
' Ouvre IE et affiche la page about:blank pour nous fournir un document vide
Dim oIE, oIEDoc
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.MenuBar = False
oIE.Visible = True
' Envoie maintenant le code HTML à IE
Set oIEDoc = oIE.Document
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
oIEDoc.WriteLn "Echantillon de script HelloWorld2"
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
oIEDoc.WriteLn "Bienvenue dans Windows Scripting Host."
oIEDoc.Write ""
If Hour(Now) < 12 Then
oIEDoc.Write "Bonjour"
ElseIf Hour(Now) < 17 Then
oIEDoc.Write "Bonjour"
Else
oIEDoc.Write "Bonsoir"
End If
oIEDoc.WriteLn " tout le monde, il est " & Time & ""
oIEDoc.WriteLn " Attendez SVP."
oIEDoc.WriteLn "La fenêtre se fermera dans 10 secondes."
oIEDoc.WriteLn ""
oIEDoc.WriteLn ""
' Attendre dix secondes
Dim vStart
vStart = Now
Do While DateDiff("s", vStart, Now) < 10
Wscript.Sleep 1000
Loop
Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
Wscript.Quit 0
'////////////////////////////////////////////////////////////////////////////
Listing 7.1 : Script RegExp.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ShowArgs2.vbs $ $Revision: 5 $ $Date: 4/24/99 11:36a $
' $Archive: /Scripts/ShowArgs2.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Traite une structure de comparaison d'expression régulière
' D'abord structure de comparaison arg=regexp, ensuite chaîne arg=search
Option Explicit
' Vérifie si les arguments de ligne de commande sont suffisants
Dim sPattern, sSearch
If Wscript.Arguments.Count < 2 Then
Wscript.Echo "usage: regexp "
Wscript.Quit(1)
End If
sPattern = Wscript.Arguments(0)
sSearch = Wscript.Arguments(1)
' Effectue la correspondance d'expression régulière
Dim oRE, oMatches
Set oRE = New RegExp
oRE.Global = True
oRE.IgnoreCase = True
oRE.Pattern = sPattern
Set oMatches = oRE.Execute(sSearch)
' Traite maintenant toutes les correspondances (s'il y en a)
Dim oMatch
Wscript.Echo "Chaîne de Structure: " & Chr(34) & sPattern & Chr(34)
Wscript.Echo "Chaîne de Recherche: " & Chr(34) & sSearch & Chr(34) & vbCRLF
Wscript.Echo oMatches.Count, "Correspondances:"
Wscript.Echo " " & sSearch
For Each oMatch In oMatches
Wscript.Echo " " & String(oMatch.FirstIndex, " ") & String(oMatch.Length, "^")
Next
'////////////////////////////////////////////////////////////////////////////
Listing 8 : Script SplitPath.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: SplitPath.vbs $ $Revision: 1 $ $Date: 6/23/99 11:15a $
' $Archive: /Scripts/SplitPath.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Décompose chaque argument en nom de chemin
Option Explicit
Dim sArg, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Traite chaque argument
For Each sArg In Wscript.Arguments
ShowComponents sArg, 0
Next
Set oFSO = Nothing
'////////////////////////////////////////////////////////////////////////////
' ShowComponents
' Affiche les composants distincts à partir des noms de chemin passés
'
' sPath Nom de chemin à décomposer
' nLevel Niveau de récursivité pour la mise en retrait
'
Sub ShowComponents(sPath, nLevel)
Dim sAbsPath, sIndent
sIndent = Space(nLevel * 4)
' Interrompt la récursivité quand le chemin est vide
If sPath = "" Then Exit Sub
Wscript.Echo sIndent & "Décompose : " & Chr(34) & sPath & Chr(34)
sAbsPath = oFSO.GetAbsolutePathName(sPath)
Wscript.Echo sIndent & " Chemin absolu : " & sAbsPath
Wscript.Echo sIndent & " Fichier valide : " & CBool(oFSO.FileExists(sAbsPath))
Wscript.Echo sIndent & " Chemin valide : " & CBool(oFSO.FolderExists(sAbsPath))
Wscript.Echo sIndent & " Nom de fichier : " & oFSO.GetFileName(sAbsPath)
Wscript.Echo sIndent & " Nom de base : " & oFSO.GetBaseName(sAbsPath)
Wscript.Echo sIndent & " Extension : " & oFSO.GetExtensionName(sAbsPath)
Wscript.Echo sIndent & " Nom de disque : " & oFSO.GetDriveName(sAbsPath)
Wscript.Echo
' Décompose maintenant récursivement le dossier parent
ShowComponents oFSO.GetParentFolderName(sAbsPath), nLevel + 1
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 8.2 : Script DriveInfo.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: DriveInfo.vbs $ $Revision: 2 $ $Date: 7/04/99 12:33p $
' $Archive: /Scripts/DriveInfo.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Afficher les informations concernant le disque spécifié
Option Explicit
Dim sArg, oFSO, sDriveName, sType
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Obtenir nom de fichier absolu depuis ligne de commande, puis obtenir nom disque
If Wscript.Arguments.Count < 1 Then Wscript.Quit(1)
sArg = oFSO.GetAbsolutePathName(Wscript.Arguments(0))
sDriveName = oFSO.GetDriveName(sArg)
' obtenir les propriétés d'objet et afficher les propriétés
With oFSO.GetDrive(sDriveName)
Wscript.Echo "Taille totale du disque (Ko):", .TotalSize / 1024
Wscript.Echo "Espace disponible (Ko) :", .AvailableSpace / 1024
Wscript.Echo "Espace libre (KB) :", .FreeSpace / 1024
Wscript.Echo "Lettre de disque :", .DriveLetter
Wscript.Echo "Nom de partage UNC :", .ShareName
Wscript.Echo "Nom de volume :", .VolumeName
Wscript.Echo "Chemin :", .Path
Wscript.Echo "Numéro de série :", Hex(.SerialNumber)
Wscript.Echo "Système de fichiers :", .FileSystem
Wscript.Echo "Disque prêt :", CBool(.IsReady)
Select Case .DriveType
Case 1: sType = "Amovible"
Case 2: sType = "Fixe"
Case 3: sType = "Réseau"
Case 4: sType = "CD-ROM"
Case 5: sType = "Disque RAM"
Case Else sType = "Inconnu"
Ernd Select
Wscript.Echo "Type de disque :", sType
End With
Set oFSO = Nothing
'////////////////////////////////////////////////////////////////////////////
Listing 8.3 : Script FolderInfo.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: FolderInfo.vbs $ $Revision: 1 $ $Date: 7/03/99 7:27p $
' $Archive: /Scripts/FolderInfo.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Afficher les informations concernant le dossier spécifié
Option Explicit
Dim sArg, oFSO, oFolder, sAttr, nAttr
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Obtenir le nom de chemin absolu à partir de la ligne de commande, puis obtenir le nom du disque
If Wscript.Arguments.Count < 1 Then Wscript.Quit(1)
sArg = oFSO.GetAbsolutePathName(Wscript.Arguments(0))
' Obtenir l'objet folder et afficher ses propriétés
Set oFolder = oFSO.GetFolder(sArg)
Wscript.Echo "Disque contenant le dossier :", oFolder.Drive
Wscript.Echo "Dossier racine ? :", oFolder.IsRootFolder
Wscript.Echo "Nom de dossier ? :", oFolder.Name
Wscript.Echo "Chemin :", oFolder.Path
Wscript.Echo "Nom court (MSDOS) :", oFolder.ShortName
Wscript.Echo "Nom court (MSDOS) :", oFolder.ShortPath
Wscript.Echo "Size (files+subfolders) :", oFolder.Size
Wscript.Echo "Folder type :", oFolder.Type
If Not oFolder.IsRootFolder Then
Wscript.Echo "Date créée :", oFolder.DateCreated
Wscript.Echo "Date de dernier accès :", oFolder.DateLastAccessed
Wscript.Echo "Date de dernière modification :", oFolder.DateLastModified
Wscript.Echo "Nom du dossier parent :", oFolder.ParentFolder.Name
End If
nAttr = oFolder.Attributes
Wscript.Echo "Attributs :", Hex(nAttr)
sAttr = ""
If nAttr And 1 Then sAttr = sAttr & "Lecture seule "
If nAttr And 2 Then sAttr = sAttr & "Masqué "
If nAttr And 4 Then sAttr = sAttr & "Système "
If nAttr And 8 Then sAttr = sAttr & "Volume "
If nAttr And 16 Then sAttr = sAttr & "Dossier "
If nAttr And 32 Then sAttr = sAttr & "Archive "
If nAttr And 64 Then sAttr = sAttr & "Alias "
If nAttr And 128 Then sAttr = sAttr & "Compressé "
Wscript.Echo " " & sAttr
Set oFolder = Nothing
Set oFSO = Nothing
'////////////////////////////////////////////////////////////////////////////
Listing 8.4 : VBTree.vbs Script
'////////////////////////////////////////////////////////////////////////////
' $Workfile: VBTree.vbs $ $Revision: 1 $ $Date: 7/03/99 6:49p $
' $Archive: /Scripts/VBTree.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Montrer une arborescence de répertoire simple
Option Explicit
Dim sArg, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Obtenir le dossier (le dossier par défaut est le dossier en cours)
If Wscript.Arguments.Count > 0 Then
sArg = Wscript.Arguments(0)
Else
sArg = "."
End If
sArg = oFSO.GetAbsolutePathName(sArg)
' Traiter l'arborescence entière (si le dossier est valide)
If oFSO.FolderExists(sArg) Then
Wscript.Echo "Arbre des dossiers de :", sArg
ShowTree "", oFSO.GetFolder(sArg)
End If
Set oFSO = Nothing
Wscript.Quit(0)
'////////////////////////////////////////////////////////////////////////////
' ShowTree
' Montrer un niveau de l'arborescence du dossier
'
' sIndent Mettre en retrait la chaîne
' oFolder Objet dossier pour ce niveau dans l'arborescence
'
Sub ShowTree(sIndent, oFolder)
Dim oSubFolder, ix
ix = 1
For Each oSubFolder In oFolder.SubFolders
Wscript.Echo sIndent & "+-" & oSubFolder.Name
If ix <> oFolder.SubFolders.Count Then
ShowTree sIndent & "| ", oSubFolder
Else
ShowTree sIndent & " ", oSubFolder
End If
ix = ix + 1
Next
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 8.5 : Script FileInfo.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: FileInfo.vbs $ $Revision: 1 $ $Date: 7/04/99 1:16p $
' $Archive: /Scripts/FileInfo.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Affiche les informations concernant le fichier spécifié
Option Explicit
Dim sArg, oFSO, oFile, sAttr, nAttr
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Obtenir le nom absolu du fichier depuis la ligne de commande, puis obtenir le nom du disque
If Wscript.Arguments.Count < 1 Then Wscript.Quit(1)
sArg = oFSO.GetAbsolutePathName(Wscript.Arguments(0))
' Obtenir l'objet fichier et afficher ses propriétés
Set oFile = oFSO.GetFile(sArg)
Wscript.Echo "Disque contenant le fichier :", oFile.Drive
Wscript.Echo "Nom de fichier :", oFile.Name
Wscript.Echo "Chemin :", oFile.Path
Wscript.Echo "Nom MS-DOS (court) :", oFile.ShortName
Wscript.Echo "Chemin MS-DOS (court) :", oFile.ShortPath
Wscript.Echo "Taille :", oFile.Size
Wscript.Echo "Type de fichier :", oFile.Type
Wscript.Echo "Date créée :", oFile.DateCreated
Wscript.Echo "Date de dernier accès :", oFile.DateLastAccessed
Wscript.Echo "Date de dernière modification :", oFile.DateLastModified
Wscript.Echo "Nom de dossier parent :", oFile.ParentFolder.Name
nAttr = oFile.Attributes
Wscript.Echo "Attributs :", Hex(nAttr)
sAttr = ""
If nAttr And 1 Then sAttr = sAttr & "Lecture seule "
If nAttr And 2 Then sAttr = sAttr & "Masqué "
If nAttr And 4 Then sAttr = sAttr & "Système "
If nAttr And 8 Then sAttr = sAttr & "Volume "
If nAttr And 16 Then sAttr = sAttr & "Dossier "
If nAttr And 32 Then sAttr = sAttr & "Archive "
If nAttr And 64 Then sAttr = sAttr & "Alias "
If nAttr And 128 Then sAttr = sAttr & "Compressé "
Wscript.Echo " " & sAttr
Set oFile = Nothing
Set oFSO = Nothing
'////////////////////////////////////////////////////////////////////////////
Listing 8.6 : Script ShowINFSection.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ShowINFSection.vbs $ $Revision: 1 $ $Date: 7/04/99 3:13p $
' $Archive: /Scripts/ShowINFSection.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Expressions régulières pour extraire une section INF d'un fichier INF
Option Explicit
Dim sArg, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' S'il n'y a pas d'arguments, afficher bref usage
If Wscript.Arguments.Count < 2 Then
Wscript.Echo "usage : showinfsection section-nom INF-fichier"
Wscript.Quit(0)
End If
' Préparer les objets expressions régulières
Dim oREStart, oREEnd
Set oREStart = new RegExp
Set oREEnd = new RegExp
oREStart.Pattern = "^\s*\[\s*" & Wscript.Arguments(0) & "\s*\]\s*$"
oREStart.IgnoreCase = True
oREEnd.Pattern = "^\s*\[.*\]\s*$"
' Préparer le flux de saisie
Dim oStream, nState, sLine
Set oStream = oFSO.OpenTextFile(Wscript.Arguments(1))
nState = 0
Do Until oStream.AtEndOfStream
sLine = oStream.ReadLine
Select Case nState
Case 0: ' Etat 0 : Section avant
If oREStart.Test(sLine) Then nState = 1
Case 1: ' Etat 1 : Section au-dedans
If oREEnd.Test(sLine) Then
nState = 2
Else
Wscript.Echo sLine
End If
Case 2: ' Etat 3 : section après
End Select
Loop
Set oStream = Nothing
Set oREStart = Nothing
Set oREEnd = Nothing
'////////////////////////////////////////////////////////////////////////////
Listing 8.7 : Script Tee.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: SplitPath.vbs $ $Revision: 1 $ $Date: 6/23/99 11:15a $
' $Archive: /Scripts/SplitPath.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Sortie en "T" vers un fichier (comme un joint de plomberie en T)
Option Explicit
Dim sArg, oFSO, oStream, oStdIn, oStdOut, sLine
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Définit le flux de texte oStream depuis argument de ligne de commande
If Wscript.Arguments.Count > 0 Then
Set oStream = oFSO.CreateTextFile(Wscript.Arguments(0), True)
Else
Set oStream = Nothing
End If
' Copie maintenant StdIn vers StdOut et oStream
Set oStdIn = Wscript.StdIn
Set oStdOut = Wscript.StdOut
Do Until oStdIn.AtEndOfStream
sLine = oStdIn.ReadLine
oStdOut.WriteLine sLine
If Not oStream Is Nothing Then oStream.WriteLine sLine
Loop
Set oStdOut = Nothing
Set oStdIn = Nothing
Set oStream = Nothing
Wscript.Quit(0)
'////////////////////////////////////////////////////////////////////////////
Listing 8.8 : Script VBGrep.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: SplitPath.vbs $ $Revision: 1 $ $Date: 6/23/99 11:15a $
' $Archive: /Scripts/SplitPath.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Utiliser des expressions régulières pour filtrer les lignes dans un ou plusieurs ' fichiers
Option Explicit
Dim sArg, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' S'il n'y a pas d'argument, afficher utilisation brève
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "usage: vbgrep reg-exp [folders]"
Wscript.Echo "Si aucun dossier, lit stdin"
Wscript.Quit(0)
End If
' Préparer l'objet expression régulière
Dim oRE
Set oRE = new RegExp
oRE.Pattern = Wscript.Arguments(0)
' Traiter maintenant l'entrée
Dim nMatchCount, ix, oFolder, oFile, oStream
nMatchCount = 0
If Wscript.Arguments.Count < 2 Then
nMatchCount = nMatchCount + GrepStream(Wscript.StdIn, oRE, Wscript.StdOut)
Else
For ix = 1 To Wscript.Arguments.Count - 1
sArg = Wscript.Arguments(ix)
If oFSO.FolderExists(sArg) Then
Set oFolder = oFSO.GetFolder(sArg)
For Each oFile In oFolder.Files
Set oStream = oFile.OpenAsTextStream(1)
nMatchCount = nMatchCount + GrepStream(oStream, oRE, Wscript.StdOut)
Set oStream = Nothing
Next
Set oFolder = Nothing
Else
Wscript.Echo sArg,"non trouvé"
End If
Next
End If
Set oRE = Nothing
Set oFSO = Nothing
Wscript.Quit(nMatchCount)
'////////////////////////////////////////////////////////////////////////////
' GrepStream
' Filtre un flux de texte en se fondant sur un objet expression régulière
'
' oStream Flux de texte à filtrer
' oRE Expression régulière pour le filtre
' oOutput Flux de sortie pour le résultat
' Renvoie Nombre de lignes correspondantes
'
Function GrepStream(oStream, oRE, oOutput)
Dim sLine, nCount
' Traiter chaque ligne de flux de sortie
nCount = 0
Do Until oStream.AtEndOfStream
sLine = oStream.ReadLine
' Si RE correspond, envoyer ligne vers flux de sortie
If oRE.Test(sLine) Then
oOutput.WriteLine sLine
nCount = nCount + 1
End If
Loop
GrepStream = nCount
End Function
'////////////////////////////////////////////////////////////////////////////
Listing 9.1 : Script CountUNCNames.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: CountUNCNames.vbs $ $Revision: 1 $ $Date: 7/05/99 11:23a $
' $Archive: /Scripts/CountUNCNames.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Compter les noms UNC sur la ligne de commande, répartis selon les indices pairs ' et impairs
Option Explicit
Dim oOddCount, oEvenCount, sArg, ix
Set oOddCount = New UNCCount
Set oEvenCount = New UNCCount
oOddCount.Reset : oEvenCount.Reset
For ix = 0 To Wscript.Arguments.Count - 1
sArg = Wscript.Arguments(ix)
If ix And 1 Then
oOddCount.AddName sArg
Else
oEvenCount.AddName sArg
End If
Next
Wscript.Echo oOddCount.Count, oEvenCount.Count
'////////////////////////////////////////////////////////////////////////////
' Classe de compteur UNC - compte les noms UNC
'
Class UNCCount
Public Count
' Initialiser toutes les propriétés
Public Sub Reset
Count = 0
End Sub
' Ajouter un nom (si c'est un nom UNC)
Public Sub AddName(sName)
If Left(sName, 2) = "\\" Then Count = Count + 1
End Sub
End Class
'////////////////////////////////////////////////////////////////////////////
Listing 9.2 : Script RDir.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: RDir.vbs $ $Revision: 2 $ $Date: 7/07/99 9:28p $
' $Archive: /Scripts/RDir.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Fichier d'expressions régulières utilisant la classe FileScan
Option Explicit
Dim oFileScan, oFSO, ix
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Montrer usage si pas d'arguments
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "usage : rdir reg-expr [chemin...]"
Wscript.Quit(0)
End If
' Créer l'objet FileScan et définir RE depuis la ligne de commande
Set oFileScan = New FileScan
oFileScan.Expr = Wscript.Arguments(0)
oFileScan.ScanSubFolders = True
' Traiter maintenant tous les arguments, ou utiliser le rép en cours si aucun
If Wscript.Arguments.Count > 1 Then
For ix = 1 To Wscript.Arguments.Count - 1
oFileScan.Execute oFSO.GetAbsolutePathName(Wscript.Arguments(ix))
Next
Else
oFileScan.Execute oFSO.GetAbsolutePathName(".")
End If
' Afficher les résultats
For ix = 0 To oFileScan.Count
Wscript.Echo oFileScan(ix)
Next
Wscript.Quit(oFileScan.Count)
'////////////////////////////////////////////////////////////////////////////
' FileScan
' Classe File scan, construit collection de fichiers selon une expr régulière
'
Class FileScan
Public Expr ' Expr rég à faire correspondre
Public MatchFullPath ' True pour faire correspondre chemin complet
Public ScanSubFolders ' True pour scanner sous-dossiers
Private sFiles ' Liste de fichiers correspondants
Private nCount ' Compte de correspondances
' Initialiser l'objet (supprimer toutes les correspondances de fichiers)
Public Sub Reset
nCount = 0 ' Ne marquer aucun fichier
sFiles = Empty ' Vider les tableaux de fichiers
End Sub
' Renvoyer le compte de fichiers en cours (R/O)
Public Property Get Count
Count = CInt(nCount) ' Renvoyez simplement le compte
End Property
' Exécuter recherche (construire liste fichiers)
Public Sub Execute(sPath)
Dim oFSO, oFolder, oRE
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath) ' Obtenir le chemin de fichier
Set oRE = New RegExp
oRE.Pattern = Expr ' Définir structure de comparaison
oRE.IgnoreCase = True ' Ignorer la casse
MatchFiles oRE, oFolder ' Faire correspondre fichiers ici
End Sub
Private Sub MatchFiles(oRE, oFolder) ' Faire corresp fichiers dans dossier
Dim oFile, oSubFolder
For Each oFile In oFolder.Files ' Parcourir tous fichiers
If MatchFullPath Then
If oRE.Test(oFile.Path) Then ' Corresp chemin complet
AddFile oFile.Path ' Ajouter si correspond
End If
Else
If oRE.Test(oFile.Name) Then ' Faire corresp nom
AddFile oFile.Path ' Ajouter si corresp
End If
End If
Next
If ScanSubFolders Then ' Si nécessaire..
For Each oSubFolder In oFolder.SubFolders ' Parcourir sous-dossiers
MatchFiles oRE, oSubFolder
Next
End If
End Sub
' Obtenir les fichiers distincts (propriété par défaut)
Public Default Property Get Item(nIndex) ' Obtenir élément indexé
Dim ixMajor, ixMinor
If (nIndex >= nCount) Or (nIndex >= 1024 * 4096) Then
Item = "" 'Fanion débordement
Else
ixMajor = nIndex / 4096 ' Calculer indice principal
ixMinor = nIndex And 4095 ' Calculer indice secondaire
Item = sFiles(ixMajor)(ixMinor) ' Obtenir nom de chemin
End If
End Property
' Ajouter nouvel élément fichier au tableau dynamique
Private Sub AddFile(sPath)
Dim ix, ixMajor, ixMinor, a ' Index de tableau
If IsEmpty(sFiles) Then ' Si encore aucun tableau..
ReDim sFiles(1023) ' Espace pour 1024 jeux
End If
ix = nCount ' Obtenir indice en cours
nCount = nCount + 1 ' Compteur complémentaire
If ix >= 1024 * 4096 Then Exit Sub ' Quitter si déborde !!
ixMajor = ix / 4096 ' Calculer indice principal
ixMinor = ix And 4095 ' Calculer indice secondaire
If IsEmpty(sFiles(ixMajor)) Then ' Si besoin nouveau tableau
ReDim a(4095) ' Créer tableau provisoire
sFiles(ixMajor) = a ' Copier pour peupler
End If
sFiles(ixMajor)(ixMinor) = sPath ' Ajouter chemin au tableau
End Sub
End Class
Listing 10.1 : Composant Simple.wsc
Listing 10.2 : Script UseSimple.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: UseSimple.vbs $ $Revision: 1 $ $Date: 7/13/99 9:57a $
' $Archive: /Scripts/UseSimple.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Echantillon WSH "Hello World!" simple
Option Explicit
Dim oSimple
Set oSimple = CreateObject("Simple.WSC")
Wscript.Echo oSimple.Hello
Set oSimple = Nothing
'////////////////////////////////////////////////////////////////////////////
Listing 10.3 : Composant FileScan.wsc
Listing 10.4 : Script Rdir2.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: RDir2.vbs $ $Revision: 1 $ $Date: 7/13/99 9:57a $
' $Archive: /Scripts/RDir2.vbs $
' Copyright (c) 1999 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Fichier de recherche d'expressions régulières utilisant la classe FileScan
Option Explicit
Dim oFileScan, oFSO, ix
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Montrer usage si pas d'argument
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "usage: filescan reg-expr [path...]"
Wscript.Quit(0)
End If
' Créer objet FileScan et définir le RE depuis la ligne de commande
Set oFileScan = CreateObject("FileScan.WSC")
oFileScan.Expr = Wscript.Arguments(0)
oFileScan.ScanSubFolders = True
' Traiter maintenant tous les arguments, ou utiliser rép en cours si aucun
If Wscript.Arguments.Count > 1 Then
For ix = 1 To Wscript.Arguments.Count - 1
oFileScan.Execute oFSO.GetAbsolutePathName(Wscript.Arguments(ix))
Next
Else
oFileScan.Execute oFSO.GetAbsolutePathName(".")
End If
' Afficher résultats
For ix = 0 To oFileScan.Count
Wscript.Echo oFileScan(ix)
Next
Wscript.Quit(oFileScan.Count)
Listing 11.1 : Script Template.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: Template.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/Template.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Modèle de création de scripts
' Déclaration explicite de variables et variables globales
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir variables globales et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Définir contrôle de suivi depuis variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Vérifier présence de requêtes d'aide -help, -? etc sur ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction principale appelée pour incorporer logique principale du script
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
' Val de renvoi est passé à Wscript.Quit comme code de sortie du script
Main = 0
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "Placer ici du texte d'aide."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Sortie suivi débogage contrôlée par var env g_nTraceLevel et WSHTRACE
'
' nLevel Niveau de suivi. Afficher seulement si <= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel >= nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 11.2 : Bibliothèque de composants MTPLib.wsc
MTP Library
Copyright (c) 1998-99 Tim Hill. All Rights Reserved.
1.0
Listing 12.1 : Script MTPLogon.bat
@echo OFF
if not "%ECHO%"=="" echo %ECHO%
rem $Workfile: MTPLogon.bat $ $Revision: 1 $ $Date: 7/25/99 12:59p $
rem Copyright (c) 1998 Tim Hill. All Rights Reserved.
set MTPLOGONVER=$Revision: 1 $
set WSHVERSION=510
set VBSVERSION=500
set WSHINSTALL=%0\..\WSH20EN.EXE /Q
set VBSINSTALL=%0\..\STE50EN.EXE /Q
set SCRIPTDIR=c:\Scripts
set SRCDIR=%0\..\LocalScripts
echo %%0=%0
rem Branch selon plate-forme OS (WSH ou non-WSH)
if "%windir%"=="" goto :NOWSH
if exist %windir%\system\kernel32.dll goto :WSHOK
if exist %windir%\system32\kernel32.dll goto :WSHOK
goto :NOWSH
:WSHOK
echo Exécution du script WSH...
rem Installer WSH si pas trouvé...
if exist %windir%\command\cscript.exe goto :WSHFOUND
if exist %windir%\system\cscript.exe goto :WSHFOUND
if exist %windir%\system32\cscript.exe goto :WSHFOUND
%WSHINSTALL%
:WSHFOUND
rem Installer VBScript si pas trouvé...
if exist %windir%\system\vbscript.dll goto :VBSFOUND
if exist %windir%\system32\vbscript.dll goto :VBSFOUND
%VBSINSTALL%
:VBSFOUND
rem Mise à jour WSH si nécessaire...
cscript //i //nologo %0\..\checkwshversion.vbs %WSHVERSION%
if errorlevel 1 %WSHINSTALL%
rem Mise à jour VBScript si nécessaire...
cscript //i //nologo %0\..\checkvbsversion.vbs %VBSVERSION%
if errorlevel 1 %VBSINSTALL%
rem Installation et inscription des scripts locaux
if not exist %SCRIPTDIR%\*.* md %SCRIPTDIR%
attrib -r -s -h %SCRIPTDIR%
rem del %SCRIPTDIR%\*.*
copy %SRCDIR% %SCRIPTDIR%
for %%i in (%SCRIPTDIR%\*.wsc) do regsvr32 /s /c scrobj.dll /n /i:file:%%i
rem Exécuter maintenant le script de connexion de phase 2...
cscript //i //nologo %0\..\mtplogon.vbs
goto :EXIT
rem Nous arrivons ici si nous fonctionnons sur une plate-forme non-WSH
:NOWSH
echo Exemption du script non-WSH...
if exist %0\..\doslogon.bat call %0\..\doslogon.bat
goto :EXIT
rem Dépannage spécial pour fin de script de connexion boguée
:EXIT
if exist c:\windows\*.* echo . >c:\windows\lmscript.$$$
if exist c:\win95\*.* echo . >c:\win95\lmscript.$$$
if exist c:\win98\*.* echo . >c:\win98\lmscript.$$$
Listing 12.2 : Script CheckWSHVersion.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: CheckWSHVersion.vbs $ $Revision: 1 $ $Date: 7/25/99 12:59p $
' $Archive: /Scripts/CheckWSHVersion.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Vérifie la version de WSH et renvoie zéro si ok, non-zéro si besoin mise à jour
Dim nVersion
nVersion = CInt(Wscript.Version * 100)
Wscript.Echo "Cela est la version : " & nVersion
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "usage : checkwshversion "
Wscript.Echo " doit être 120 pour la version 1.20, etc."
Wscript.Echo "Renvoie 0 si ok, 1 si besoin mise à jour version"
Wscript.Quit(0)
End If
If nVersion < CInt(Wscript.Arguments(0)) Then
Wscript.Quit(1)
Else
Wscript.Quit(0)
End If
Listing 12.3 : Script CheckVBSVersion.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: CheckVBSVersion.vbs $ $Revision: 1 $ $Date: 7/25/99 12:59p $
' $Archive: /Scripts/CheckVBSVersion.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Vérifie version VBScript et renvoie 0 si ok, non-zéro si besoin mise à jour
Dim nVersion
nVersion = CInt((ScriptEngineMajorVersion * 100) + ScriptEngineMinorVersion)
Wscript.Echo "Cela est la version : " & nVersion
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "usage : checkvbsversion "
Wscript.Echo " doit être 120 pour la version 1.20, etc."
Wscript.Echo "Renvoie 0 si ok, 1 si besoin mise à jour version"
Wscript.Quit(0)
End If
If nVersion < CInt(Wscript.Arguments(0)) Then
Wscript.Quit(1)
Else
Wscript.Quit(0)
End If
Listing 12.4 : Script MTPLogon.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: MTPLogon.vbs $ $Revision: 4 $ $Date: 7/25/99 3:17p $
' $Archive: /Scripts/MTPLogon.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Script de connexion de Phase 2
' Déclaration variables explicites et globales standards
Option Explicit
Dim g_oShell, g_oFSO, g_oNet, g_oGroupDict
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
Set g_oNet = CreateObject("Wscript.Network")
' Un mappage de disque comprend ","
' Ur * dans les deux champs pour le disque ou répertoire d'accueil
Dim g_sDriveMap(25)
g_sDriveMap(0) = "J:,\\K140\JAZDRIVE"
g_sDriveMap(1) = "L:,\\K140\LIBRARY"
g_sDriveMap(2) = "S:,\\K140\SETUP"
g_sDriveMap(3) = "P:,*"
g_sDriveMap(4) = "K:,\\K140\COMMON"
g_sDriveMap(5) = "R:,\\K140\C$"
' Mapper disques selon table de mappage de disque
Dim sMap, bResult, sItems
For Each sMap In g_sDriveMap
If Not IsEmpty(sMap) Then
sItems = Split(sMap, ",")
bResult = MapDrive(sItems(0), sItems(1))
If Not bResult Then Wscript.Echo "*** FAILED"
End If
Next
' Mapper disque selon appartenance au groupe
If IsMember("Domain Admins") Then
bResult = MapDrive("W:", "\\K140\NetApps")
If Not bResult Then Wscript.Echo "*** FAILED"
End If
Wscript.Quit(0)
'////////////////////////////////////////////////////////////////////////////
' IsMember
' Tester pour voir si l'utilisateur appartient au groupe spécifié
'
' sGroup Nom du groupe
' Renvoie True si utilisateur est membre du groupe
'
Function IsMember(sGroup)
Dim sAdsPath, oUser, oGroup
' Peupler dictionnaire si pas encore créé
If IsEmpty(g_oGroupDict) Then
Set g_oGroupDict = CreateObject("Scripting.Dictionary")
g_oGroupDict.CompareMode = vbTextCompare
sAdsPath = g_oNet.UserDomain & "/" & g_oNet.UserName
Set oUser = GetObject("WinNT://" & sAdsPath & ",user")
For Each oGroup In oUser.Groups
g_oGroupDict.Add oGroup.Name, "-"
Next
Set oUser = Nothing
End If
IsMember = CBool(g_oGroupDict.Exists(sGroup))
End Function
'////////////////////////////////////////////////////////////////////////////
' MapDrive
' Mapper un disque réseau comme spécifié
'
' g_oFSO Objet FileSystem
' g_oNet Objet WshNetwork
' sPath Nom chemin pour disque ou * (peut être relatif)
' sUNCPath Chemin UNC vers partage ou * pour accueil (\\computer\sharename)
' Renvoie True si disque bien mappé, sinon erreur
'
Function MapDrive(ByVal sPath, ByVal sUNCPath)
Dim nExit, sAdsPath, oAdsObj, sComputer, sShare, x, sDrive, sLocalPath
' Si nécessaire, obtenir rép ou disque d'accueil
If sPath = "*" Or sUNCPath = "*" Then
sAdsPath = g_oNet.UserDomain & "/" & g_oNet.UserName
Set oAdsObj = GetObject("WinNT://" & sAdsPath & ",user")
If sPath = "*" Then sPath = oAdsObj.HomeDirDrive
If sUNCPath = "*" Then sUNCPath = oAdsObj.HomeDirectory
Set oAdsObj = Nothing
End If
' Valider les paramètres, puis analyser le nom UNC
If sPath = "" Or sUNCPath = "" Then
MapDrive = False : Exit Function
End If
x = Split(sUNCPath, "\")
If UBound(x) < 3 Then
MapDrive = False : Exit Function
End If
sComputer = x(2) : sShare = x(3)
sDrive = GetDriveName(sPath)
Wscript.Echo "Mappe : " & sDrive & " -> " & sUNCPath
' Essayer de démapper ou unSUBST le disque
UnmapDrive(sDrive)
' Ne peut mapper disque local
If IsLocalDrive(sDrive) Then
MapDrive = False : Exit Function
End If
' Si possible, utiliser SUBST, car plus rapide que boucle locale en retour
If IsWinNT And StrComp(sComputer, g_oNet.ComputerName, vbTextCompare) = 0 Then
sAdsPath = sComputer & "/lanmanserver/" & sShare
Set oAdsObj = GetObject("WinNT://" & sAdsPath & ",fileshare")
sLocalPath = oAdsObj.Path
Set oAdsObj = Nothing
nExit = RunCmd("subst " & sDrive & " " & sLocalPath)
' Terminé si bon mappage SUBST
If nExit = 0 Then
MapDrive = True : Exit Function
End If
End If
' Mapper le disque réseau et renvoyer le résultat
g_oNet.MapNetworkDrive sDrive, sUNCPath
MapDrive = IsNetworkDrive(sDrive)
End Function
'////////////////////////////////////////////////////////////////////////////
' UnmapDrive
' Supprimer mappage d'un disque réseau (ou un d'un disque SUBST sous WinNT)
'
' g_oFSO Objet FileSystem
' g_oNet Objet WshNetwork
' sPath Nom de chemin pour disque (peut être relatif)
'
Sub UnmapDrive(sPath)
Dim nExit, sDrive
sDrive = GetDriveName(sPath)
' Sous WinNT, disques SUBST apparaissent comme locaux
If IsWinNT And IsLocalDrive(sDrive) Then
nExit = RunCmd("subst " & sDrive & " /d")
End If
' Ne peut démapper que les disques réseau
If IsNetworkDrive(sDrive) Then
g_oNet.RemoveNetworkDrive sDrive, True, True
End If
End Sub
'////////////////////////////////////////////////////////////////////////////
' IsNetworkDrive
' Teste si un disque est un disque mis en réseau
'
' g_oFSO Objet FileSystem
' sPath Nom de chemin du disque (peut être relatif)
' Renvoie True si disque est mis en réseau, False sinon
Function IsNetworkDrive(sPath)
Dim oDrive
Set oDrive = GetDriveObject(sPath)
' Teste type si disque valide
If Not oDrive Is Nothing Then
IsNetworkDrive = CBool(oDrive.DriveType = 3)
Else
IsNetworkDrive = False
End If
End Function
'////////////////////////////////////////////////////////////////////////////
' IsLocalDrive
' Teste si un disque est local (tout type)
'
' g_oFSO Objet FileSystem
' sPath Nom chemin pour disque (peut être relatif)
' Renvoie True si disque est local, False sinon
'
Function IsLocalDrive(sPath)
Dim oDrive
Set oDrive = GetDriveObject(sPath)
' Teste type si disque valide
If Not oDrive Is Nothing Then
IsLocalDrive = CBool(oDrive.DriveType <> 3)
Else
IsLocalDrive = False
End If
End Function
'////////////////////////////////////////////////////////////////////////////
' GetDriveObject
' Obtient objet disque FSO avec vérification erreurs
'
' g_oFSO Objet FileSystem
' sPath Nom de chemin pour disque (peut être relatif)
' Renvoie Objet disque ou Nothing si le disque n'existe pas
'
Function GetDriveObject(sPath)
On Error Resume Next
Set GetDriveObject = Nothing
Set GetDriveObject = g_oFSO.GetDrive(GetDriveName(sPath))
If Err.Number <> 0 Then Set GetDriveObject = Nothing
End Function
'////////////////////////////////////////////////////////////////////////////
' GetDriveName
' Obtient nom du disque à partir du nom de chemin
'
' g_oFSO Objet FileSystem
' sPath Nom de chemin pour le disque (peut être relatif)
' Renvoie Nom du disque à partir du chemin
'
Function GetDriveName(sPath)
GetDriveName = g_oFSO.GetDriveName(g_oFSO.GetAbsolutePathName(sPath)) End Function
'////////////////////////////////////////////////////////////////////////////
' RunCmd
' Run a shell command
'
' g_oShell Objet WshShell
' sCmd Commande à exécuter
' Renvoie Code de sortie de l'application
'
Function RunCmd(sCmd)
Dim sShell
' Obtient le nom du processeur de commande
sShell = g_oShell.Environment("Process").Item("COMSPEC")
If sShell = "" Then
If IsWinNT Then sShell = "cmd" Else sShell = "command"
End If
' Exécute la commande via "COMSPEC /c command"
WScript.Echo "Run: " & sCmd
RunCmd = g_oShell.Run(sShell & " /c " & sCmd, &H20000000, True)
End Function
'////////////////////////////////////////////////////////////////////////////
' IsWinNT
' Teste pour savoir si Windows NT ou Windows 2000
'
' g_oShell Objet WshShell
' Renvoie True sur NT ou Win2K, False sinon
'
Function IsWinNT
Dim sOS
sOS = g_oShell.Environment("Process").Item("OS")
IsWinNT = CBool(sOS = "Windows_NT")
End Function
'////////////////////////////////////////////////////////////////////////////
Listing 13.1 : Script ADSIExplore.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: ADSIExplore.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/ADSIExplore.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Enumère tous les objets ADSI contenus dans l'ordinateur spécifié
' Déclaration variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standard et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Installer contrôle suivi depuis variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher requête d'aide -help, -? etc sur ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Globales utilisées par Main etc
Dim g_bSubObjSwitch, g_bVerboseSwitch, g_aFilters
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer globales standard, puis quitter script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer logique du script principal
'
' Renvoie Code de sortie de script
'
Function Main
Trace 1, "+++Main"
Dim sAdsPath, oAdsObj, nCount, oArgs, oArg
' Analyser ligne de commande en globales
Set oArgs = CreateObject("MTP.CmdArgs")
oArgs.FromCollection(Wscript.Arguments) ' Obtenir ligne de commande
If oArgs.TypedCount(1+4) < 1 Then ' Si chemin manque..
ShowHelpMessage
Wscript.Quit(0)
End If
sAdsPath = oArgs.TypedItem(1+4, 0).Text ' Obtenir nom de chemin ADSI
g_bSubObjSwitch = oArgs.TestSwitch("c") Or oArgs.TestSwitch("s")
g_bVerboseSwitch = oArgs.TestSwitch("v")
ReDim g_aFilters(100) : ix = 0 : nCount = 0
Do
Set oArg = oArgs.FindArg(2, "f", ix) ' Trouver commutateur /f
If Not oArg Is Nothing Then
ix = oArg.Index + 1 ' Prêt pour la suite
g_aFilters(nCount) = oArg.Value ' Obtenir valeur filtre
nCount = nCount + 1
End if
Loop Until oArg Is Nothing
If nCount > 0 Then
ReDim Preserve g_aFilters(nCount - 1) ' Rogner tableau
Else
g_aFilters = Empty ' Supprimer tableau
End If
Set oArgs = Nothing
' Préparer objet ADSI
On Error Resume Next
Set oAdsObj = GetObject(sAdsPath)
If Err.Number <> 0 Then
Wscript.Echo sAdsPath & ": pas trouvé (0x" & Hex(Err.Number) & ")"
Wscript.Quit(Err.Number)
End If
On Error Goto 0
' Afficher en-tête, puis cliche objet principal et contenu
Wscript.StdOut.WriteLine "ADSI Dump of: " & sAdsPath
Wscript.StdOut.WriteLine
If g_bVerboseSwitch Then
DumpSchema "", oAdsObj
Wscript.StdOut.WriteLine
End If
DumpAll "", oAdsObj
' Valeur de retour passée à Wscript.Quit comme code pour quitter script
Main = 0
End Function
'////////////////////////////////////////////////////////////////////////////
' DumpSchema
' Clicher le schéma de l'objet ADSI spécifié
'
' sPrefix Espace préfixe pour mise en retrait
' oAdsObj Object à clicher
'
Sub DumpSchema(sPrefix, oAdsObj)
Trace 1, "+++DumpSchema"
Dim sData, oClass, sList
' Obtenir objet classe pour l'objet ADSI
Set oClass = GetObject(oAdsObj.Schema)
' Clicher contenu classe (objets)
Wscript.StdOut.WriteLine sPrefix & "Schéma pour classe : " & oClass.Name
If oClass.Container Then
Wscript.StdOut.WriteLine sPrefix & " Objets contenus :"
sList = ""
For Each sData In oClass.Containment
If sList = "" Then
sList = sData
Else
sList = sList & ", " & sData
End If
Next
Wscript.StdOut.WriteLine sPrefix & " " & sList
End If
' Clicher propriétés de la classe
Wscript.StdOut.WriteLine sPrefix & " Properties (O=optional, M=mandatory):"
For Each sData In oClass.MandatoryProperties
Wscript.StdOut.WriteLine sPrefix & " (M) " & sData
Next
For Each sData in oClass.OptionalProperties
Wscript.StdOut.WriteLine sPrefix & " (O) " & sData
Next
End Sub
'////////////////////////////////////////////////////////////////////////////
' DumpAll
' Clicher objet et tout objet qu'il contient, récursivement
'
' sPrefix Espace préfixe pour mise en retrait
' oAdsObj Objet à clicher
'
Sub DumpAll(sPrefix, oAdsObj)
Trace 2, "+++DumpAll"
Dim oSubObj
' Clicher objet lui-même
DumpObject sPrefix, oAdsObj
Wscript.StdOut.WriteLine
' Si objet dans conteneur, énumérer tous objets contenus
If g_bSubObjSwitch And GetObject(oAdsObj.Schema).Container = True Then
If Not IsEmpty(g_aFilters) Then
oAdsObj.Filter = g_aFilters ' Définir filtres
End If
For Each oSubObj In oAdsObj
DumpAll sPrefix & " ", oSubObj
Next
End If
End Sub
'////////////////////////////////////////////////////////////////////////////
' DumpObject
' Clicher objet ADSI distinct (ainsi que les infos en rapport avec objet)
'
' sPrefix Préfixes espaces pour mise en retrait
' oAdsObj Objet à clicher
'
Sub DumpObject(sPrefix, oAdsObj)
Trace 3, "+++DumpObject"
Dim nPropCount, ix, sName, vData, sType, oPropEntry
' Afficher informations élémentaires objet
Wscript.StdOut.WriteLine sPrefix & "*** " & oAdsObj.Class & ": " & oAdsObj.Name
Wscript.StdOut.WriteLine sPrefix & "AdsPath: " & oAdsObj.AdsPath & "," & oAdsObj.Class
' Charger cache de propriétés et obtenir décompte propriétés
oAdsObj.GetInfo
On Error Resume Next
nPropCount = oAdsObj.PropertyCount
If Err.Number <> 0 Then nPropCount = 0
On Error Goto 0
' Traiter toutes informations spécifiques de la classe
Select Case oAdsObj.Class
Case "Group", "LocalGroup"
Wscript.StdOut.WriteLine sPrefix & "Membres:"
Wscript.StdOut.WriteLine sPrefix & " " & GetList(oAdsObj.Members)
Case "Utilisateur"
Wscript.StdOut.WriteLine sPrefix & "Groupes :"
Wscript.StdOut.WriteLine sPrefix & " " & GetList(oAdsObj.Groups)
Case "Service"
Wscript.StdOut.WriteLine sPrefix & "Etat =" & oAdsObj.Status
Case "FileService"
Wscript.StdOut.WriteLine sPrefix & "Sessions :"
Wscript.StdOut.WriteLine sPrefix & " " & GetList(oAdsObj.Sessions)
End Select
' Clicher liste propriétés (si prolixe)
If nPropCount <> 0 And g_bVerboseSwitch Then
Wscript.StdOut.WriteLine sPrefix & "Propriétés (" & nPropCount & "):"
For ix = 0 To nPropCount - 1
Set oPropEntry = oAdsObj.Item(ix)
If oPropEntry.AdsType <> 0 Then
vData = oAdsObj.Get(oPropEntry.Name)
sType = oPropEntry.AdsType & "," & TypeName(vData)
sName = oPropEntry.Name & "[" & sType & "]="
Wscript.StdOut.WriteLine sPrefix & " " & sName & CStr(vData)
End If
Next
End If
End Sub
' Elaborer liste de noms délimitée par virgules
Function GetList(oColl)
Dim oObj
GetList = ""
For Each oObj In oColl ' Pour chaque objet
If GetList = "" Then ' si premier élément..
GetList = oObj.Name
Else
GetList = GetList & ", " & oObj.Name
End If
Next
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "usage: adsiexplore []"
Wscript.Echo " /c Cliché contenait objets (secondaires)"
Wscript.Echo " /s Même que /c"
Wscript.Echo " /f:cls Filtre pour classe spécifiée (déf : tous)"
Wscript.Echo " (Plusieurs commutateurs /f autorisés)"
Wscript.Echo " /v Sortie prolixe (schéma et autres détails)"
Wscript.Echo ""
Wscript.Echo "Enumère toutes propriétés ADSI dans espace WinNT pour"
Wscript.Echo "chemin ADSI spécifié (e.g. WinNT://ordinateur,ordinateur)."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Débogue sortie trace contrôlée par var env g_nTraceLevel et WSHTRACE
'
' nLevel Niveau suivi. Seulement afficher si >= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 13.2 : Script DumpUsers.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: DumpUsers.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/DumpUsers.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Saisir les comptes utilisateurs sur une feuille de calcul Excel
' Déclaration variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standards et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Installer contrôle de suivi depuis variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher requête d'aide -help, -? etc sur ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Afficher bannière d'accueuil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer logique du script principal
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
Dim sAdsPath, sExcelPath, oSheet, oExcel, oUser, oAdsObj
' Valider ligne de commande et obtenir args
If Wscript.Arguments.Count < 2 Then
ShowHelpMessage
Wscript.Quit(1)
End If
sAdsPath = "WinNT://" & Wscript.Arguments(0)
sExcelPath = g_oFSO.GetAbsolutePathName(Wscript.Arguments(1))
' Préparer objet ordinateur/domaine ADSI
On Error Resume Next
Set oAdsObj = GetObject(sAdsPath)
If Err.Number <> 0 Then
Wscript.Echo sAdsPath & ": pas trouvé (0x" & Hex(Err.Number) & ")"
Wscript.Quit(Err.Number)
End If
On Error Goto 0
' Préparer feuille de calcul
Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add
oExcel.ActiveWorkbook.Worksheets.Add
Set oSheet = oExcel.ActiveWorkbook.Worksheets(1)
oSheet.Cells.Font.Size = 8
oSheet.Name = "Clicher utilisateur"
oSheet.Cells(1,1).Value = "Clicher données uts. sur : " & Wscript.Arguments(0)
oSheet.Cells(1,1).Font.Bold = True
oSheet.Cells(1,1).Font.Size = 10
oSheet.Range("A3:I3").Font.Bold = True
oSheet.Range("A3:I3").Interior.Color = RGB(192,192,192)
SetupCol oSheet, 3, 1, 12, "Nom"
SetupCol oSheet, 3, 2, 18, "Nom complet"
SetupCol oSheet, 3, 3, 10, "Disque d'accueil"
SetupCol oSheet, 3, 4, 12, "Rép d'accueil"
SetupCol oSheet, 3, 5, 12, "Script de connexion"
SetupCol oSheet, 3, 6, 8, "Fanions utilisateurs"
SetupCol oSheet, 3, 7, 12, "Profil"
SetupCol oSheet, 3, 8, 36, "Description"
SetupCol oSheet, 3, 9, 36, "Groupes"
' Enumérer tous les utilisateurs dans l'ordinateur/domaine
oAdsObj.Filter = Array("User") ' Filtrer cptes utilisateurs seult
ix = 0
For Each oUser In oAdsObj ' Pour chaque compte utilisateur..
DumpAccount oSheet, ix, oUser ' Aller ajouter à feuille
ix = ix + 1 ' indice complémentaire
Next
' Enregistrer feuille de calcul et fermer
oExcel.ActiveWorkbook.SaveAs sExcelPath
oExcel.ActiveWorkbook.Close
Set oSheet = Nothing
Set oExcel = Nothing
Set oAdsObj = Nothing
' Val de retour est passée à Wscript.Quit quand script quitte code
Main = 0
End Function
Sub SetupCol(oSheet, nRow, nCol, nWidth, sTitle)
oSheet.Cells(nRow, nCol).Value = sTitle
oSheet.Cells(nRow, nCol).ColumnWidth = nWidth
End Sub
'////////////////////////////////////////////////////////////////////////////
' DumpAccount
' Clicher comptes utilisateurs
'
' oSheet Objet feuille de calcul
' ix Indice compte
' oUser Objet compte utilisateur
'
Sub DumpAccount(oSheet, ix, oUser)
Dim oObj, sList
' Elaborer liste groupes
sList = ""
For Each oObj In oUser.Groups
If sList = "" Then
sList = oObj.Name
Else
sList = sList & ", " & oObj.Name
End If
Next
' Définir valeurs cellules
oSheet.Cells(4 + ix, 1).Value = oUser.Name
oSheet.Cells(4 + ix, 2).Value = oUser.FullName
oSheet.Cells(4 + ix, 3).Value = oUser.HomeDirDrive
oSheet.Cells(4 + ix, 4).Value = oUser.HomeDirectory
oSheet.Cells(4 + ix, 5).Value = oUser.LoginScript
oSheet.Cells(4 + ix, 6).Value = "0x" & Hex(oUser.UserFlags)
oSheet.Cells(4 + ix, 7).Value = oUser.Profile
oSheet.Cells(4 + ix, 8).Value = oUser.Description
oSheet.Cells(4 + ix, 9).Value = sList
End Sub
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Affiche message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "utilisation : utilisateursclichés "
Wscript.Echo
Wscript.Echo "Cliché des informations comptes utilisateurs sous feuille de"
Wscript.Echo "calcul Excel spécifiée. Spécifier un nom d'ordinateur ou un nom"
Wscript.Echo "de domaine. Pour améliorer performances, ajoute "",ordinateur"""
Wscript.Echo "aux noms d'ordinateurs et "",domaine"" aux noms de domaines."
Wscript.Echo "Par exemple :"
Wscript.Echo
Wscript.Echo " utilisateursclichés mondomaine,domaine mondomaine.xls"
Wscript.Echo
Wscript.Echo "Clichera les uts du domaine MONDOMAIN vers MYDOMAIN.XLS"
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Déboguer sortie de suivi contrôlé par var env g_nTraceLevel et WSHTRACE
'
' nLevel Niveau de suivi. N'affiche que si >= var en WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 13.3 : Script NewUser.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: NewUser.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/NewUser.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Créer un nouvel utilisateur dans l'ordinateur ou le domaine spécifié
' Déclaration variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standards et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Définir contrôle de suivi depuis variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher requêtes d'aide -help, -? etc sur ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Globales utilisées par Main etc
Dim g_bDomainSwitch, g_sFullNameSwitch, g_sDescriptionSwitch
Dim g_sLoginScriptSwitch, g_sHomeDirSwitch, g_sHomeDriveSwitch
Dim g_aGroupList, g_sHomeComputerSwitch, g_sProtoFilesSwitch
Dim g_sPasswordSwitch, g_sComputerName, g_sUserName
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer logique du script principal
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
Dim oArgs, oArg, ix, nCount, sAdsPath, oAdsObj
Dim oUser, oGroup, sGroup
' Obtenir ligne de commande et analyser en globales
Set oArgs = CreateObject("MTP.CmdArgs")
oArgs.FromCollection(Wscript.Arguments) ' Obtenir ligne de commande
If oArgs.TypedCount(1+4) < 2 Then ' doit avoir ord+utilisateur
ShowHelpMessage
Wscript.Quit(0)
End If
g_sComputerName = oArgs.TypedItem(1+4, 0) ' Obtenir nom ordinateur
g_sUserName = oArgs.TypedItem(1+4, 1) ' .. et nom utilisateur
g_bDomainSwitch = oArgs.TestSwitch("Domain")
g_sFullNameSwitch = oArgs.GetSwitch("FullName", "")
g_sDescriptionSwitch = oArgs.GetSwitch("Description", "")
g_sLoginScriptSwitch = oArgs.GetSwitch("LoginScript", "")
g_sHomeDirSwitch = oArgs.GetSwitch("HomeDir", "")
g_sHomeDriveSwitch = oArgs.GetSwitch("HomeDrive", "")
g_sHomeComputerSwitch = oArgs.GetSwitch("HomeComputer", "")
g_sProtoFilesSwitch = oArgs.GetSwitch("ProtoFiles", "")
g_sPasswordSwitch = oArgs.GetSwitch("Password", "")
ix = 0 : nCount = 0 : ReDim g_aGroupList(100)
Do
Set oArg = oArgs.FindArg(2, "Group", ix) ' Obtenir argument groupe..
If Not oArg Is Nothing Then
ix = oArg.Index + 1 ' Définir indice de recherche
g_aGroupList(nCount) = oArg.Value ' Obtenir nom groupe
nCount = nCount + 1 ' Compteur complémentaire
End If
Loop Until oArg Is Nothing
If nCount > 0 Then ' Si quelques groupes..
ReDim Preserve g_aGroupList(nCount - 1) ' Rogner tableau
Else
g_aGroupList = Empty ' Ne marquer aucun groupe
End If
Set oArgs = Nothing
' Préparer objet ADSI
sAdsPath = "WinNT://" & g_sComputerName ' Chemin basique
If g_bDomainSwitch Then ' S'il s'agit d'un domaine..
sAdsPath = sAdsPath & ",domaine"
Else
sAdsPath = sAdsPath & ",ordinateur"
End If
Set oAdsObj = GetObject(sAdsPath)
' Si /HomeComputer spécifié, créer le partage et modifier le rép d'accueil
If g_sHomeComputerSwitch <> "" And g_sHomeDirSwitch <> "" Then
g_sHomeDirSwitch = CreateHomeShare(g_sHomeComputerSwitch, g_sUserName, g_sHomeDirSwitch)
End If
' Créer le compte de base
Set oUser = oAdsObj.Create("user", g_sUserName)
oUser.FullName = g_sFullNameSwitch ' Définit nom utilisateur complet
oUser.Description = g_sDescriptionSwitch ' .. et description
oUser.LoginScript = g_sLoginScriptSwitch ' Nom script de connexion
oUser.HomeDirectory = g_sHomeDirSwitch ' Rép et disque d'accueuil
oUser.SetInfo ' Mettre à jour objet
If g_sPasswordSwitch <> "" Then
oUser.SetPassword = g_sPasswordSwitch ' Définir le mot de passe
End If
oUser.SetInfo ' Mettre à jour objet
' Ajouter le nouveau compte au groupe requis
If Not IsEmpty(g_aGroupList) Then ' Si quelques-uns spécifiés..
For Each sGroup In g_aGroupList ' Pour chaque groupe..
Set oGroup = GetObject(oAdsObj.AdsPath & "/" & sGroup & ",groupe")
oGroup.Add oUser.AdsPath ' Ajouter utilisateur
Set oGroup = Nothing
Next
End If
Set oUser = Nothing
' Copier prototype arborescence vers nouveau répertoire d'accueil
If g_sProtoFilesSwitch <> "" And g_sHomeDirSwitch <> "" Then
Wscript.Echo "Copie: " & g_sProtoFilesSwitch & " En : " & g_sHomeDirSwitch
g_oFSO.CopyFolder g_sProtoFilesSwitch, g_sHomeDirSwitch & "\", False
End If
' Valeur de retour est passée à Wscript.Quit comme code de script de sortie
Main = 0
End Function
'////////////////////////////////////////////////////////////////////////////
' CreateHomeShare
' Créer un nouveau partage sur l'ordinateur spécifié
'
' sComputer Ordinateur cible (où créer partage)
' sUserName Nom de compte utilisateur pour partage
' sPath Chemin vers partage sur ordinateur (chemin local)
' Renvoie Chemin UNC vers nouveau partage
'
Function CreateHomeShare(sComputer, sUserName, sPath)
Trace 1, "+++ShowHelpMessage"
Dim oAdsObj, sAdsPath, oShare
sAdsPath = "WinNT://" & sComputer & "/lanmanserver,fileservice"
Set oAdsObj = GetObject(sAdsPath) ' Obtenir chemin service
Set oShare = oAdsObj.Create("fileshare", sUserName & "$") ' Créer partage
oShare.Path = sPath ' Définir chemin local de partage
oShare.SetInfo ' Enregistrer nouveau partage
Set oAdsObj = Nothing
CreateHomeShare = "\\" & sComputer & "\" & sUserName & "$"
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "usage : newuser []"
Wscript.Echo
Wscript.Echo "Crée un nouveau compte utilisateur sur l'ordi ou le domaine"
Wscript.Echo "specifié comme premier argument. Les commutateurs suivants"
Wscript.Echo "sont pris en charge :"
Wscript.Echo " /Domain Crée le compte dans un domaine"
Wscript.Echo " /FullName:name Nom complet des utilisateurs"
Wscript.Echo " /Description:text Texte descriptif pour comptes"
Wscript.Echo " /LoginScript:name Nom du script de connexion"
Wscript.Echo " /HomeDir:path Chemin vers répertoire d'accueil"
Wscript.Echo " /HomeDrive:name Disque à mapper au chemin d'accueil"
Wscript.Echo " /Group:name Rendre utilisateur membre du groupe"
Wscript.Echo " /HomeComputer:name Ordinateur pour partage username$"
Wscript.Echo " /ProtoFiles:path Source des fichiers prototypes"
Wscript.Echo " /Password:pwd Mot de passe initial"
Wscript.Echo "Plusieurs commutateurs /Group sont autorisés. Si le"
Wscript.Echo "/HomeComputer est spécifié, un nouveau partage appelé username$"
Wscript.Echo "sera créé sur l'ordinateur à l'emplacement dans"
Wscript.Echo "/HomeDir. Le répertoire d'accueil effectif du compte"
Wscript.Echo "référencera alors ce partage."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Déboguer sortie de suivi contrôlée par var env g_nTraceLevel and WSHTRACE
'
' nLevel Niveau de sortie. Ne s'affiche que si >= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 14.1 : Script XMLDir.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: XMLDir.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/XMLDir.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Génère la représentation XML d'un répertoire
' Déclaration de variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standards et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Installer contrôle de suivi à partir de la variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher requêtes d'aide -help, -? etc sur ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter le script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer la logique du script principal
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
Dim sPath, oFolder, oFile, oSubFolder
' Obtenir le nom de chemin absolu du répertoire
If Wscript.Arguments.Count < 1 Then
sPath = "." ' Utiliser ce répertoire
Else
sPath = Wscript.Arguments(0)
End If
sPath = g_oFSO.GetAbsolutePathName(sPath) ' Rendre absolu
Set oFolder = g_oFSO.GetFolder(sPath) ' Obtenir dossier
' Emettre la séquence de début de bloc
Wscript.StdOut.WriteLine "" ' En-tête XML spécial
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine
Wscript.StdOut.WriteLine ""
' Emettre éléments de fichiers et de dossiers distincts
For Each oFile In oFolder.Files ' Pour chaque fichier..
EmitFile " ", oFile ' Emettre code XML
Next
For Each oSubFolder In oFolder.SubFolders ' Pour chaque dossier
EmitFolder " ", oSubFolder ' Emettre code XML
Next
' Emettre la séquence de fin de bloc
Wscript.StdOut.WriteLine ""
Set oFolder = Nothing
' Valeur de retour passée à Wscript.Quit comme code de sortie du script
Main = 0
End Function
'////////////////////////////////////////////////////////////////////////////
' EmitFile
' Emit file object as XML
'
Sub EmitFile(sPrefix, oFile)
Wscript.StdOut.WriteLine sPrefix & "" ' Elément de départ
EmitElement sPrefix & " ", "NOM", oFile.Name
EmitElement sPrefix & " ", "DATECREATION", oFile.DateCreated
EmitElement sPrefix & " ", "DATEDERNIERACCES", oFile.DateLastAccessed
EmitElement sPrefix & " ", "DATEDERNIEREMODIF", oFile.DateLastModified
EmitElement sPrefix & " ", "TAILLE", oFile.Size
EmitElement sPrefix & " ", "ATTR", GetAttrString(oFile.Attributes)
Wscript.StdOut.WriteLine sPrefix & "" ' Elément de fermeture
End Sub
'////////////////////////////////////////////////////////////////////////////
' EmitFolder
' Emettre objet dossier comme code XML
'
Sub EmitFolder(sPrefix, oFolder)
Wscript.StdOut.WriteLine sPrefix & "" ' Elément de départ
EmitElement sPrefix & " ", "NOM", oFolder.Name
EmitElement sPrefix & " ", "DATECREATION", oFolder.DateCreated
EmitElement sPrefix & " ", "DATEDERNIERACCES", oFolder.DateLastAccessed
EmitElement sPrefix & " ", "DATEDERNIEREMODIF", oFolder.DateLastModified
EmitElement sPrefix & " ", "ATTR", GetAttrString(oFolder.Attributes)
Wscript.StdOut.WriteLine sPrefix & "" ' Elément de fermeture
End Sub
'////////////////////////////////////////////////////////////////////////////
' GetAttrString
' Obtenir attributs sous forme chaîne
'
Function GetAttrString(nAttr)
Dim sAttr
GetAttrString = ""
If nAttr And 1 Then sAttr = "R" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
If nAttr And 2 Then sAttr = "H" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
If nAttr And 4 Then sAttr = "S" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
If nAttr And 8 Then sAttr = "V" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
If nAttr And 16 Then sAttr = "D" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
If nAttr And 32 Then sAttr = "A" Else sAttr = "-"
GetAttrString = GetAttrString & sAttr
End Function
'////////////////////////////////////////////////////////////////////////////
' EmitElement
' Emettre éléments XML distincts
'
Sub EmitElement(sPrefix, sName, sValue)
Dim sElement
sElement = "<" & sName & ">" & MakeXML(sValue) & ""
Wscript.StdOut.WriteLine sPrefix & sElement
End Sub
'////////////////////////////////////////////////////////////////////////////
' MakeXML and MakeQXML
' Rendre chaîne valide pour utilisation XML (convertit en entités cars réservés)
'
' sString Chaîne à convertir
'
Function MakeXML(sString)
' Remplacer par entités les caractères réservés
MakeXML = sString ' Obtenir chaîne de remplacement
MakeXML = Replace(MakeXML, "&", "&") ' DOIT VENIR D'ABORD !!
MakeXML = Replace(MakeXML, "<", "<") ' Inférieur à
MakeXML = Replace(MakeXML, ">", ">") ' Supérieur à
MakeXML = Replace(MakeXML, "'", "'") ' Apostrophe
MakeXML = Replace(MakeXML, Chr(34), """) ' Doubles guillemets
End Function
Function MakeQXML(sString)
MakeQXML = Chr(34) & MakeXML(sString) & Chr(34)
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "usage : xmldir []"
Wscript.Echo
Wscript.Echo "Génère un fichier XML vers StdOut contenant un fichier XML"
Wscript.Echo "bien formé (sans DTD) décrivant le contenu du répertoire "
Wscript.Echo "spécifié, ou le répertoire actuel si aucun n'est"
Wscript.Echo "spécifié."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Déboguer sortie de suivi contrôlée par var env g_nTraceLevel et WSHTRACE
'
' nLevel Niveau de suivi. N'affiche que si >= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 14.2 : Script VBSToWS.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: VBSToWS.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/VBSToWS.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Convertit un script .VBS en script .WS
' Déclaration de variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standards et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Définir contrôle de suivi depuis la variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher les requêtes d'aide -help, -? etc sur la ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter le script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer la logique du script principal
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
Dim sDstPath, oDstStream, sSrcPath, oSrcStream, ix, sLine, sID
' DERNIER arg est le fichier de sortie .WS, les autres sont fichiers .VBS i/p
If Wscript.Arguments.Count < 2 Then
ShowHelpMessage
Wscript.Quit(1)
End If
sDstPath = Wscript.Arguments(Wscript.Arguments.Count - 1)
If sDstPath <> "-" Then
sDstPath = g_oFSO.GetAbsolutePathName(sDstPath)
Set oDstStream = g_oFSO.CreateTextFile(sDstPath, True)
Else
Set oDstStream = Wscript.StdOut
End If
' Emettre la séquence de début de bloc
oDstStream.WriteLine "" ' En-tête XML spécial
oDstStream.WriteLine ""
oDstStream.WriteLine
If Wscript.Arguments.Count > 2 Then ' Si plusieurs fichiers .VBS
oDstStream.WriteLine ""
oDstStream.WriteLine
End If
' Traite chaque fichier .VBS distinct
For ix = 0 To Wscript.Arguments.Count - 2
sSrcPath = g_oFSO.GetAbsolutePathName(Wscript.Arguments(ix))
sID = g_oFSO.GetBaseName(sSrcPath)
' Emettre la séquence de début de bloc du fichier
oDstStream.WriteLine ""
oDstStream.WriteLine ""
oDstStream.WriteLine ""
oDstStream.WriteLine ""
oDstStream.WriteLine
Next
' Emettre la séquence de fin de bloc et fermer le flux dst
If Wscript.Arguments.Count > 2 Then ' Si plusieurs fichiers .VBS
oDstStream.WriteLine ""
End If
oDstStream.Close
Set oDstStream = Nothing
' Valeur de retour passée à Wscript.Quit quand le script quitte le code
Main = 0
End Function
'////////////////////////////////////////////////////////////////////////////
' MakeXML and MakeQXML
' Rendre chaîne valide pour utilisation XML (convertit en entités cars réservés)
'
' sString Chaîne à convertir
'
Function MakeXML(sString)
' Remplacer caractères réservés par entités
MakeXML = sString ' Obtenir chaîne de remplacement
MakeXML = Replace(MakeXML, "&", "&") ' DOIT VENIR D'ABORD !!
MakeXML = Replace(MakeXML, "<", "<") ' Inférieur à
MakeXML = Replace(MakeXML, ">", ">") ' Supérieur à
MakeXML = Replace(MakeXML, "'", "'") ' Apostrophe
MakeXML = Replace(MakeXML, Chr(34), """) ' Doubles guillemets
End Function
Function MakeQXML(sString)
MakeQXML = Chr(34) & MakeXML(sString) & Chr(34)
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "usage: vbstows ... "
Wscript.Echo
Wscript.Echo "Convertit un ou plusieurs scripts .VBS de style WSH 1.0 en un"
Wscript.Echo "script.WS WSH 2.0 unique en ajoutant les éléments XML"
Wscript.Echo "nécessaires. Le dernier argument spécifie le à"
Wscript.Echo "utiliser pour la sortie. Chaque fichier .VBS est écrit dans le"
Wscript.Echo "fichier .WSH comme simple élément job. Si le "
Wscript.Echo "est ""-"", la sortie est écrite dans StdOut."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Débogue sortie de suivi contrôlée par g_nTraceLevel et var env WSHTRACE
'
' nLevel Niveau de suivi. Ne s'affiche que si >= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 14.3 : Script FindMovedFiles.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: FindMovedFiles.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/FindMovedFiles.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Trouver tous les fichiers déplacés dans une arborescence
' Déclaration de variables explicites et globales standards
Option Explicit
Dim g_sScriptPath, g_sScriptName, g_sScriptFolder, g_sVersion
Dim g_nTraceLevel
Dim g_oShell, g_oFSO
Dim s, ix, i
' Définir globales standards et créer objets globaux
g_sVersion = "1.0"
g_sScriptPath = Wscript.ScriptFullName
g_sScriptName = Wscript.ScriptName
g_sScriptFolder = Left(g_sScriptPath, Len(g_sScriptPath) - Len(g_sScriptName))
Set g_oShell = CreateObject("Wscript.Shell")
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
' Définir contrôle de suivi depuis la variable d'environnement WSHTRACE
i = g_oShell.Environment("Process").Item("WSHTRACE")
If IsNumeric(i) Then g_nTraceLevel = CInt(i) Else g_nTraceLevel = 0
' Rechercher les requêtes d'aide -help, -? etc sur la ligne de commande
If Wscript.Arguments.Count > 0 Then
s = LCase(Wscript.Arguments(0))
If (s = "-help") Or (s = "-?") Or (s = "/help") Or (s = "/?") Then
ShowHelpMessage
Wscript.Quit(1)
End If
End If
' Afficher bannière d'accueil, puis appeler fonction Main
ix = Instr(g_sScriptName, ".")
If ix <> 0 Then s = Left(g_sScriptName, ix - 1) Else s = g_sScriptName
Wscript.Echo s & " version " & g_sVersion & vbCRLF
i = Main
' Libérer objets globaux standards, puis quitter le script
Set g_oFSO = Nothing
Set g_oShell = Nothing
Wscript.Quit(i)
'////////////////////////////////////////////////////////////////////////////
' Main
' Fonction Main appelée pour incorporer la logique du script principal
'
' Renvoie Code de sortie du script
'
Function Main
Trace 1, "+++Main"
Dim sSrcPath, sDstPath, oSrcDict, oDstDict, oSrcRoot, oDstRoot, nCount
' Valider les args (doivent être au moins deux, et répertoires valides)
If Wscript.Arguments.Count < 2 Then ShowHelpMessage : Wscript.Quit(0)
sSrcPath = g_oFSO.BuildPath(Wscript.Arguments(0), ".")
If Not g_oFSO.FolderExists(sSrcPath) Then
Wscript.Echo Wscript.Arguments(0) & " n'existe pas"
Wscript.Quit(0)
End If
sDstPath = g_oFSO.BuildPath(Wscript.Arguments(1), ".")
If Not g_oFSO.FolderExists(sDstPath) Then
Wscript.Echo Wscript.Arguments(1) & " n'existe pas"
Wscript.Quit(0)
End If
sSrcPath = g_oFSO.GetAbsolutePathName(g_oFSO.GetParentFolderName(sSrcPath))
sDstPath = g_oFSO.GetAbsolutePathname(g_oFSO.GetParentFolderName(sDstPath))
' Elaborer les dictionnaires src et dst
Set oSrcDict = BuildDictionary(sSrcPath)
Set oDstDict = BuildDictionary(sDstPath)
' Trouver tous fichiers source orphelins et fichier déplacé dans destination
Set oSrcRoot = g_oFSO.GetFolder(sSrcPath)
Set oDstRoot = g_oFSO.GetFolder(sDstPath)
nCount = FindMovedFiles(oSrcRoot, oDstRoot, oSrcDict, oDstDict, oSrcRoot)
' Valeur de retour passée à Wscript.Quit en tant que code de sortie du script
Main = nCount
End Function
'////////////////////////////////////////////////////////////////////////////
' BuildDictionary
' Crée objet dictionnaire contenant signatures de tous fichiers de l'arborescence
'
' sPath Chemin du dossier à la racine de l'arborescence
' Renvoie Objet dictionnaire créé
'
Function BuildDictionary(sPath)
Trace 1, "+++BuildDictionary: " & sPath
Dim oDict, oFolder
Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = vbTextCompare ' Ignorer la casse
Set oFolder = g_oFSO.GetFolder(sPath)
AddFiles oDict, oFolder ' Ajouter fichiers récursivement
Set BuildDictionary = oDict
End Function
Sub AddFiles(ByVal oDict, ByVal oFolder)
Trace 2, "+++AddFiles: " & oFolder.Path
Dim oFile, sSig, oSubFolder
' Ajouter chaque fichier dans ce dossier
For Each oFile In oFolder.Files ' Pour chaque fichier..
sSig = GetSignature(oFile) ' Obtenir signature
If oDict.Exists(sSig) Then ' S'il existe..
oDict.Item(sSig) = oDict.Item(sSig) & ";" & oFile.Path
Else
oDict.Add sSig, oFile.Path ' Ajouter nouvel élément
End If
Next
' Ajouter récursivement fichiers de sous-dossiers
For Each oSubFolder in oFolder.SubFolders ' Pour chaque sous-dossier..
AddFiles oDict, oSubFolder ' ..ajouter plus de fichiers
Next
End Sub
'////////////////////////////////////////////////////////////////////////////
' FindMovedFiles
' Trouve tous les fichiers déplacés en comparant src à dst
'
' oSrcRoot Dossier racine source
' oDstRoot Dossier racine de destination
' oSrcDict Dictionnaire des fichiers signature du fichier source
' oDstDict Dictionnaire des fichiers signature du fichier de destination
' oFolder Dossier actuel à parcourir (récursivement)
' Renvoie Décompte des fichiers déplacés trouvés
'
Function FindMovedFiles(oSrcRoot, oDstRoot, oSrcDict, oDstDict, oFolder)
Trace 2, "+++FindMovedFiles: " & oFolder.Path
Dim nCount, oFile, oSubFolder, sSig, sCmd, sCmd1, sCmd2
Dim sSrcPath, sDstPath, sSrcRelPath, sDstRelPath
nCount = 0
' Traiter chaque fichier dans ce dossier
For Each oFile In oFolder.Files
sSig = GetSignature(oFile) ' Obtenir signature fichier
' La signature doit exister dans les arborescences src et dst
If oSrcDict.Exists(sSig) And oDstDict.Exists(sSig) Then
' Il doit n'y avoir qu'un fichier src et dst
If Instr(oSrcDict.Item(sSig), ";") = 0 Then
If Instr(oDstDict.Item(sSig), ";") = 0 Then
' Les chemins relatifs Src/dst doivent être différents
sSrcPath = oSrcDict.Item(sSig)
sDstPath = oDstDict.Item(sSig)
sSrcRelPath = Mid(sSrcPath, Len(oSrcRoot.Path) + 1)
sDstRelPath = Mid(sDstPath, Len(oDstRoot.Path) + 1)
If StrComp(sSrcRelPath, sDstRelPath, vbTextCompare) <> 0 Then
sCmd1 = g_oFSO.BuildPath(oDstRoot.Path, sDstRelPath)
-sCmd2 = g_oFSO.GetParentFolderName(g_oFSO.BuildPath(oDstRoot.Path, sSrcRelPath))
sCmd = "MOVE " & sCmd1 & " " & sCmd2
Wscript.StdOut.WriteLine sCmd
' Traite ligne suivante pour effectuer opérations MOVE
'g_oFSO.MoveFile sCmd1, sCmd2
End If
End If
End If
End If
Next
' Traiter récursivement les sous-dossiers
For Each oSubFolder In oFolder.SubFolders
nCount = nCount + FindMovedFiles(oSrcRoot, oDstRoot, oSrcDict, oDstDict, oSubFolder)
Next
FindMovedFiles = nCount ' Renvoie décompte de déplacements
End Function
'////////////////////////////////////////////////////////////////////////////
' GetSignature
' Calcule signature pour un objet fichier
'
' oFile Objet fichier
' Renvoie Chaîne de signature pour fichier
'
Function GetSignature(oFile)
Trace 3, "+++GetSignature: " & oFile.Name
Dim nAttr
nAttr = oFile.Attributes And Not (32+64+2048)
GetSignature = oFile.Name & ";" & CStr(oFile.DateCreated)
GetSignature = GetSignature & ";" & CStr(oFile.DateLastModified)
GetSignature = GetSignature & ";" & CStr(oFile.Size) & ";" & CStr(nAttr)
End Function
'////////////////////////////////////////////////////////////////////////////
' ShowHelpMessage
' Afficher message d'aide
'
Sub ShowHelpMessage
Trace 1, "+++ShowHelpMessage"
Wscript.Echo "usage : findmovedfiles "
Wscript.Echo "Les arborescences trouvées en src-path et dst-path sont"
Wscript.Echo "comparées et les fichiers qui ont changé d'emplacement dans"
Wscript.Echo " dst-path (donc ont été déplacés) sont identifiés. La sortie"
Wscript.Echo "est une liste de ces fichiers exprimée en tant que série de"
Wscript.Echo "commandes MOVE, qui peuvent être capturées dans un fichier"
Wscript.Echo "et exécutées comme script batch."
End Sub
'////////////////////////////////////////////////////////////////////////////
' Trace
' Déboguer sortie de suivi contrôlée par var env g_nTraceLevel et WSHTRACE
'
' nLevel Niveau de suivi. Ne s'affiche que si >= var env WSHTRACE
' sText Texte à afficher
'
Sub Trace(nLevel, sText)
if g_nTraceLevel > nLevel Then Wscript.Echo sText
End Sub
'////////////////////////////////////////////////////////////////////////////
Listing 14.4 : Script Animal.vbs
'////////////////////////////////////////////////////////////////////////////
' $Workfile: Animal.vbs $ $Revision: 1 $ $Date: 7/18/99 10:42p $
' $Archive: /Scripts/Animal.vbs $
' Copyright (c) 1998 Tim Hill. All Rights Reserved.
'////////////////////////////////////////////////////////////////////////////
' Joue l'ancien jeu électronique Animal
Option Explicit
Dim oAnimals, sDatabase, n
' Former le nom de chemin du fichier de données
sDatabase = Wscript.ScriptFullName
sDatabase = Left(sDatabase, InStrRev(sDatabase, ".") - 1) & ".dat"
' Charger base de données et jouer, puis enregistrer si base de données incorrecte
Set oAnimals = New AnimalSet
oAnimals.Reset
oAnimals.Load sDatabase
If PlayGame(oAnimals) Then
oAnimals.Save sDatabase
End If
Set oAnimals = Nothing
Wscript.Quit(0)
'////////////////////////////////////////////////////////////////////////////
' PlayGame
' Joue au jeu Animals
'
' oAnimals Réf à objet AnimalSet prêt à jouer
' Renvoie True si le jeu a changé (nouveaux animaux)
'
Function PlayGame(ByRef oAnimals)
Dim sMsg, nComputer, nHuman
nComputer = 0 : nHuman = 0
sMsg = ""
PlayGame = False ' Pas encore incomplet
Dim oCursor, n, sAnimal, sQuestion, bYesForNew
Do While True
Set oCursor = oAnimals.GetCursor ' Obtenir curseur jeu
n = MsgBox(sMsg & "Computer: " & nComputer & vbCRLF & "Humain : " & nHuman & vbCRLF & "Penser à un animal, puis OK pour jouer ou Cancel pour quitter.", vbOKCancel, "Animal")
If n = vbCancel Then Exit Do
Do While oCursor.IsQuestion
n = MsgBox(oCursor.Text, vbYesNo, "Animal")
If n = vbYes Then
oCursor.FollowYes
Else
oCursor.FollowNo
End If
Loop
n = MsgBox("C'est un " & oCursor.Text & "?", vbYesNo, "Animal")
If n = vbYes Then
sMsg = "J'ai gagné !! On rejoue." & vbCRLF
nComputer = nComputer + 1
Else
sAnimal = InputBox("Gagné !! A quel animal pensez-vous ?", "Animal")
sAnimal = Trim(sAnimal)
If sAnimal = "" Then Wscript.Quit(1)
Do
sQuestion = InputBox("Saisir question oui/non pour distinguer un " & sAnimal & " d'un " & oCursor.Text & ".", "Animal")
sQuestion = Trim(sQuestion)
If Instr(sQuestion, "?") = 0 Then
n = MsgBox("Saisir question (avec un ""?"" en fin)!", vbOK, "Animal")
sQuestion = ""
End If
Loop While sQuestion = ""
n = MsgBox("La question est : """ & sQuestion & """" & vbCRLF & "For a " & sAnimal & " la réponse serait ?", vbYesNo, "Animal")
If n = vbYes Then
oCursor.AddNewAnimal sAnimal, sQuestion, True
Else
oCursor.AddNewAnimal sAnimal, sQuestion, False
End If
PlayGame = True
sMsg = "J'aurai ma revanche !" & vbCRLF
nHuman = nHuman + 1
End If
Set oCursor = Nothing ' Relâcher le curseur
Loop
End Function
'////////////////////////////////////////////////////////////////////////////
' IsValidObject
' Vérifie si une variable est un objet différent de rien
'
' oObj Référence d'objet à vérifier
' Renvoie Vrai si la variable contient un objet valide
'
Function IsValidObject(ByRef oObj)
IsValidObject = False
If IsObject(oObj) Then
If Not oObj Is Nothing Then
IsValidObject = True
End If
End If
End Function
'////////////////////////////////////////////////////////////////////////////
' AnimalCursor class
' Gère un jeu animal en parcourant l'arborescence des animaux
'
Class AnimalCursor
Private m_oTree ' Arborescence où nous sommes
Private m_oNode ' Nœud actuel dans arborescence
' Attacher/détacher à/d'une arborescence
Public Sub Attach(ByRef oTree, ByRef oNode) ' Attacher curseur à arborescence
Set m_oTree = oTree
Set m_oNode = oNode
End Sub
Public Sub Detach ' Détacher curseur d'arborescence
Set m_oTree = Nothing
Set m_oNode = Nothing
End Sub
' Tests IsAnimal et IsQuestion
Public Property Get IsAnimal
If IsValidObject(m_oNode) Then
If IsValidObject(m_oNode.Yes) Then
IsAnimal = False ' Animaux sont feuilles
Else
IsAnimal = True
End If
Else
IsAnimal = False
End If
End Property
Public Property Get IsQuestion
If IsValidObject(m_oNode) Then
IsQuestion = Not IsAnimal ' Questions sont nœuds internes
Else
IsQuestion = False
End If
End Property
' Parcourir vers le nœud suivant
Public Sub FollowYes
If IsValidObject(m_oNode.Yes) Then ' Seulement si valide
Set m_oNode = m_oNode.Yes
End If
End Sub
Public Sub FollowNo
If IsValidObject(m_oNode.No) Then ' Seulement si valide
Set m_oNode = m_oNode.No
End If
End Sub
Public Property Get Text
Text = m_oNode.Text ' Texte nœud actuel
End Property
' Ajouter nouvel animal à l'arborescence (en fin de jeu)
Public Sub AddNewAnimal(sAnimal, sQuestion, bYesForNew)
Dim oYesNode, oNoNode
If IsValidObject(m_oNode) Then ' Seulement si curseur valide
Set oYesNode = m_oTree.NewNode(sAnimal, Nothing, Nothing)
Set oNoNode = m_oTree.NewNode(m_oNode.Text, Nothing, Nothing)
m_oNode.Text = sQuestion ' Nouveau nœud intérieur
If bYesForNew Then ' Lien de manière correcte
Set m_oNode.Yes = oYesNode
Set m_oNode.No = oNoNode
Else
Set m_oNode.Yes = oNoNode
Set m_oNode.No = oYesNode
End If
End If
End Sub
End Class
'////////////////////////////////////////////////////////////////////////////
' Classe AnimalNode
' Stocke les données d'un nœud simple dans l'arborescence des animaux
'
Class AnimalNode
Public Text ' Texte nœud actuel
Public Yes ' Yes réponse réf nœud
Public No ' Non réponse réf nœud
Public Index ' Utilisé à l'enregistrement
End Class
'////////////////////////////////////////////////////////////////////////////
' AnimalSet class
' Stocke le jeu complet de nœuds animaux (feuilles sont animaux)
'
Class AnimalSet
Private m_oRoot ' Racine arborescence animaux
Private m_nIndex ' Utilisé pour numéroter nœuds
' Initialiser arborescence (supprimer tous nœuds)
Public Sub Reset
DeleteNode m_oRoot ' Supprimer arborescence entière
End Sub
Private Sub DeleteNode(ByRef oNode)
If IsValidObject(oNode) Then ' Si nœud valide..
DeleteNode oNode.Yes ' Supprimer sous-arborescence Yes
DeleteNode oNode.No ' Supprimer sous-arborescence Non
End If
Set oNode = Nothing ' Supprimer le nœud lui-même
End Sub
' Charger arborescence à partir d'un fichier
Public Sub Load(sFilename)
Dim oFSO, oFile, nLastNode, nNodeSize
Dim sLine, vData, oNode, ix, oNodes()
Reset
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FileExists(sFilename) Then
LoadBuiltin ' Charger BD intégrée
Set oFSO = Nothing
Exit Sub ' .. et terminé
End If
Set oFile = oFSO.OpenTextFile(sFilename, 1)
nLastNode = 0 : nNodeSize = 0
Do While Not oFile.AtEndOfStream
sLine = Trim(oFile.ReadLine)
If Len(sLine) > 0 And Left(sLine, 1) <> ";" Then
vData = Split(sLine, ",", 3)
Set oNode = NewNode(vData(2), vData(0), vData(1))
nLastNode = nLastNode + 1
If nLastNode > nNodeSize Then
nNodeSize = nLastNode + 100
ReDim Preserve oNodes(nNodeSize)
End If
Set oNodes(nLastNode) = oNode
Set oNode = Nothing
End If
Loop
Set oFile = Nothing
For ix = 1 To nLastNode
n = oNodes(ix).Yes
If n <> 0 Then
Set oNodes(ix).Yes = oNodes(n)
Else
Set oNodes(ix).Yes = Nothing
End If
n = oNodes(ix).No
If n <> 0 Then
Set oNodes(ix).No = oNodes(n)
Else
Set oNodes(ix).No = Nothing
End If
Next
Set m_oRoot = oNodes(1) ' Définir nœud racine
Erase oNodes
End Sub
' Charger base de données intégrée
Public Sub LoadBuiltin
Reset
Set m_oRoot = NewNode("Vit dans la mer ?", Nothing, Nothing)
Set m_oRoot.No = NewNode("chien", Nothing, Nothing)
Set m_oRoot.Yes = NewNode("poisson", Nothing, Nothing)
End Sub
' Enregistrer arborescence vers un fichier
Public Sub Save(sFilename)
Dim oFSO, oFile
m_nIndex = 1 ' Indice de départ
NumberNodes m_oRoot ' Numéroter tous nœuds
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(sFilename, True)
oFile.WriteLine ";ANIMAL data (" & m_nIndex - 1 & ")"
SaveTree oFile, m_oRoot
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
End Sub
Private Sub SaveTree(ByRef oFile, ByRef oNode)
Dim nYes, nNo
If IsValidObject(oNode) Then
If IsValidObject(oNode.Yes) Then
nYes = oNode.Yes.Index
Else
nYes = 0
End If
If IsValidObject(oNode.No) Then
nNo = oNode.No.Index
Else
nNo = 0
End If
oFile.WriteLine nYes & "," & nNo & "," & oNode.Text
SaveTree oFile, oNode.Yes
SaveTree oFile, oNode.No
End If
End Sub
Private Sub NumberNodes(ByRef oNode)
If IsValidObject(oNode) Then
oNode.Index = m_nIndex ' Numéroter ce nœud
m_nIndex = m_nIndex + 1 ' Indice complémentaire
NumberNodes oNode.Yes ' Numéro arborescence Yes
NumberNodes oNode.No ' .. et pas d'arborescence
End If
End Sub
' Obtenir arborescence
Public Function GetCursor
Set GetCursor = New AnimalCursor ' Créer nouveau curseur
GetCursor.Attach Me, m_oRoot ' Attacher à cette arborescence
End Function
' Créer un nouveau nœud
Public Function NewNode(sText, ByRef oYes, ByRef oNo)
Set NewNode = New AnimalNode ' Créer nouveau nœud
NewNode.Text = sText
If IsObject(oYes) Then
Set NewNode.Yes = oYes
Set NewNode.No = oNo
Else
NewNode.Yes = oYes
NewNode.No = oNo
End If
End Function
End Class
'////////////////////////////////////////////////////////////////////////////