Changer la clef d’activation Windows

Script trouvé ici: http://www.commentcamarche.net/forum/affich-12008209-changer-ma-cle-d-activation-windows

Voici un copier-coller:

'***************************************************************************
' 
' Script - ChangeKey.vbs
'
' Ce script vous autorisera à changer de clef sur XP /Vista /7
'
' Made by Ro20.
' 
'***************************************************************************

Dim objFS, objFile, objShell
Dim strXPKey, strSystemRoot

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

ON ERROR RESUME NEXT


'On récupère la clef actuelle
oldkey = GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))


Dim VOL_PROD_KEY

if Wscript.arguments.count<1 then
VOL_PROD_KEY=InputBox("Instructions:" & vbCr & vbCr & "Ce script vous permettra de changer la clef actuelle de votre Windows." & vbCr & "ATTENTION les clefs OEM ne sont pas valables." & vbCr &  vbCr & "Entrez dans la case ci-dessous votre nouvelle clef: " & vbCr & "(clef actuelle inscrite par défaut) ","Changeur de clef Windows XP/Vista/7",oldkey)
if VOL_PROD_KEY="" then
Wscript.quit
end if
else
VOL_PROD_KEY = Wscript.arguments.Item(0)
end if

VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any


for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")

result = Obj.SetProductKey (VOL_PROD_KEY)

if err = 0 then

Newkey = GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))


 Wscript.echo "L'inscription de la nouvelle clef " & Newkey & " a réussi..."
end if



if err <> 0 then
strMessage = "Erreur la nouvelle clef " & VOL_PROD_KEY & " est incorrecte !" & vbCr & vbCr & "Veuillez inscrire une clef qui soit valide s.v.p."& vbCr & vbCr & "L'ancienne clef " & oldkey & " n'a pas été modifiée."

result = Msgbox (strMessage,vbExclamation ,"Erreur clef incorrecte !")


' Inspect the return value.
If result = vbRetry Then
   Wscript.quit
 ' Show result using the Echo method.
Else 
    Err.Clear
    Wscript.quit
End If


end if

Next



'--------------------------------------------------------------------------

Function GetKey(rpk)
  Const rpkOffset=52:i=28
  szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
  Do
    dwAccumulator=0 : j=14
    Do
      dwAccumulator=dwAccumulator*256
      dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
      rpk(j+rpkOffset)=(dwAccumulator\24) and 255
      dwAccumulator=dwAccumulator Mod 24
      j=j-1
    Loop While j>=0
    i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
    if (((29-i) Mod 6)=0) and (i<>-1) then
      i=i-1 : szProductKey="-"&szProductKey
    End If
  Loop While i>=0
  GetKey=szProductKey
End Function

VBS: Traitement de fichier

'<<<<<<< LECTURE d'un fichier >>>>>>>>>>>>
'déclaration file system object
Dim fso
 
'instanciation
Set FSO = CreateObject("Scripting.FileSystemObject")
 
'on instance le fichier texte 
Set Ftxt = FSO.OpenTextFile("Monchemin")
 
'on parcours chaque ligne du fichier texte

Do While Not Ftxt.AtEndOfStream
      MaVariable = Ftxt.Readline
      '....... <- votre code ici pour traiter chaque ligne
Loop
 
Ftxt.Close
 
'<<<<<<< ECRITURE dans un fichier >>>>>>>>>>>>
'déclaration file system object

Dim fso
 
'instanciation

Set FSO = CreateObject("Scripting.FileSystemObject")
 
'on instance le fichier texte dans lequel on veut ecrire

Set Ftxt =  FSO.createTextFile("Monchemin",true) 'true=ecrase

'On ecrit ce que l'on veut dans le fichier 

Ftxt.writeline ("Mon texte à écrire ou ma Variable texte")
Ftxt.Close
 
'<<<<<<<<<  DEPLACER un fichier >>>>>>>>>>>>>>>
'déclaration file system object

Dim fso
 
'instanciation

Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Déplacement du fichier

Set Ftxt = fso.GetFile("moncheminsource")   'Fichier origine
Ftxt.move("monchemindestination") 'emplacement destination

'<<<<<<<<<  COPIER un fichier >>>>>>>>>>>>>>>
'déclaration file system object

Dim fso
 
'instanciation

Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Copie du fichier

Set Ftxt = fso.GetFile("moncheminsource")   'Fichier origine
Ftxt.copy("monchemindestination") 'emplacement destination
 
'<<<<<<<<<  SUPPRIMER un fichier >>>>>>>>>>>>>>>
'déclaration file system object

Dim fso
 
'instanciation

Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Suppression du fichier

Set Ftxt = fso.GetFile("moncheminsource")   'Fichier origine
Ftxt.delete

VBS: Rapport système

Ci-dessous un script permettant de générer un rapport système.

