Changer le nom utilisateur d'office par le nom de login windows

Commenter

Contenu du snippet

Ce script en vbs permet de modifier le nom enregistré dans office par le nom de login windows de l'utilisateur. Cela permet par exemple de savoir qui utilise réellement un fichier sur un serveur de données et de le libérer au lieu d'un nom générique souvent utilisé pour installer office.
Il fait :
-la vérification de la version office installée
-la supresssion et modification de la clef registre "HKCU\Software\Microsoft\Office\x.0\Common\UserInfo\UserName"
-la trace des modifications effectuées dans le fichier office.log situé sous \\serveur\partage ou \racine\fichier (à modifier dans le code)
Merci aux membres des forums qui m'ont aidés pour les fonctions de conversion ascii vers binaire. Il manque certainement une fonction pour tracer les erreurs mais je débute..

Source / Exemple : 


'office.vbs version 2.00
'
'script de modification du nom enregistré dans office par le nom de login windows de l'utilisateur
'Vérification de la version office installée
'modification par supresssion et modification de la clef registre "HKCU\Software\Microsoft\Office\x.0\Common\UserInfo\UserName"
'traces des modifications effectuées dans le fichier office.log situé sous \\serveur\partage

On error resume next 

'déclaration des variables

Dim wscr, WshShell, tempread, key, valhex
Dim refRegistry, arrValueData, strValueData, strSKPath, strValueName, i
Dim oFSys, Filelog
Dim sResult, sNomOffice, sOfficeVer, sVersionOffice

'déclaration des objets

Set wscr = CreateObject("wscript.shell")
Set netw = CreateObject("WScript.Network")
Set objWord = CreateObject("Word.Application")
Set oFSys = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

'déclaration constante
Const HKEY_CURRENT_USER = &H80000001
Const strComputer = "."

 sRegHKCU="HKCU\"
 sregHKLM="HKLM\"
 sRegCommun="SOFTWARE\Microsoft\Office\"
 sregPost1="\Common\UserInfo"
 sRegPost = "\Common\InstallRoot\"
 strValueName = "UserName"
 
'HKLM\SOFTWARE\Microsoft\Office\11.0\Common\InstallRoot   ' Office 2003 
'HKLM\SOFTWARE\Microsoft\Office\10.0\Common\InstallRoot   ' Office 2002 (XP) 
'HKLM\SOFTWARE\Microsoft\Office\9.0\Common\InstallRoot    ' Office 2000 
'HKLM\SOFTWARE\Microsoft\Office\8.0\Common\InstallRoot    ' Office 97 

Function GetOfficeVer() 

 
  Select Case True 
    Case RegKeyExists(sRegPre & "11.0" & sRegPost) 
      sOfficeVer = "11.0" 
      sVersionOffice = "Office 2003"
    Case RegKeyExists(sRegPre & "10.0" & sRegPost) 
      sOfficeVer = "10.0"
      sVersionOffice = "Office 2002"
    Case RegKeyExists(sRegPre & "9.0" & sRegPost) 
      sOfficeVer = "9.0"
      sVersionOffice = "Office 2000"
    Case RegKeyExists(sRegPre & "8.0" & sRegPost) 
      sOfficeVer = "8.0" 
      sVersionOffice = "Office 97"
      
      
    Case Else 
      sOfficeVer = "pas d'office"
      sVersionOffice = "pas d'office"
      
  End Select 
     GetOfficeVer= sOfficeVer
     End Function 

