abasov
Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Исправляет некорректное имя автора в Office 2003 на ФИО (displayName) из AD.
Собственно баг в кодировке при добавлении в реестр. Коллеги как исправить?
(видимо ldap utf > реестр 1251)
Код: Set fs = CreateObject("Scripting.FileSystemObject")
set WshShell = WScript.CreateObject("WScript.Shell")
' get UserName
strName = WshShell.ExpandEnvironmentStrings("%USERNAME%")
On Error Resume Next
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1179 = 1
Set objNetwork = CreateObject("Wscript.Network")
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
Wscript.Quit
End If
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use the NameTranslate object to find the NetBIOS domain name from the
' DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_TYPE_NT4, strDNSDomain
objTrans.Set ADS_NAME_TYPE_1179, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
objTrans.Init ADS_NAME_INITTYPE_DOMAIN, strNetBIOSDomain
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1179)
' Bind to the user object in Active Directory with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)
'Get Common name
strUsername=objUser.Get("displayName") & ", " & objUser.Get("telephoneNumber")
'strUsername= objUser.cn
'WScript.Echo strUsername
'Convert Initials to HEX
For i = 1 to Len(strName)
strInitialsHex = strInitialsHex & "," & Hex(Asc(Mid(strName, i, 1))) & ",00"
Next
strInitialsHex = Right(strInitialsHex , Len(strInitialsHex ) -1)
strInitialsHex = strInitialsHex & ",00,00"
'Convert Username to HEX
For i = 1 to Len(strUsername)
strUsernameHex = strUsernameHex & "," & Hex(Asc(Mid(strUsername, i, 1))) & ",00"
Next
strUsernameHex = Right(strUsernameHex, Len(strUsernameHex) -1)
strUsernameHex = strUsernameHex & ",00,00"
' Create temporary registry file
Const OverwriteIfExist = -1
Const FailIfExist = 0
Const OpenAsASCII = 0
Const OpenAsUnicode = -1
Const OpenAsDefault = -2
sTmpFile = WshShell.ExpandEnvironmentStrings("%TEMP%") & "\UserInfo.reg"
Set fFile = fs.CreateTextFile(sTmpFile, OverwriteIfExist, OpenAsASCII)
' Write to the temporary registry file
fFile.WriteLine "Windows Registry Editor Version 5.00"
fFile.WriteLine
fFile.WriteLine "[HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\UserInfo]"
fFile.WriteLine """UserName""=hex:" & strUsernameHex
fFile.WriteLine """UserInitials""=hex:" & strInitialsHex
fFile.Close
' Import the registry file
WshShell.Run "regedit /s " & sTmpFile, 0, True
' Delete the temporary registry file
fs.DeleteFile sTmpFile |
рабочий вариант, спасибо за помощь script-coding dot info и лично alexii:
Код: Set fs = CreateObject("Scripting.FileSystemObject")
set WshShell = WScript.CreateObject("WScript.Shell")
' get UserName
strName = WshShell.ExpandEnvironmentStrings("%USERNAME%")
On Error Resume Next
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1179 = 1
Set objNetwork = CreateObject("Wscript.Network")
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
Wscript.Quit
End If
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use the NameTranslate object to find the NetBIOS domain name from the
' DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_TYPE_NT4, strDNSDomain
objTrans.Set ADS_NAME_TYPE_1179, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
objTrans.Init ADS_NAME_INITTYPE_DOMAIN, strNetBIOSDomain
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1179)
' Bind to the user object in Active Directory with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)
'Get Common name
strUsername=objUser.Get("displayName") & ", " & objUser.Get("telephoneNumber")
'strUsername= objUser.cn
'WScript.Echo strUsername
'Convert Initials to HEX
Const HKEY_CURRENT_USER = &H80000001
Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
strUsername = strUsername & Chr(0)
ReDim arrValues(LenB(strUsername) - 1)
For i = 1 To Len(strUsername)
intDValue = AscW(Mid(strUsername, i, 1))
intBigValue = intDValue \ &HFF
intLittleValue = (intDValue - intBigValue) Mod &HFF
arrValues(i * 2 - 2) = intLittleValue
arrValues(i * 2 - 1) = intBigValue
Next
errReturn = objRegistry.SetBinaryValue _
(HKEY_CURRENT_USER, "Software\Microsoft\Office\11.0\Common\UserInfo", "UserName", arrValues)
Set objRegistry = Nothing |
|
Всего записей: 345 | Зарегистр. 12-11-2002 | Отправлено: 16:42 26-02-2009 | Исправлено: abasov, 06:24 27-02-2009 |
|
)
