Prev: Number of pages in TIF image
Next: Terminate process issue
From: Graham Turner on 1 Jul 2008 16:04
dear all, was wondering if someone could offer a helping-hand with
this script .

the aim of the script is to automatically populate the Username
registry value for Office 2003 such that it is prepopulated with data
from AD and does not prompt the user.

the AD query seems fine.

however i have an issue with the writing of the reg_binary data in
that would seem related to the data retrieved from AD, as if i hard-
wire text into the 'strusername' variable all is well.(using the Ascii
function).

first up i have found that i need to use the 'unicode' function of the
script to get any 'sensible' data in to the registry, which would seem
related to the storage of the data in AD.

when doing this the observed behaviour is for the script to enter
registry data that is nearly correct, but non-printable chars appear
in the User information dialog of the application.

when we look at the binary data using regedit we are missing "00 00"
from the hex data as compared to the data which yields correct user
information as viewed in the office applications.

I hope this makes sense. TIA

script content follows.(feel free to offer mods !....

On Error Resume Next

'this first section uses and we then , from which we derive the LDAP
query
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName

Set objUser = GetObject("LDAP://" & strUser)

strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.TelephoneNumber

Const HKEY_CURRENT_USER = &H80000001
Const strPath = "Software\Microsoft\Office\11.0\Common\UserInfo"
Dim objNet, ObjRegistry, strUserName, uBinary, Return
Set objNet = CreateObject("WScript.NetWork")
Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
strUserName = lcase(objNet.UserName)
' uBinary = Str2BinA(strUserName)
uBinary = Str2BinU(strUserName)
WScript.Echo Join(uBinary)
Return = objRegistry.SetBinaryValue(HKEY_CURRENT_USER, strPath,
"UserName", uBinary)
If Return = 0 Then
WScript.Echo "Binary value added successfully"
Else
' An error occurred
End If
'
Function Str2BinA(Src) ' Ascii version
Dim Tmp(), I, L
L = Len(Src): ReDim Tmp(L - 1)
For I = 1 To L: Tmp(I - 1) = Asc(Mid(Src, I)): Next
Str2BinA = Tmp
End Function
'
Function Str2BinU(Src) ' Unicode version
Dim Tmp(), I, L
L = LenB(Src): ReDim Tmp(L - 1)
For I = 1 To L: Tmp(I - 1) = AscB(MidB(Src, I)): Next
Str2BinU = Tmp
End Function




From: ThatsIT.net.au on 12 Jul 2008 22:04
I stuggled with this before

this scripts creates a reg file, and then imports the reg file. but you
could modify it to use regwrite,
there is a ref to my domnain and to a shared folder that you need to change
But you would be interested in the sub "hexDis" sub

on error resume next

dim network:Set network = CreateObject("WScript.Network")
dim user: user = network.UserName


dim fullName: fullName = getFullName(user)


Function getFullName(user)
Set usr = GetObject("WinNT://thatsIT.local/" & user)
getFullName = usr.Get("Fullname")
End Function


dim twoNames:twoNames = Split(fullName," ")

initials = Mid(twoNames(0),1,1)

if UBound(twoNames) => 1 then
initials = initials & Mid(twoNames(1),1,1)
end if


hexDis initials,"UserInitials"
hexDis fullName,"UserName"
hexDis "ThatsIT Solutions","Company"




sub hexDis(dis,valueToChange)
' Convert ascii to hex and add "00"'s and commas
For i = 1 to Len(dis)
disHex = disHex & "," _
& Hex(Asc(Mid(dis, i, 1))) & ",00"
Next
' Remove trailing comma
disHex = Right(disHex, Len(disHex) -1)

' Add terminating ",00,00"
disHex = disHex & ",00,00"
' Ready to create temporary registry file
Const OverwriteIfExist = true
Const FailIfExist = 0
Const OpenAsASCII = 0
Const OpenAsUnicode = -1
Const OpenAsDefault = -2

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
oFSO.GetFolder("\\hank\shared")
sTmpFile = oShell.ExpandEnvironmentStrings("%TEMP%") & "\mso_usr.reg"
Set fFile = oFSO.CreateTextFile(sTmpFile, _
OverwriteIfExist, OpenAsASCII)
fFile.WriteLine "REGEDIT4"
fFile.WriteLine
fFile.WriteLine "[HKEY_CURRENT_USER\Software\Microsoft\" _
& "Office\11.0\Common\UserInfo]"
fFile.WriteLine """"& valueToChange &"""=hex:" & disHex
fFile.Close
' Import the registry file
oShell.Run "regedit /s " & sTmpFile, 0, True
if oFSO.FileExists(sTmpFile) then
oFSO.DeleteFile sTmpFile
end if
End sub






"Graham Turner" <ipcomp1(a)gotadsl.co.uk> wrote in message
news:3664212a-e30c-480b-a260-4f0802375422(a)r66g2000hsg.googlegroups.com...
> dear all, was wondering if someone could offer a helping-hand with
> this script .
>
> the aim of the script is to automatically populate the Username
> registry value for Office 2003 such that it is prepopulated with data
> from AD and does not prompt the user.
>
> the AD query seems fine.
>
> however i have an issue with the writing of the reg_binary data in
> that would seem related to the data retrieved from AD, as if i hard-
> wire text into the 'strusername' variable all is well.(using the Ascii
> function).
>
> first up i have found that i need to use the 'unicode' function of the
> script to get any 'sensible' data in to the registry, which would seem
> related to the storage of the data in AD.
>
> when doing this the observed behaviour is for the script to enter
> registry data that is nearly correct, but non-printable chars appear
> in the User information dialog of the application.
>
> when we look at the binary data using regedit we are missing "00 00"
> from the hex data as compared to the data which yields correct user
> information as viewed in the office applications.
>
> I hope this makes sense. TIA
>
> script content follows.(feel free to offer mods !....
>
> On Error Resume Next
>
> 'this first section uses and we then , from which we derive the LDAP
> query
> Set objSysInfo = CreateObject("ADSystemInfo")
> strUser = objSysInfo.UserName
>
> Set objUser = GetObject("LDAP://" & strUser)
>
> strName = objUser.FullName
> strTitle = objUser.Title
> strDepartment = objUser.Department
> strCompany = objUser.Company
> strPhone = objUser.TelephoneNumber
>
> Const HKEY_CURRENT_USER = &H80000001
> Const strPath = "Software\Microsoft\Office\11.0\Common\UserInfo"
> Dim objNet, ObjRegistry, strUserName, uBinary, Return
> Set objNet = CreateObject("WScript.NetWork")
> Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
> strUserName = lcase(objNet.UserName)
> ' uBinary = Str2BinA(strUserName)
> uBinary = Str2BinU(strUserName)
> WScript.Echo Join(uBinary)
> Return = objRegistry.SetBinaryValue(HKEY_CURRENT_USER, strPath,
> "UserName", uBinary)
> If Return = 0 Then
> WScript.Echo "Binary value added successfully"
> Else
> ' An error occurred
> End If
> '
> Function Str2BinA(Src) ' Ascii version
> Dim Tmp(), I, L
> L = Len(Src): ReDim Tmp(L - 1)
> For I = 1 To L: Tmp(I - 1) = Asc(Mid(Src, I)): Next
> Str2BinA = Tmp
> End Function
> '
> Function Str2BinU(Src) ' Unicode version
> Dim Tmp(), I, L
> L = LenB(Src): ReDim Tmp(L - 1)
> For I = 1 To L: Tmp(I - 1) = AscB(MidB(Src, I)): Next
> Str2BinU = Tmp
> End Function
>
>
>
>

 | 
Pages: 1
Prev: Number of pages in TIF image
Next: Terminate process issue