Ce script à l’origine trouvé sur http://www.vbfrance.com a été écrit par Rachid Benbrik, développeur web free-lance.

Merci à lui (et n’hésitez pas à visiter son site => http://www.fullflash.fr/).

On error resume next
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set rapor= fso.OpenTextFile("rapport.txt",2,True)
 
rapor.WriteLine("--------------------------------------------------")
rapor.WriteLine("Information systeme by racattac13 Le "&Now)
rapor.WriteLine("--------------------------------------------------")
rapor.WriteBlankLines(2)
 
Set wmobj = Getobject("WinMgmts:{impersonationLevel=impersonate}")
 
rapor.WriteLine("Systeme d'exploitation :")
 
Set test=wmobj.ExecQuery("Select * from Win32_OperatingSystem")
 
for each valeur in test
rapor.WriteLine("Nom de l'OS : "&valeur.Name)
rapor.WriteLine("Version : "&valeur.Version)
rapor.WriteLine("Nom du Fabricant : "&valeur.Manufacturer)
rapor.WriteLine("Repertoire windows : "&valeur.WindowsDirectory)
rapor.WriteLine("Chemin Locale : "&valeur.Locale)
rapor.WriteLine("Memoire physique dispo : "&valeur.FreePhysicalMemory)
rapor.WriteLine("Memoire virtuelle total : "&valeur.TotalVirtualMemorySize)
rapor.WriteLine("Memoire virtuelle dispo : "&valeur.FreeVirtualMemory)
rapor.WriteLine("Memoire partager : "&valeur.SizeStoredInPagingFiles)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Systeme ordinateur:")
 
Set test=wmobj.ExecQuery("Select * from Win32_ComputerSystem")
 
For each valeur in test
rapor.WriteLine("Nom de l'ordinateur : "&valeur.Name)
rapor.WriteLine("Nom du Fabricant : "&valeur.Manufacturer)
rapor.WriteLine("Nom de produit : "&valeur.Model)
rapor.WriteLine("Zone horraire : "&valeur.CurrentTimeZone)
rapor.WriteLine("Memoire physique totale : "&valeur.TotalPhysicalMemory)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Processeur:")
 
Set test=wmobj.ExecQuery("Select * from Win32_Processor")
 
For each valeur in test
rapor.WriteLine("Processeur : "&valeur.Description)
rapor.WriteLine("Fréquence actuelle : "&valeur.CurrentClockSpeed)
rapor.WriteLine("Fréquence Maximum : "&valeur.MaxClockSpeed)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Syteme BIOS:")
 
Set test=wmobj.ExecQuery("Select * from Win32_BIOS")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Nom du Fabricant : "&valeur.Manufacturer)
rapor.WriteLine("Version : "&valeur.Version)
rapor.WriteLine("Numero de série : "&valeur.SerialNumber)
rapor.WriteLine("Date de publication : "&valeur.ReleaseDate)
rapor.WriteLine("Language utilisé : "&valeur.CurrentLanguage)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Processus:")
 
Set test=wmobj.ExecQuery("Select * from Win32_Process")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Numero id : "&valeur.Handle)
rapor.WriteLine("Numero id : "&valeur.HandleCount)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Disponibilité memoire:")
 
Set test=wmobj.ExecQuery("Select * from Win32_LogicalMemoryConfiguration")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Description : "&valeur.Description)
rapor.WriteLine("Memoire dispo pour l'OS : "&valeur.TotalPhysicalMemory)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("CD ROM:")
 
Set test=wmobj.ExecQuery("Select * from Win32_CDROMDrive")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Type de media : "&valeur.MediaType)
rapor.WriteLine("Nom du Fabricant : "&valeur.Manufacturer)
rapor.WriteLine("Description : "&valeur.Description)
rapor.WriteLine("Nom du volume : "&valeur.VolumeName)
rapor.WriteLine("Numero de serie du media : "&valeur.VolumeSerialNumber)
rapor.WriteLine("Taille de bloque par defaut : "&valeur.DefaultBlockSize)
rapor.WriteLine("Taille du lecteur : "&valeur.Size)
rapor.WriteLine("Taux de transfert : "&valeur.TransferRate)
rapor.WriteLine("Lettre de lecteur : "&valeur.Drive)
rapor.WriteLine("Identifiant : "&valeur.DeviceID)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Connexion reseau:")
 
Set test=wmobj.ExecQuery("Select * from Win32_NetworkConnection")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Nom Local : "&valeur.LocalName)
rapor.WriteLine("Nom d'utilisateur : "&valeur.UserName)
rapor.WriteLine("Type : "&valeur.DisplayType)
rapor.WriteLine("Description : "&valeur.Description)
rapor.WriteLine("Etat de la connection : "&valeur.ConnectionState)
rapor.WriteLine("Nom du fournisseur : "&valeur.ProviderName)
rapor.WriteLine("Nom de la ressource distante: "&valeur.RemoteName)
rapor.WriteLine("Chemin ressource distante : "&valeur.RemotePath)
rapor.WriteLine("Type de ressource : "&valeur.ResourceType)
rapor.WriteLine("Commentaire du fournisseur : "&valeur.Comment)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Adapter réseaux:")
 
Set test=wmobj.ExecQuery("Select * from Win32_NetworkAdapter")
 
For each valeur in test
 
rapor.WriteLine("Type de carte : "&valeur.AdapterType)
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Statut : "&valeur.Availability)
rapor.WriteLine("Description : "&valeur.Description)
rapor.WriteLine("Adresse MAC : "&valeur.MACAddress)
rapor.WriteLine("Adresses réseau de la carte : "&valeur.NetworkAddresses)
rapor.WriteLine("Adresse pré programmé : "&valeur.PermanentAddress)
rapor.WriteLine("Nom du Fabricant : "&valeur.Manufacturer)
rapor.WriteLine("Nb max de port adressable : "&valeur.MaxNumberControlled)
rapor.WriteLine("Nom de produit : "&valeur.ProductName)
rapor.WriteLine("Nom de service : "&valeur.ServiceName)
rapor.WriteLine("Bande passante actuelle : "&valeur.Speed)
rapor.WriteLine("Derniere réinitialisation : "&valeur.TimeOfLastReset)
Next
 
rapor.WriteBlankLines(2)
 
rapor.WriteLine("Compte utilisateur:")
 
Set test=wmobj.ExecQuery("Select * from Win32_Account")
 
For each valeur in test
rapor.WriteLine("Nom : "&valeur.Name)
rapor.WriteLine("Description : "&valeur.Description)
rapor.WriteLine("Domaines : "&valeur.Domain)
rapor.WriteLine("SID : "&valeur.SID)
Next
 
rapor.WriteBlankLines(2)
 
Set ws= CreateObject("WScript.Shell")
 
ws.Run "rapport.txt"

VBS: Connaître le nom de machine

'Retourne le nom de machine dans un fichier nom_machine.txt
Dim fso, tf
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set tf = fso.CreateTextFile(".\nom_machine.txt", True)
 
Public Function Computer_Name()
  Set WshNetwork = WScript.CreateObject("WScript.Network")
  Computer_Name = WshNetwork.ComputerName
End Function
 
    tf.WriteLine("Nom de la machine: " & Computer_Name)
tf.Close

Fonction include en vbs

'---------------Fonction permettant d'inclure un fichier *.vbs
Sub Include(sInstFile)
  On Error Resume Next
  Dim oFSO, f, s
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  If oFSO.FileExists(sInstFile) Then
    Set f = oFSO.OpenTextFile(sInstFile)
    s = f.ReadAll
    f.Close
    ExecuteGlobal s
  End If
  Set oFSO = Nothing
  Set f = Nothing
End Sub
 
'----------------Inclusion
include("mon_fichier.vbs")

VBS: Manipulation de fichiers ini

'----------------------------------
' Manipulation des fichiers ini
'----------------------------------
 
Sub WriteINIStringVirtual(Section, KeyName, Value, FileName)
  WriteINIString Section, KeyName, Value, _
    Server.MapPath(FileName)
End Sub
 
Function GetINIStringVirtual(Section, KeyName, Default, FileName)
  GetINIStringVirtual = GetINIString(Section, KeyName, Default, _
    Server.MapPath(FileName))
End Function 
 
'Work with INI files In VBS (ASP/WSH)
'v1.00
'2003 Antonin Foller, PSTRUH Software, http://www.motobit.com
'Function GetINIString(Section, KeyName, Default, FileName)
'Sub WriteINIString(Section, KeyName, Value, FileName)
 
Sub WriteINIString(Section, KeyName, Value, FileName)
  Dim INIContents, PosSection, PosEndSection
  'Get contents of the INI file As a string
  INIContents = GetFile(FileName)
 
  'Find section
  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
  If PosSection>0 Then
    'Section exists. Find end of section
    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")

    '?Is this last section?
    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
 
    'Separate section contents
    Dim OldsContents, NewsContents, Line
    Dim sKeyName, Found
    OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
    OldsContents = split(OldsContents, vbCrLf)
 
    'Temp variable To find a Key
    sKeyName = LCase(KeyName & "=")
 
    'Enumerate section lines
    For Each Line In OldsContents
      If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
        Line = KeyName & "=" & Value
        Found = True
      End If
 
      NewsContents = NewsContents & Line & vbCrLf
 
    Next
 
    If isempty(Found) Then
      'key Not found - add it at the end of section
      NewsContents = NewsContents & KeyName & "=" & Value
    Else
      'remove last vbCrLf - the vbCrLf is at PosEndSection
      NewsContents = Left(NewsContents, Len(NewsContents) - 2)
    End If
 
    'Combine pre-section, new section And post-section data.

    INIContents = Left(INIContents, PosSection-1) & _
      NewsContents & Mid(INIContents, PosEndSection)
  else'if PosSection>0 Then
    'Section Not found. Add section data at the end of file contents.
    If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then 
      INIContents = INIContents & vbCrLf 
    End If
    INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
      KeyName & "=" & Value
  end if'if PosSection>0 Then
  WriteFile FileName, INIContents
End Sub
 
Function GetINIString(Section, KeyName, Default, FileName)
  Dim INIContents, PosSection, PosEndSection, sContents, Value, Found
 
  'Get contents of the INI file As a string
  INIContents = GetFile(FileName)
 
  'Find section

  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
  If PosSection>0 Then
    'Section exists. Find end of section
    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
 
    '?Is this last section?
    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
 
    'Separate section contents
    sContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
 
    If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare)>0 Then
      Found = True

      'Separate value of a key.
      Value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
    End If
  End If
 
  If isempty(Found) Then Value = Default

  GetINIString = Value
 
