#164692 - 2006-07-20 01:06 PM
Change Userinfo for MS-Office 2K3 in the Registry to current user
|
DWE
Fresh Scripter
Registered: 2006-07-20
Posts: 5
|
I hope that this script is helpfull for someone. It was created in a environment where users change their workstation often, but we want to know which user worked with which Office dokument.
Regards
Dirk
;************************************************************************ ; Change Userinfo for MS-Office 2K3 in the Registry to current user ;************************************************************************
$Laenge = len(@fullname)
$zaehler = 1
while $zaehler < $laenge+1 $hexbyte = DecToHex (Asc(Substr(UCase(@fullname),$zaehler,1))) ; great Kung-Fu here 
if $hexbyte = "20" $incount = ($zaehler*4)+1 endif
$hexstr = $hexstr + $hexbyte + "00"
$zaehler = $zaehler + 1 loop
$strout = $hexstr+"0000" ; complete name upcase
$initials = Substr($strout,1,4)+Substr($strout,$incount,8)+"0000" ; 1st Char Firstname, 1st and 2nd Char of Surename
$RC=WriteValue("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\UserInfo", "UserName", $strout, "REG_BINARY") $RC=WriteValue("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\UserInfo", "UserInitials", $initials, "REG_BINARY")
;*************************************************************************
|
|
Top
|
|
|
|
#164693 - 2006-07-20 03:42 PM
Re: Change Userinfo for MS-Office 2K3 in the Registry to current user
|
ChristopheM
Hey THIS is FUN
   
Registered: 2002-05-13
Posts: 311
Loc: STRASBOURG, France
|
as we are migrating from NT 4+Office 97 to XT+Office 2003, i recently wrote a script very similar to yours : Code:
;-- try to connect to WORD -- dim $WordUsername, $WordUserInitials, $WordUserAddress ; ; initialize here the $WordUserXXXX variables ; $objWord = CreateObject("Word.Application") if not @error $objWord.UserName = $WordUsername $objWord.UserInitials = $WordUserInitials $objWord.UserAddress = $WordUserAddress $objWord.Quit $objWord = nothing endif here is a piece of code. No need to convert ANSI string to unicode, No need to know registry keys and values. When i started to test this code, i was very surprised to see that it is working on office 2003 AND office 97.
in fact, the global script i use, is more complex because i read informations in AD (sn, givenname, initials, company, streetaddress, postofficebox,postalcode, l) and if initials in AD are not set but those in MS-Word are, then i set user initials in AD because it is a field that administrators never set in my company (initials are not used very often in France)
If you are interested, i can post the complete script.
_________________________
Christophe
|
|
Top
|
|
|
|
#164694 - 2006-07-20 07:09 PM
Re: Change Userinfo for MS-Office 2K3 in the Registry to current user
|
NTDOC
Administrator
   
Registered: 2000-07-28
Posts: 11634
Loc: Space
|
Quote:
If you are interested, i can post the complete script.
I'm interested to see what all you're doing. May not currently have a need for it, but who knows what the future brings.
|
|
Top
|
|
|
|
#164695 - 2006-07-21 02:13 PM
Re: Change Userinfo for MS-Office 2K3 in the Registry to current user
|
ChristopheM
Hey THIS is FUN
   
