J'ai mis ici les rares scripts auquels j'ai collaboré plus quelques exemples de chez microsoft

Option Explicit
On Error resume Next

'permet d'ajouter une valeur dans uneclé MULTI_SZ
'PREREQUIS : Reg.exe (resource kit) dans winnt\system32
'
'arguments :
'1 : adresse de la clé (avec guillemets si espaces dans la chaine)
'2 : nom de la clé
'3 : valeur à ajouter à la clé



Dim valcleadd
Dim tabcleadd
Dim i
Dim WshShell
Dim Ret
Dim cle
Dim name
Dim ajout
Dim nb

Set WshShell = WScript.CreateObject("WScript.Shell")

Set nb = WScript.Arguments
if nb < 0 then msgbox "veuillez entrer les arguments : adresse, nom, valeur à ajouter"



cle = Wscript.Arguments(0)
name = Wscript.Arguments(1)
ajout = Wscript.Arguments(2)


'On lit dans la base de registre la valeur actuelle de la clé

tabcleadd = WshShell.RegRead (cle & "\" & name)

'on concatène les valeurs du tableau obtenu
valcleadd=""
for i = lbound(tabcleadd) to ubound(tabcleadd)
    valcleadd = valcleadd & tabcleadd(i) & "\0"
next

'on concatène cette valeur avec celle a injecter
valcleadd = valcleadd & ajout


'On inscrit dans la base de registre le résultat de la concaténation

Ret = WshShell.Run("%windir%\system32\reg add """ & cle & """ /v " & name & " /t REG_MULTI_SZ /d " & valcleadd & " /f",1, TRUE)


=================================================================================
Script permettant de remplacer une partie d'une clé MULTI_SZ, sans reg.exe
=================================================================================
Dim Fso , WshShell, f

Set Fso = CreateObject("scripting.filesystemobject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim cle, chemincle, fin, i, taille, clemz, oldvalue, newvalue
Dim newcle(100)
oldvalue="c:\progra~1\symantec\s32evnt1.dll"
newvalue="c:\winnt\system32\s32evnt1.dll"
chemincle = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\VirtualDeviceDrivers\VDD"
Const ForWriting = 2

'lecture le la cle VDD
cle = WshShell.RegRead(chemincle)
taille = (UBound(cle))

'supression de la clé
WshShell.RegDelete "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\VirtualDeviceDrivers\VDD"


'lecture du tableau, ecriture et jeu des .inf
i=0
Do While (i 0) And (f.AtEndOfStream <> True))
                ligne = f.readline
                'ligne = Mid(ligne,1, Len(Section) + 2)
                Test_section = StrComp(Trim(UCase(ligne)), UCase("[" & Section & "]"))
        Loop
        If (Test_section = 0) Then
                'Section Trouvée ->  Recherche de la clé
                Test_cle = 1
                ligne = ""
                Do While ((Test_cle <> 0) And (f.AtEndOfStream <> True) And (Left(Trim(ligne), 1) <> "["))
                        ligne = f.readline
                        ligne2 = Left(ligne, Len(Cle))
                        Test_cle = StrComp(UCase(ligne2), UCase(Cle))
                Loop
                If (Test_cle = 0) Then
                        LireValeurfic = Trim(Mid(ligne, (Len(Cle) + 2)))
                Else
                        LireValeurfic = ""
                End If
        Else
                LireValeurifc = ""
        End If
        f.Close
End Function
'******************************************************************************

=================================================================================
Script copiant la valeur d'une clé dans une autre
=================================================================================

Set Fso = createobject("scripting.filesystemobject")
Set WshShell = WScript.CreateObject("WScript.Shell")

Dim cle, chemin1, chemin2
chemin1 = "HKEY_LOCAL_MACHINE\Software\Intel\LANDesk\Inventory\Custom Fields\ServeurTeledistribution"
chemin2 = "HKEY_LOCAL_MACHINE\Software\Intel\LANDesk\Inventory\Custom Fields\CoreServeurRegional"
cle = wshshell.regread(chemin1)
WshShell.regwrite chemin2, cle ,"REG_SZ"

Wscript.quit(0)

=================================================================================
Script remplacant une chaine par une autre dans un fichier
=================================================================================

Const Fichier = "c:\chorus\scripts\master\fonction.vbs"
Const LigneCherche = "        Set f = fso.opentextfile(""c:\Ldiscan.cfg"", 2)"
Const Ligne_remplacant = "        Set f = Fso.CreateTextFile(""c:\ldclient\ldiscan.old"", 2)"

'On error resume next
Dim f1, f2, Test_ligne, Fso
Dim ligne, ligne2, Retour

Set fso = wscript.CreateObject("scripting.filesystemobject")

'On travaille dans un fichier temporaire
fso.CopyFile fichier, Mid(fichier, 1, Len(fichier) - 3) & "tmp", True
Set f = Fso.opentextfile(Mid(fichier, 1, Len(fichier) - 3) & "tmp", 1)
Set f2 = Fso.opentextfile(fichier, 2)

Test_ligne = 1
Retour = False
Do while ((Test_Ligne <> 0) and (f.AtEndOfStream <> True))
	ligne = f.readline
	ligne2 = LTrim(ligne)
	Test_ligne = strcomp(ligne2,LTrim(LigneCherche))
	If (test_ligne <> 0) Then
		f2.writeline ligne
	Else
		f2.Writeline Ligne_remplacant	
		Retour = True
	End if
loop

'On réécrit le reste du fichier
Do While (f.AtEndOfStream = False)
	Ligne = f.readline
	f2.writeline ligne	
Loop

f2.close
f.close
fso.deletefile(Mid(fichier, 1, Len(fichier) - 3) & "tmp")
If (Retour = True) Then 
	wscript.quit(0)
Else
	wscript.quit(1)
End if

====================================================================================
'Script "lanceur" de scripts du même nom ( script.vbs) dans des sous-repertoires distincts

Option Explicit
'défiitions des variables et objets utilisés ensuite
Dim WshShell, fso, Return, LocalPack
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

'recupertaion du path courant
Dim Path, PathFull
PathFull = WScript.ScriptFullName
Path = Left(PathFull, InStrRev(PathFull, "\"))
'definition du nom du repertoire contenant les sous-repertoires
LocalPack=path&"local_pack\"


Dim ObjGetFolder
Dim ObjGetSubFolder
Dim F1

'verif de l'existence du repertoire 
if fso.FolderExists (LocalPack)then
			
			'definition de l'objet repertoire
                        Set ObjGetFolder = fso.GetFolder(LocalPack)
                        
                        'listing des soud-repertoires
                        Set ObjGetSubFolder = ObjGetFolder.SubFolders

			'lancement des script.vbs
                        For Each f1 in ObjGetSubFolder
                        	'option 0 => non visible, true, attend la fin du script pour rendre la main
                        	Return = WshShell.Run("%windir%\system32\wscript.exe " &LocalPack &f1.name& "\script.vbs", 0, true)
                        Next
End if
====================================================================================
'Script qui joue à la suite les vbs, cmd ou exe dans un repertoire donné

Option Explicit

Dim WshShell, fso, WshNetwork, Return, PathScripts, Pathhistorique, PathRoot
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

'Path is a defined variable to have the path of start.vbs script
Dim Path, PathFull, lenpath, lenf1,result
PathFull = WScript.ScriptFullName
Path = Left(PathFull, InStrRev(PathFull, "\"))
Pathpack="c:\packages"
'calcul de la longueur de la chaine pathpack
LenPath=Len(pathpack)
Dim f, f1, f2, fc, s

'definition de l'objet repertoire  
Set f = fso.GetFolder(pathpack)
'listing des fichiers
Set fc = f.Files

'debut de la boucle
For Each f1 in fc
     
     'taille du nom du fichier avec son arborescence
      lenf1=Len(f1)
     'extraction du nom de fichier dans la chaine 
      f2 = Right(f1,(lenf1-lenpath-1))
      
				
		If UCase(Right(f2,3))="VBS" Then
		Return=WshShell.run("%windir%\system32\wscript.exe " &f1, 0, true)
		End If
			
		If UCase(Right(f2,3))="CMD" Then
		Return=WshShell.Run(f1,0, true)
		End If
		
		If UCase(Right(f2,3))="EXE" Then
		Return=WshShell.Run(f1 &" -u", 0, true)
		End If
	
Next
====================================================================================
'script qui recopie  les valeurs "noms" d'une arborescence de registre dans une autre

Dim fso, objRegistry, WshShell
Dim InvDate, InvVerion, InvTitle 
Set fso = CreateObject ("Scripting.FileSystemObject")
Set objRegistry = GetObject ("winmgmts:root\default:StdRegProv")
Set WshShell = CreateObject("WScript.Shell")

Const RegHKLM = &H80000002
Const PathOri = "SOFTWARE\Ori\"
Const FullPathOri = "HKLM\SOFTWARE\Ori\"
Const FullPathTarget = "HKLM\SOFTWARE\Target\"

Dim lRC
Dim sKeys ()
Dim s , i , ProductName, 

i = 0
lRC = objRegistry.EnumKey (RegHKLM, PathOri, sKeys)
If (lRC = 0) then

	For each s in sKeys
	
                If s = "" then
		          wscript.quit()
                End If
               	
               	'lecture de la valeur nom               	
               	ProductName = (WshShell.RegRead(FullPathOri & s & "\Nom"))
               	
               	'création de la clé et ecritude de la valeur "nom" dedans
               	WshShell.regwrite FullPathTarget & s & "\", 1 , "REG_BINARY"
                WshShell.regwrite FullPathTarget & s & "\ProductName", ProductName, "REG_SZ"
	      
        Next
End If
wscript.quit
====================================================================================

'Script qui transforme un fichier xml en un fichier ini inutile mais plein d'exmples

Option Explicit


' declare WSH objects
Dim fso , WshShell  , WshNetwork , XMLDoc , objEnv
Dim ObjXMLNodePath
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
Set XMLDoc = CreateObject("MSXML2.DOMDocument")

' constantes to manipulate file
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Path is a defined variable to have the path of start.vbs script
Dim Path, PathFull
PathFull = WScript.ScriptFullName
Path = Left(PathFull, InStrRev(PathFull, "\"))

' files needed to start.vbs

Const XMLfile = "c:\test.xml"
Const Inifile = "c:\test.ini"


' ******************************************************************************************
' STEP : find all on XML
' ******************************************************************************************
Dim LogicalName
Dim HardwareName
Dim SiteCode
Dim RegionName
Dim Langue
Dim DomainName
Dim LandeskPackageServer
Dim User
Dim UName
Dim ServerUM
Dim CommercialType
Dim LHardwareType

LogicalName = GiveResultonXMLFile (XMLfile , "Computer", "LogicalName",0)

HardwareName = UCase(GiveResultonXMLFile (XMLfile , "Computer", "HardwareName",0))

SiteCode = UCase(GiveResultonXMLFile (XMLfile , "Computer", "SiteCode",0))

RegionName = UCase(GiveResultonXMLFile (XMLfile , "Computer", "RegionName",0))

Langue = UCase(GiveResultonXMLFile (XMLfile , "Computer", "Language",0))

   	Select Case langue
		Case "0000040C"
			Langue = "XP FRANCAIS"
		Case "00000c0a"
			Langue = "XP ESPAGNOLS"
		Case "00000407"
			Langue = "XP ALLEMANDS"
		Case "00000409"
			Langue = "XP ANGLAIS"
		Case "00000410"
			Langue = "XP ITALIENS"
		Case "00000413"
			Langue = "XP NEERLANDAIS"
	End Select
                
DomainName = UCase(GiveResultonXMLFile (XMLfile , "Computer", "DomainName",0))

LandeskPackageServer = UCase(GiveResultonXMLFile (XMLfile , "Computer", "LandeskPackageServer",0))

User = UCase(GiveResultonXMLFile (XMLfile , "Users/User", "UserID",1))

UName = UCase(GiveResultonXMLFile (XMLfile , "Users/User", "Name",1))

ServerUM = UCase(GiveResultonXMLFile (XMLfile , "Users/User", "ServerUM",1))

CommercialType = UCase(GiveResultonXMLFile (XMLfile , "Computer", "CommercialType",0))

LHardwareType = UCase(GiveResultonXMLFile (XMLfile , "Computer", "HardwareType",0))

Dim f,i

'ouverture du fichier ini
Set f = fso.OpenTextFile(Inifile, ForWriting, True)
f.WriteLine "[Infos]"
f.WriteLine "Date_creation_ini="&Date
f.WriteLine ""
f.WriteLine "[Machine]"
f.WriteLine "ComputerName="&LogicalName
f.WriteLine "Etiq_UC="& HardwareName
f.WriteLine "CodeSite="&SiteCode
f.WriteLine "Region="&RegionName
f.WriteLine "Langue="&Langue
f.WriteLine "Nom_Dom_Compte="&DomainName
f.WriteLine "Nom_Dom_Ressource="&RegionName
f.WriteLine "Nom_Srv_Landesk="&LandeskPackageServer
f.WriteLine "Poste="&LHardwareType
f.WriteLine "Fonction="&CommercialType
f.WriteLine ""
f.WriteLine "[Users]"

Dim Index,IndexN, IndexUM,  ListUser, ListUserName, ListUserUM, Ok, VarTemp, VarTempn, VarTempUM, numuser
numuser=1
	Ok = False
	
	ListUser = User
	'Test pour chaque utilisateur de la liste
Do
	Index = InStr(ListUser,";")
	If (Index <> "0") Or (ListUser <> "") Then
		If (Index <> "0") Then
			VarTemp = Mid(ListUser, 1, (Index - 1))
		Else
			VarTemp = Mid(ListUser, 1)
		End If
		
		'ajout d'une numérotation du type user01=...
		If numuser < 10 Then
			f.WriteLine "User0"& numuser&"="&(UCase(VarTemp))
		Else
			f.WriteLine "User"& numuser&"="&(UCase(VarTemp))
		End If
		ListUser = Mid(ListUser, Index + 1)
		numuser=numuser+1
		
	End If		
Loop While ((ListUser <> "") and (Ok = False) And (Index <> "0"))

f.WriteLine ""

numuser=1
	Ok = False
	
	ListUser = User
	ListUserName = UName
	
	If ServerUM <> "CNR" Then
		ListUserUM = ServerUM
	End If
	'Test pour chaque utilisateur de la liste
Do
	Index = InStr(ListUser,";")
	IndexN = InStr(ListUserName,";")
	
	If ServerUM <> "CNR" Then
		IndexUM = InStr(ListUserUM,";")
	End If
	
	If (Index <> "0") Or (ListUser <> "") Then
		If (Index <> "0") Then
			VarTemp = Mid(ListUser, 1, (Index - 1))
			VarTempn = Mid(ListUserName, 1, (IndexN - 1))
			
			If ServerUM <> "CNR" Then
				VarTempUM = Mid(ListUserUM, 1, (IndexUM - 1))
			End If
		Else
			VarTemp = Mid(ListUser, 1)
			VarTempn = Mid(ListUserName, 1)
			If ServerUM <> "CNR" Then
				VarTempUM = Mid(ListUserUM, 1)
			End If
		End If
		
			f.WriteLine "["&(UCase(VarTemp))&"]"
			f.WriteLine "UserName="&(UCase(VarTempn))
			If ServerUM <> "CNR" Then
				f.WriteLine "SERVEUR_UM="&(UCase(VarTempUM))
			Else
				f.WriteLine "SERVEUR_UM="
			End If
			f.WriteLine ""
			
				
		ListUser = Mid(ListUser, Index + 1)
		ListUserName = Mid(ListUserName, IndexN + 1)
		If ServerUM <> "CNR" Then
		ListUserUM = Mid(ListUserUM, IndexUM + 1)
		End If
		numuser=numuser+1
		
	End If		
Loop While ((ListUser <> "") and (Ok = False) And (Index <> "0"))

f.WriteLine ""
f.close

Fso.CopyFile Inifile,"c:\it\scripts\master\"

' **********************************************************************************
' Function GiveResultonXMLFile parameters
        ' "filename" is the filepath and filename where you want to find information
                ' ex : c:\Foldername\MyXML.xml
        ' "NodePath" is the path where the function can find informations wanted
                ' ex : NodeName or NodeName/ChildNode
        ' "WantedResult" is the ElementName or attributName where the function can find informations wanted
                ' ex : ElementName:
        ' "IsAnAttribut"
                        '0 is an Element
                        '1 is an Attribut

Function GiveResultonXMLFile (FileName ,NodePath ,WantedResult ,IsAnAttribut)
Dim  ObjXMLNodePath , GoodSubNodeValue, SubNode

XMLDoc.async="False"
XMLDoc.load (FileName)
Set ObjXMLNodePath = XMLDoc.getElementsByTagName(NodePath)
Select Case IsAnAttribut
             case 1
             ' find Attribut value
                for each subNode in  ObjXMLNodePath
                        if GoodSubNodeValue = "" then
                                GoodSubNodeValue= subNode.getattribute(WantedResult)
                                Else
                                GoodSubNodeValue= GoodSubNodeValue&";"&subNode.getattribute(WantedResult)
                        End if
                Next

             Case 0
             ' find Node / Element value
             'wscript.echo ObjXMLNodePath.length             ' give number of entries
	               'wscript.echo ObjXMLNodePath.item(0).text     ' Give the node Name
	               ' read all entries on Node Name
	               For each SubNode in ObjXMLNodePath.item(0).ChildNodes
		              If subnode.NodeName = WantedResult Then
			             If GoodSubNodeValue = "" then
			                     GoodSubNodeValue = subnode.text
			                     else
                                                GoodSubNodeValue = GoodSubNodeValue&";"&subnode.text
                                     End If
		              End If
	               Next
End Select
If GoodSubNodeValue = "" Then
	 GoodSubNodeValue = "CNR"
End If
GiveResultonXMLFile = GoodSubNodeValue
End function
====================================================================================