End Function
 
'Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
  Dim PosB: PosB = InStr(1, sFrom, sStart, 1)
  If PosB > 0 Then
    PosB = PosB + Len(sStart)
    Dim PosE: PosE = InStr(PosB, sFrom, sEnd, 1)
    If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
    If PosE = 0 Then PosE = Len(sFrom) + 1
    SeparateField = Mid(sFrom, PosB, PosE - PosB)
  End If
End Function
 
'File functions
Function GetFile(ByVal FileName)
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
  'Go To windows folder If full path Not specified.
  If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then 
    FileName = FS.GetSpecialFolder(0) & "\" & FileName
  End If
  On Error Resume Next
  GetFile = FS.OpenTextFile(FileName).ReadAll
End Function
 
Function WriteFile(ByVal FileName, ByVal Contents)
 
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
  'On Error Resume Next
  'Go To windows folder If full path Not specified.

  If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then 
    FileName = FS.GetSpecialFolder(0) & "\" & FileName
  End If
 
  Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)
 
  OutStream.Write Contents
 
End Function
 
'---------------------------------------------------------------
' Fonction qui récupère le chemin courant
' car sinon, ce script utilise par défaut le répertoire windows 
'---------------------------------------------------------------
 
Function GetPath()
 
Dim path
	path = WScript.ScriptFullName
	GetPath = Left(path, InStrRev(path, "\"))
End Function
 
Msgbox GetPath()
 
'------------------------------------------
' Exemple de manipulation de fichiers ini
'------------------------------------------
 
'WriteINIString "Mail", "MAPI", "3", "./win.ini"

'wscript.echo GetINIString("Mail", "MAPI", "-", "win.ini")

Read and write windows INI files in VBSscript

VBS: Détection d’imprimantes

Script 1

'ce script cherche les imprimantes connectées à la machine
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery ("Select * from Win32_Printer")

'boucle qui va afficher toutes les imprimantes
For Each objPrinter in colInstalledPrinters
	'Le if ci-dessous permet de n'afficher que l'imprimante par défaut
	'Il faut le supprimer si on veut toutes les imprimantes
	If objPrinter.Default = "Vrai" Then
		Wscript.Echo "Name: " & objPrinter.Name
		Wscript.Echo "Default: " & objPrinter.Default
	End If
Next

Script 2

    ' Liste les proprietés d Imprimantes installées
    ' et les mets dans un fichier Liste_Drivers_Imprimantes.txt
    ' Windows Server 2003 : Yes
    ' Windows XP : Yes
    ' Windows 2000 : No
    ' Windows NT 4.0 : No
    ' Windows 98 : No
    'Enjoy!! bernes3@gmail.com
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colInstalledPrinters =  objWMIService.ExecQuery _
        ("Select * from Win32_Printer")
     
    Dim fso, tf
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set tf = fso.CreateTextFile(".\Liste_Drivers_Imprimantes.txt", True)
 
    For Each objPrinter in colInstalledPrinters
        tf.WriteLine("----------------------------")
        tf.WriteLine("Name: " & objPrinter.Name)
        tf.WriteLine("Location: " & objPrinter.Location)
     	tf.WriteLine("Description: " & objPrinter.Description)
        tf.WriteLine("DriverName: " & objPrinter.DriverName)
        tf.WriteLine("PortName: " & objPrinter.PortName)
        tf.WriteLine("ShareName: " & objPrinter.ShareName)
    Next

    '---------------Retourne le nom de machine
    Public Function Computer_Name()
      Set WshNetwork = WScript.CreateObject("WScript.Network")
      Computer_Name = WshNetwork.ComputerName
    End Function

        tf.WriteLine("Nom de la machine: " & Computer_Name)
    tf.Close