Registered: 2002-05-13
Posts: 311
Loc: STRASBOURG, France
|
Here is my code : Code:
;---------------------------------------------------------------------------------- ; Update user informations ; - username ; - userinitials ; - useraddress ; if informations are missing (or have default value), try to read in AD ;---------------------------------------------------------------------------------- break on $=setoption( "NoVarsInStrings", "ON" ) $=setoption( "NoMacrosInStrings", "ON" ) $=setoption( "Explicit", "ON" ) dim $CanSetUserValue, $SetWordUserValue, $userAdsPath, $userObj, $objWord dim $WordUsername, $WordUserInitials, $WordUserAddress, $WordDefaultUsername dim $NewWordUsername, $NewWordUserInitials, $NewWordUserAddress ;-- i don't know where this information is stored -- $WordDefaultUsername = "xxxx" $CanSetUserValue = 0 $userAdspath = GetAdsPath( "samAccountName="+@userid ) if not @error $userObj = GetObject($userAdsPath) if not @error ;-- immediatly get user information -- $userObj.GetInfo() $CanSetUserValue = 1 endif endif if not $CanSetUserValue ;-- unable to read informations in AD -- exit endif ;-- création d'une connexion sur Word -- $objWord = CreateObject("Word.Application") if @error ;-- unable to connect to MS-Word -- exit endif ;-- read current values in MS-Word -- $SetWordUserValue = 0 $WordUsername = $objWord.UserName $WordUserInitials = $objWord.UserInitials $WordUserAddress = $objWord.UserAddress ;-- field "username" -- $NewWordUserName = $WordUsername if (trim($WordUsername)="" ) or ($WordUsername=@userID ) or ($WordUsername=$WordDefaultUsername) $NewWordUsername = "" $NewWordUsername = ConcatenateString($userObj.sn, $NewWordUsername, "", "" ) $NewWordUsername = ConcatenateString($userObj.givenname, $NewWordUsername, " ", "" ) $SetWordUserValue = 1 endif ;-- field "userinitials" -- $NewWordUserInitials = $WordUserInitials if (trim($WordUserInitials)="" ) or ($WordUserInitials="msoffice" ) or ($WordUserInitials=left($WordUsername,1) ) $NewWordUserInitials = $userObj.initials $SetWordUserValue = 1 else if ($WordUserInitials<>$userObj.initials) and ($WordUserInitials<>"") ;-- set data in AD -- $userObj.initials = $WordUserInitials $userObj.setinfo() endif endif ;-- field "useraddress" -- $NewWordUserAddress = $WordUserAddress if (trim($WordUserAddress)="" ) $NewWordUserAddress = "" $NewWordUserAddress = ConcatenateString($userObj.company, $NewWordUserAddress, "", @crlf ) $NewWordUserAddress = ConcatenateString($userObj.StreetAddress, $NewWordUserAddress, "", @crlf ) $NewWordUserAddress = ConcatenateString($userObj.PostOfficeBox, $NewWordUserAddress, "", @crlf ) $NewWordUserAddress = ConcatenateString($userObj.PostalCode, $NewWordUserAddress, "", " " ) $NewWordUserAddress = ConcatenateString(UCase($userObj.l), $NewWordUserAddress, "", "" ) $SetWordUserValue = 1 endif if $SetWordUserValue ;-- set informations in MS-Word -- $objWord.UserName = $NewWordUsername $objWord.UserInitials = $NewWordUserInitials $objWord.Useraddress = $NewWordUserAddress endif $objWord.Quit $objWord = nothing exit ;------------------------------------------------------------------------------ ; ;------------------------------------------------------------------------------ function ConcatenateString( $what, $to, $before, $after ) if trim($what) $to = $to + $before + $what + $after endif $ConcatenateString = $to endfunction ;------------------------------------------------------------------------------ ; ;------------------------------------------------------------------------------ Function GetAdsPath($sFilter) Dim $sWhat, $sFrom, $sScope, $Request $sWhat = "adspath" $sFrom = "" $sScope = "SubTree" $Request = fnLDAPQuery($sWhat, $sFrom, "("+$sFilter+")", , $sScope) if @error exit @error endif If Ubound($Request)<>0 Exit Ubound($Request) Else $GetAdsPath=$Request[0,0] EndIf Exit 0 EndFunction ;------------------------------------------------------------------------------ ; ;------------------------------------------------------------------------------ ;Function: ; fnLDAPQuery() ; ;Author: ; Christopher Shilt (christopher.shilt@relizon.com) ; ;Contributors: ; Christophe Melin (christophe.melin@cus-strasbourg.net) ; Jens Meyer (sealeopard@usa.net) ; ;Version: ; 1.0 (June 20, 2005) ; ;Version History: ; ;Action: ; Uses ADODB to retrieve information from Active Directory. ; ;Syntax: ; fnLDAPQuery(WHAT, Optional FROM, Optional FILTER, Optional ORDER BY, ; Optional SCOPE, Optional USER, Optional PASSWORD) ; ;Parameters: ; WHAT : Required. Attribute (or array of attributes) to retrieve. ; ; FROM : Optional. Specifies the ADsPath of the base of the search. ; For example, the ADsPath of the Users container in an Active ; Directory domain might be 'LDAP://CN=Users,DC=Fabrikam,DC=COM'. ; ; FILTER : Optional. Specifies the query filter. You can also add wildcards ; and conditions to an LDAP search filter. The following examples ; show substrings that can be used to search the directory. ; ; Get all users: ; "(objectClass=Users)" ; Get all users with a common name equal to "bob": ; "(&(objectClass=Users)(cn=bob))" ; Get all users with a common name beginning with "bob": ; "(&(objectClass=Users)(cn=bob*))" ; Get all users containing "bob" somewhere in the common name: ; "(&(objectClass=Users)(cn=*bob*))" ; Get all users with "bob" as the common name and "dull" as the surname: ; "(&(objectClass=Users)(cn=bob)(sn=dull))" ; ; ORDER BY : Optional. An optional statement that generates a server-side ; sort. Active Directory supports the sort control, but it can ; impact server performance if the results set is large. Active ; Directory supports only a single sort key. You can use the ; optional ASC and DESC keywords to specify ascending or descending ; sort order; the default is ascending. ; ; Order by surname with a ascending sort order: ; "sn" ; Order by surname with a descending sort order: ; "sn DESC" ; ; SCOPE : Optional. Specifies the scope of a directory search. ; ; BASE ; Limits the search to the base object. The result contains, ; at most, one object. ; ONELEVEL ; Searches one level of the immediate children, excluding ; the base object. ; SUBTREE (DEFAULT) ; Searches the whole subtree, including all the children and ; the base object itself. ; ; USER : Optional. Specifies the user to connect to the directory. ; ; PASSWORD : Optional. Specifies the password to connect to the directory. ; ;Remarks: ; See http://msdn.microsoft.com/library/en-us/adschema/adschema/attributes_all.asp ; for a list of LDAP attributes that may be queried. ; ;Returns: ; A multi-diminsional array of attributes entered in the order specified in the ; WHAT parameter. ; ; Sets the value of @ERROR based on success/failure (Note: A query that returns no ; data is still considered a successful query). ; Function fnLDAPQuery($What,Optional $From, Optional $Filter, Optional $OrderBy, Optional $Scope, Optional $User, Optional $Pswd) Dim $oCon, $oCommand, $oRS, $sQ, $aR, $C, $R ;-- constants for ADO object -- dim $ads_Secure_Authentication, $ads_chase_referrals_external dim $adUseClient, $adUseServer dim $adCmdText, $adCmdTable dim $adLockUnspecified, $adLockReadOnly, $adLockPessimistic, $adLockOptimistic, $adLockBatchOptimistic dim $adOpenForwardOnly, $adOpenKeyset, $adOpenStatic, $adOpenDynamic $ads_Secure_Authentication = 1 $ads_chase_referrals_external = &00000040 $adUseServer = 2 $adUseClient = 3 $adCmdText = 1 $adCmdTable = 2 $adLockUnspecified = -1 $adLockReadOnly = 1 $adLockPessimistic = 2 $adLockOptimistic = 3 $adLockBatchOptimistic = 4 $adOpenForwardOnly = 0 $adOpenKeyset = 1 $adOpenDynamic = 2 $adOpenStatic = 3 ;-- Create ADO connection object for Active Directory -- $oCon=CreateObject("ADODB.Connection") $oCon.Provider="ADsDSOObject" $oCon.Properties("Encrypt Password").Value=1 $oCon.Properties("ADSI Flag").value = $ads_Secure_Authentication If $User AND $Pswd $oCon.Properties("User ID").Value=$User $oCon.Properties("Password").Value=$Pswd EndIf $oCon.Open("Active Directory Provider") ;-- Create ADO command object for the connection -- $oCommand=CreateObject("ADODB.Command") $oCommand.ActiveConnection=$oCon ;-- Build the filter element of the commandtext -- $sQ= "<"+Iif($From="","LDAP://"+GetObject("LDAP://rootDSE").Get("defaultNamingContext"),$From)+">;"+ $Filter+";"+ Iif(VarType($What)>8192,Join($What,','),$What)+";"+ Iif($Scope<>"base" AND $Scope<>"onelevel","subtree",$Scope) $oCommand.CommandText=$sQ ;-- set ADO command options -- $oCommand.Properties( "Page Size" ).Value = 16384 $oCommand.Properties( "Timeout" ).Value = 120 $oCommand.Properties( "Chase referrals").Value = $ads_chase_referrals_external $oCommand.Properties( "Cache Results" ).Value = 0 ;-- Create ADO recordset object -- If InStr($OrderBy,"distinguishedName") $oRS=CreateObject("ADODB.Recordset") $oRS.CursorLocation = $adUseClient $oRS.Sort=$OrderBy $oRS.Open($sQ, $oCon, $adOpenForwardOnly, $adLockReadOnly, $adCmdText) Else If $OrderBy $oCommand.Properties("Sort On").Value=$OrderBy EndIf $oRS=$oCommand.Execute EndIf If @ERROR Exit @ERROR EndIf If $oRS.BOF AND $oRS.EOF Exit @ERROR EndIf $aR = $oRS.GetRows() Redim $fnLDAPQuery[Ubound($aR,2),Ubound($aR,1)] For $R=0 to Ubound($aR,2) For $C=0 to Ubound($aR,1) $fnLDAPQuery[$R,$C]=$aR[$C,$R] Next Next EndFunction
2 points :
- at the top of the script, $WordDefaultUsername should be initialized with something specific to your company or maybe to the workstation. In my company, PC are cloned from a master so the default username is always the same.
- there is a dependency with fnLDAPQuery function but i put the code i use so that the script should work without "call" or "include".
_________________________
Christophe
|
|
Top
|
|
|
|
Moderator: Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart
|
0 registered
and 2220 anonymous users online.
|
|
|