Function RegKeyExists(ByVal sRegKey) 
  ' Returns True or False based on the existence of a registry key. 

  Dim sDescription, oShell 
  Set oShell = CreateObject("WScript.Shell") 

   RegKeyExists = True 
   sRegKey = Trim (sRegKey) 
   If Not Right(sRegKey, 1) = "\" Then 
   sRegKey = sRegKey & "\" 
    
    
  End If 

  On Error Resume Next 
  oShell.RegRead "HKEYNotAKey\" 
  sDescription = Replace(Err.Description, "HKEYNotAKey\", "") 

  Err.Clear 
  oShell.RegRead sRegKey 
  RegKeyExists = sDescription <> Replace(Err.Description, sRegKey, "") 
  On Error Goto 0
  
End Function 

 'declaration des chaines clef de registre
   sRegPre = sregHKLM & sRegCommun ' "HKLM\SOFTWARE\Microsoft\Office\" 
  
   strSKPath =  sRegCommun & GetOfficeVer & sregPost1 '"Software\Microsoft\Office\9.0\Common\UserInfo"
      
   key =  sRegHKCU & strSKPath &  "\" & strValueName   '"HKCU\Software\Microsoft\Office\9.0\Common\UserInfo\UserName"

 'Lecture des données utilisateur et test d'égalité pour ne pas faire de modification si username =user office
 
 Sub LoginUtilisateur

 'WScript.Echo "Version office installée : " & sOfficeVer
  
 sNomOffice = objWord.UserName
 If netw.UserName=objWord.UserName Then Call Fichier

End Sub

'Transformation du nom login utilisateur en chaine hexa pour la clef office  
Sub ASCIIHEXA

Dim aAscii()
Dim aChaine() 
Dim iLenChaine
Dim k
Dim aHexa()

sChaine = netw.UserName
sResult = "" 

' taille

iLenChaine = Len(sChaine) 

' la chaine en tableau

ReDim aChaine(iLenChaine) 'premiere valeur null non utilisée... indice 0
For k = 1 To iLenChaine 
aChaine(k) = Mid(sChaine, k, 1) 
Next  

' ascii integer en tableau
 
ReDim aAscii(iLenChaine) 
For k = 1 To iLenChaine 
aAscii(k) = Asc(aChaine(k)) 
Next  

' ascii hexa en tableau + result
 
ReDim aHexa(iLenChaine) 
For k = 1 To iLenChaine 
aHexa(k) = Hex(aAscii(k)) 
sResult = sResult & CStr(aHexa(k)) & "-00-" 
Next  

' on ajoute le dernier chr(0)
sResult = sResult & "00-00" 

End Sub

'Lecture de la clef de registre pour user office

Sub lecture

Set refRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

		If refRegistry.GetBinaryValue(HKEY_CURRENT_USER, strSKPath , strValueName, arrValueData) = 0 Then

					For i = LBound(arrValueData) to UBound (arrValueData)
					strValueData = strValueData & Right("00" & Hex(arrValueData(i)),2) & "-"
					Next

						strValueData = Left(strValueData, Len(strValueData) - 1)

		Else
					Call Fichier
		End If

Set refRegistry = Nothing

End Sub

'Ecriture base de registre et fichier log

Sub Fichier

'cas egalité username et user office

	If netw.UserName=objWord.UserName Then
			Set FileLog = oFSys.OpenTextFile("c:\office.log", 8, True)
			FileLog.writeLine ("PC :" & netw.ComputerName & " Nom utilisateur :" & netw.UserName & " Nom office :" & objWord.UserName & " Compte Identique" & "; Version office : " & sVersionOffice)
			FileLog.close
      Exit Sub
		End If
		
'cas différence username et user office

If netw.UserName <> objWord.UserName Then

WshShell.RegDelete key
	        Dim refRegistry, arrValueData, strValueData, l, k

          ReDim arrValueData(Len(sResult)* 2 + 1)
             
             k = 0 

             For l = 1 To Len(sResult)
             		arrValueData(k) = Asc(Mid(sResult,l,1))
             		k = k + 1
              	arrValueData(k) = 0
             			k = k + 1
            Next
				arrValueData(k) = 0
				k = k + 1
				arrValueData(k) = 0

			Set refRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
			refRegistry.SetBinaryValue HKCU, strSKPath, strValueName, arrValueData
			Set refRegistry = Nothing

'Ecriture fichier log sur c:\
			
			Set FileLog = oFSys.OpenTextFile("c:\office.log", 8, True)
			FileLog.writeLine ("PC :" & netw.ComputerName & " Nom utilisateur :" & netw.UserName & " Nom office :" & sNomOffice & " Modification effectuée" & "; Version office : " & sVersionOffice)
			FileLog.close
 
Set netw = Nothing
Set objWord =Nothing
Set oFSys = Nothing
Set WshShell =	Nothing	
Set FileLog= Nothing	

End If

End Sub

'procédure principale

LoginUtilisateur
ASCIIHEXA
Lecture 
Fichier

A voir également