|
Hi,
Thank you very much for your work and for the script.
I would like to ask you if there's any way to add a second ldap address book.
I try to change the script but no luck...it will be great if we can add more than one ldap address book on outlook.
Thank you in advance
Sergio
|
|
|
|
|
|
The order of the keys in 01023d01 is not static. The following code checks if the key is the right one. If not it reads the next 16 bytes:
'Get Contacts Registry Key
For num = LBound(Backup) To LBound(Backup) + 15
strRetVal_temp = Dec2Hex(Backup(num))
If (Len (strRetVal_temp) < 2) Then
contactskey = contactskey & "0" & strRetVal_temp
Else
contactskey = contactskey & strRetVal_temp
End if
Next
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026601", Contacts
If (Contacts <> "") Then
'msgbox (contactskey)
Else
contactskey = ""
For num = LBound(Backup) + 16 To LBound(Backup) + 31
strRetVal_temp = Dec2Hex(Backup(num))
If (Len (strRetVal_temp) < 2) Then
contactskey = contactskey & "0" & strRetVal_temp
Else
contactskey = contactskey & strRetVal_temp
End if
Next
'msgbox (contactskey)
End if
|
|
|
|
|
Hi,
i spent another 5 days in development. I solved problems with:
- password encryption and portability of the script to other computers and users
- adress book search order (if you need another order change it in outlook and see what happens to the 11023d05 key, build this syntax with the script)
- script ran multiple times and added the ldap adress book key multiple time
Environment is exchange server 2016 (with global adress list and user's individual contacts) and office 2016.
Here is the new code:
' BASED ON: https://www.codeproject.com/Articles/14053/Adding-an-LDAP-address-book-to-MS-Outlook
' MODIFIED BY nacken2008
' IGNORE ANY ERRORS:
'On Error Resume Next
const HKEY_CURRENT_USER = &H80000001
Set objShell = WScript.CreateObject("Wscript.Shell")
Set objRegistry = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & CreateObject("WScript.Network").ComputerName & "\root\default:StdRegProv")
strRegistryFolder = "Software\Microsoft\Office\16.0\Outlook\Profiles\Outlook"
strMailAccountsSubKey = "9375CFF0413111d3B88A00104B2A6676"
strSearchString = "Service UID"
strLDAPDisplayNameID = "001e3001"
strLDAPServerNameID = "001e6600"
strLDAPDisplayName = "LDAP Address Book"
strLDAPServerName = "ldap.domainname.com"
strLDAPPort = "636"
strLDAPSearchBase = ""
strLDAPUserLogin = "ldap@domainname.com"
strLDAPUserPassword = "MyC00Le$Tp@$$vv0Rd"
If objRegistry.EnumKey(HKEY_CURRENT_USER, strRegistryFolder, arrSubKeys) <> 0 Then
'msgbox("Outlook Profile does not exist")
WScript.Quit
End If
If objRegistry.EnumKey(HKEY_CURRENT_USER, strRegistryFolder & "\" & "e8cb48869c395445ade13e3c1c80d154", arrSubKeys) = 0 Then
'msgbox("Key e8cb48869c395445ade13e3c1c80d154 already exists")
WScript.Quit
End If
strCMD = "powershell.exe -noninteractive -command " & Chr(34) & "$Password = '" & strLDAPUserPassword & "' | ConvertTo-SecureString -AsPlainText -Force | ConvertFrom-SecureString; Write-Host $Password" & Chr(34)
Set objScriptExec = objShell.Exec(strCMD)
objScriptExec.StdIn.Close()
strLDAPUserPassword = objScriptExec.StdOut.ReadAll
If (objScriptExec.status = 1) Then
DELIMITER = "||"
i = 0
do while len(strLDAPUserPassword) <> 0
current = left(strLDAPUserPassword, 2)
strLDAPUserPassword = right(strLDAPUserPassword, len(strLDAPUserPassword) - len(current))
output = output & "&H" & current & DELIMITER
If ((3 < i) And (i <= 19)) Then
strS001e67f1_1 = strS001e67f1_1 & "&H" & current & DELIMITER
End If
If ((23 < i) And (i <= 39)) Then
strS001e67f1_2 = strS001e67f1_2 & "&H" & current & DELIMITER
End If
i = i + 1
loop
output = left(output, len(output) - len(DELIMITER) - 5)
objLDAPUserPassword = split(output, DELIMITER)
strS001e67f1 = "&H01||&H00||&H00||&H00||" & strS001e67f1_1 & "&H01||&H00||&H00||&H00||" & strS001e67f1_2 & "&H00||&H00||&H00||&H00||&H14||&H00||&H00||&H00||&H53||&H00||&H30||&H00||&H30||&H00||&H31||&H00||&H65||&H00||&H36||&H00||&H37||&H00||&H66||&H00||&H31||&H00||&H00||&H00||&H03||&H66||&H00||&H00||&Hc0||&H00||&H00||&H00||&H10||&H00||&H00||&H00||&H53||&H31||&Hf3||&H19||&H7e||&Hbb||&H8a||&Hb6||&H59||&Hcd||&H26||&Hf6||&H3d||&H75||&Hc8||&Hc2||&H00||&H00||&H00||&H00||&H04||&H80||&H00||&H00||&Ha0||&H00||&H00||&H00||&H10||&H00||&H00||&H00||&H60||&H21||&H78||&H2d||&Hb2||&H24||&He4||&H4c||&H77||&Hb4||&H1b||&H98||&Hbc||&Hec||&H40||&H3e||&H08||&H00||&H00||&H00||&Hba||&H6f||&Hed||&Ha4||&H68||&Hcd||&H84||&Hd5||&H14||&H00||&H00||&H00||&H49||&H88||&H84||&H2d||&Hc8||&H50||&H35||&Hcb||&Hfa||&H43||&He7||&H15||&Hdd||&Hbb||&H9c||&H39||&Hc1||&Hf9||&H09||&H94"
objS001e67f1 = split(strS001e67f1, DELIMITER)
strFlagCreateAccount = "yes"
Else
strFlagCreateAccount = "no"
End if
objRegistry.EnumKey HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey, arrProfiles
For Each strSubfolder In arrProfiles
'msgbox (strSubfolder)
objRegistry.GetBinaryValue HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey & "\" & strSubfolder, strSearchString, strRetVal
strSubfolderName = ""
For i = lBound(strRetVal) to uBound(strRetVal)
strRetVal_temp = Dec2Hex(strRetVal(i))
If (Len (strRetVal_temp) < 2) Then
strSubfolderName = strSubfolderName & "0" & strRetVal_temp
Else
strSubfolderName = strSubfolderName & strRetVal_temp
End if
Next
If (strSubfolderName <> "") Then
'msgbox (strRegistryFolder & "\" & LCase (strSubfolderName))
objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPDisplayNameID, strLDAPDisplayNameValue
If (strLDAPDisplayNameValue <> "") Then
If (strLDAPDisplayNameValue = strLDAPDisplayName) Then
strFlagCreateAccount = "no"
End if
End if
objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPServerNameID, strLDAPServerNameValue
If (strLDAPServerNameValue <> "") Then
If (strLDAPServerNameValue = strLDAPServerName) Then
strFlagCreateAccount = "no"
End if
End if
End if
Next
If (strFlagCreateAccount = "yes") Then
CreateAccount objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword, objS001e67f1
End If
Function Dec2Hex (ByVal numAny)
Dim Sign
Const maxNum = 9007199254740991
Const HexChars = "0123456789ABCDEF"
Sign = Sgn(numAny)
numAny = Fix(Abs(CDbl(numAny)))
If numAny > CDbl(maxNum) Then
Wscript.Echo "Dec2Hex Error: " & numAny & " must be greater/less than +/- 9,007,199,254,740,991"
Dec2Hex = Empty
Exit Function
End If 'numAny > maxNum
If numAny = 0 Then
Dec2Hex = "0"
Exit Function
End If
While numAny > 0
Dec2Hex = Mid(HexChars, 1 + (numAny - 16 * Fix(numAny / 16)), 1) & Dec2Hex
numAny = Fix(numAny/16)
WEnd
If Sign = -1 Then Dec2Hex = "-" & Dec2Hex
End Function 'Dec2Hex
Function CreateAccount (objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword, objS001e67f1)
'Add Ldap Type Key
sKeyPath = strRegistryFolder & "\" & "e8cb48869c395445ade13e3c1c80d154\"
objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f300a", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H2e,&H00,&H44,&H00,&H4c,&H00,&H4c,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d13", Array(&H7b,&H00,&H36,&H00,&H34,&H00,&H38,&H00,&H35,&H00,&H44,&H00,&H32,&H00,&H36,&H00,&H38,&H00,&H2d,&H00,&H43,&H00,&H32,&H00,&H41,&H00,&H43,&H00,&H2d,&H00,&H31,&H00,&H31,&H00,&H44,&H00,&H31,&H00,&H2d,&H00,&H41,&H00,&H44,&H00,&H33,&H00,&H45,&H00,&H2d,&H00,&H31,&H00,&H30,&H00,&H41,&H00,&H30,&H00,&H43,&H00,&H39,&H00,&H31,&H00,&H31,&H00,&H43,&H00,&H39,&H00,&H43,&H00,&H30,&H00,&H7d,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3006", Array(&H4d,&H00,&H69,&H00,&H63,&H00,&H72,&H00,&H6f,&H00,&H73,&H00,&H6f,&H00,&H66,&H00,&H74,&H00,&H20,&H00,&H4c,&H00,&H44,&H00,&H41,&H00,&H50,&H00,&H2d,&H00,&H56,&H00,&H65,&H00,&H72,&H00,&H7a,&H00,&H65,&H00,&H69,&H00,&H63,&H00,&H68,&H00,&H6e,&H00,&H69,&H00,&H73,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033e03", Array(&H23,0,0,0)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0c", Array(&H5c,&Hb9,&H3b,&H24,&Hff,&H71,&H07,&H41,&Hb7,&Hd8,&H3b,&H9c,&Hb6,&H31,&H79,&H92)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d09", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3001", Array(&H4d,&H00,&H69,&H00,&H63,&H00,&H72,&H00,&H6f,&H00,&H73,&H00,&H6f,&H00,&H66,&H00,&H74,&H00,&H20,&H00,&H4c,&H00,&H44,&H00,&H41,&H00,&H50,&H00,&H2d,&H00,&H56,&H00,&H65,&H00,&H72,&H00,&H7a,&H00,&H65,&H00,&H69,&H00,&H63,&H00,&H68,&H00,&H6e,&H00,&H69,&H00,&H73,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(0,0,0,0)
'Add Ldap connection settings key
sKeyPath = strRegistryFolder & "\" & "5cb93b24ff710741b7d83b9cb6317992\"
objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d13", Array(&H7b,&H00,&H36,&H00,&H34,&H00,&H38,&H00,&H35,&H00,&H44,&H00,&H32,&H00,&H36,&H00,&H38,&H00,&H2d,&H00,&H43,&H00,&H32,&H00,&H41,&H00,&H43,&H00,&H2d,&H00,&H31,&H00,&H31,&H00,&H44,&H00,&H31,&H00,&H2d,&H00,&H41,&H00,&H44,&H00,&H33,&H00,&H45,&H00,&H2d,&H00,&H31,&H00,&H30,&H00,&H41,&H00,&H30,&H00,&H43,&H00,&H39,&H00,&H31,&H00,&H31,&H00,&H43,&H00,&H39,&H00,&H43,&H00,&H30,&H00,&H7d,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0a", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H2e,&H00,&H44,&H00,&H4c,&H00,&H4c,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "101e3d0f", Array(&H01,&H00,&H00,&H00,&H08,&H00,&H00,&H00,&H45,&H4d,&H41,&H42,&H4c,&H54,&H2e,&H44,&H4c,&H4c,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0b", Array(&H53,&H00,&H65,&H00,&H72,&H00,&H76,&H00,&H69,&H00,&H63,&H00,&H65,&H00,&H45,&H00,&H6e,&H00,&H74,&H00,&H72,&H00,&H79,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(&H20,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f6604", Array(&H28,&H00,&H26,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H63,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H73,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H67,&H00,&H69,&H00,&H76,&H00,&H65,&H00,&H6e,&H00,&H4e,&H00,&H61,&H00,&H6d,&H00,&H65,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d09", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,&H54,&H45,&Had,&He1,&H3e,&H3c,&H1c,&H80,&Hd1,&H54)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023615", Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,&Hd3,&H11,&H9d,&H60,&H00,&Hc0,&H4f,&H4c,&H8e,&Hfa)
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6600", strLDAPServerName
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6601", strLDAPPort
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6602", strLDAPUserLogin
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "S001e67f1", objS001e67f1
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6622", Array(&H00,&H00)
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6603", strLDAPSearchBase
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6605", "SMTP"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6606", "mail"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6607", "60"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6608", "100"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6609", "120"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660a", "15"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660b", ""
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660c", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660d", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660e", "NONE"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660f", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6610", "postalAddress"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6611", "cn"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6612", "1"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3001", strLDAPDisplayName
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026617", objLDAPUserPassword
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00036623", Array(&H00,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026631", Array(&H5b,&Hfe,&H3f,&He9,&H65,&H55,&H19,&H48,&H9c,&H52,&H2d,&H68,&Hfc,&Hb9,&H89,&Hbf)
'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d09", "EMABLT"
'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0a", "BJABLR.DLL"
'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0b", "ServiceEntry"
'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
'objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6604", "(&(mail=*)(|(mail=%s*)" & "(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"'objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001e67f1", Array(&H0a)
'Append to Backup Key for ldap types
sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
Dim oldLength
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &He8
Backup(oldLength+2) = &Hcb
Backup(oldLength+3) = &H48
Backup(oldLength+4) = &H86
Backup(oldLength+5) = &H9c
Backup(oldLength+6) = &H39
Backup(oldLength+7) = &H54
Backup(oldLength+8) = &H45
Backup(oldLength+9) = &Had
Backup(oldLength+10) = &He1
Backup(oldLength+11) = &H3e
Backup(oldLength+12) = &H3c
Backup(oldLength+13) = &H1c
Backup(oldLength+14) = &H80
Backup(oldLength+15) = &Hd1
Backup(oldLength+16) = &H54
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
'Get Contacts Registry Key
For num = LBound(Backup) To LBound(Backup) + 15
strRetVal_temp = Dec2Hex(Backup(num))
If (Len (strRetVal_temp) < 2) Then
contactskey = contactskey & "0" & strRetVal_temp
Else
contactskey = contactskey & strRetVal_temp
End if
Next
'array for ABSearchOrder
Dim ABSearchOrder(203)
ABSearchOrder(0) = &H03
ABSearchOrder(1) = &H00
ABSearchOrder(2) = &H00
ABSearchOrder(3) = &H00
ABSearchOrder(4) = &H1e
ABSearchOrder(5) = &H00
ABSearchOrder(6) = &H00
ABSearchOrder(7) = &H00
ABSearchOrder(8) = &H1c
ABSearchOrder(9) = &H00
ABSearchOrder(10) = &H00
ABSearchOrder(11) = &H00
ABSearchOrder(12) = &H5a
ABSearchOrder(13) = &H00
ABSearchOrder(14) = &H00
ABSearchOrder(15) = &H00
ABSearchOrder(16) = &H3c
ABSearchOrder(17) = &H00
ABSearchOrder(18) = &H00
ABSearchOrder(19) = &H00
ABSearchOrder(20) = &H33
ABSearchOrder(21) = &H00
ABSearchOrder(22) = &H00
ABSearchOrder(23) = &H00
ABSearchOrder(24) = &H98
ABSearchOrder(25) = &H00
ABSearchOrder(26) = &H00
ABSearchOrder(27) = &H00
ABSearchOrder(28) = &H00
ABSearchOrder(29) = &H00
ABSearchOrder(30) = &H00
ABSearchOrder(31) = &H00
'GAL ID 1, length 16
For n = 32 To 47
ABSearchOrder(n) = Backup(n - 16)
Next
'GAL ID 1 end
ABSearchOrder(48) = &H01
ABSearchOrder(49) = &H00
ABSearchOrder(50) = &H00
ABSearchOrder(51) = &H00
ABSearchOrder(52) = &H00
ABSearchOrder(53) = &H01
ABSearchOrder(54) = &H00
ABSearchOrder(55) = &H00
ABSearchOrder(56) = &H2f
ABSearchOrder(57) = &H00
ABSearchOrder(58) = &H00
ABSearchOrder(59) = &H00
ABSearchOrder(60) = &H00
ABSearchOrder(61) = &H00
ABSearchOrder(62) = &H00
ABSearchOrder(63) = &H00
ABSearchOrder(64) = &Hfe
ABSearchOrder(65) = &H42
ABSearchOrder(66) = &Haa
ABSearchOrder(67) = &H0a
ABSearchOrder(68) = &H18
ABSearchOrder(69) = &Hc7
ABSearchOrder(70) = &H1a
ABSearchOrder(71) = &H10
ABSearchOrder(72) = &He8
ABSearchOrder(73) = &H85
ABSearchOrder(74) = &H0b
ABSearchOrder(75) = &H65
ABSearchOrder(76) = &H1c
ABSearchOrder(77) = &H24
ABSearchOrder(78) = &H00
ABSearchOrder(79) = &H00
ABSearchOrder(80) = &H03
ABSearchOrder(81) = &H00
ABSearchOrder(82) = &H00
ABSearchOrder(83) = &H00
ABSearchOrder(84) = &H03
ABSearchOrder(85) = &H00
ABSearchOrder(86) = &H00
ABSearchOrder(87) = &H00
'Contacts ID 1, length 16 (from 01023d01 (0..15) -> 01026601)
sKeyPath = strRegistryFolder & "\" & contactskey & "\"
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026601", Contacts
For n = 88 To 103
ABSearchOrder(n) = Contacts(n - 88)
Next
'Contacts ID 1 end
'Contacts ID 2, length 48 (from 01023d01 (0..15) -> 11026620 (12..59))
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "11026620", Contacts
For n = 104 To 151
ABSearchOrder(n) = Contacts(n - 92)
Next
'Contacts ID 2 end
ABSearchOrder(152) = &H00
ABSearchOrder(153) = &H00
ABSearchOrder(154) = &H00
ABSearchOrder(155) = &H00
'LDAP Adress Book ID, length 16
ABSearchOrder(156) = &H50
ABSearchOrder(157) = &Ha7
ABSearchOrder(158) = &H0a
ABSearchOrder(159) = &H61
ABSearchOrder(160) = &H55
ABSearchOrder(161) = &Hde
ABSearchOrder(162) = &Hd3
ABSearchOrder(163) = &H11
ABSearchOrder(164) = &H9d
ABSearchOrder(165) = &H60
ABSearchOrder(166) = &H00
ABSearchOrder(167) = &Hc0
ABSearchOrder(168) = &H4f
ABSearchOrder(169) = &H4c
ABSearchOrder(170) = &H8e
ABSearchOrder(171) = &Hfa
'LDAP Adress Book ID end
ABSearchOrder(172) = &H01
ABSearchOrder(173) = &H04
ABSearchOrder(174) = &H00
ABSearchOrder(175) = &H00
ABSearchOrder(176) = &Hfe
ABSearchOrder(177) = &Hff
ABSearchOrder(178) = &Hff
ABSearchOrder(179) = &Hff
ABSearchOrder(180) = &H00
ABSearchOrder(181) = &H75
ABSearchOrder(182) = &H72
ABSearchOrder(183) = &H62
ABSearchOrder(184) = &H6f
ABSearchOrder(185) = &H6b
ABSearchOrder(186) = &H2e
ABSearchOrder(187) = &H62
ABSearchOrder(188) = &H65
ABSearchOrder(189) = &H72
ABSearchOrder(190) = &H2e
ABSearchOrder(191) = &H6d
ABSearchOrder(192) = &H79
ABSearchOrder(193) = &H74
ABSearchOrder(194) = &H6f
ABSearchOrder(195) = &H79
ABSearchOrder(196) = &H73
ABSearchOrder(197) = &H2e
ABSearchOrder(198) = &H64
ABSearchOrder(199) = &H65
ABSearchOrder(200) = &H00
ABSearchOrder(201) = &H00
ABSearchOrder(202) = &H00
ABSearchOrder(203) = &H00
sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "11023d05", ABSearchOrder
'Append to Backup Key for ldap connection settings
sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &H5c
Backup(oldLength+2) = &Hb9
Backup(oldLength+3) = &H3b
Backup(oldLength+4) = &H24
Backup(oldLength+5) = &Hff
Backup(oldLength+6) = &H71
Backup(oldLength+7) = &H07
Backup(oldLength+8) = &H41
Backup(oldLength+9) = &Hb7
Backup(oldLength+10) = &Hd8
Backup(oldLength+11) = &H3b
Backup(oldLength+12) = &H9c
Backup(oldLength+13) = &Hb6
Backup(oldLength+14) = &H31
Backup(oldLength+15) = &H79
Backup(oldLength+16) = &H92
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
'Delete Active Books List Key
sKeyPath = strRegistryFolder & "\" & "9375CFF0413111d3B88A00104B2A6676"
objRegistry.DeleteValue HKEY_CURRENT_USER, sKeyPath, "{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
End Function 'CreateAccount
modified 15-Jun-17 11:00am.
|
|
|
|
|
Good day. Why does the script swear by a virus?
|
|
|
|
|
Hi,
i think there is an error in the section 'Delete Active Books List Key'. {ED475419-B0D6-11D2-8C3B-00104B2A6676} is not a registry key but a value. So the code has to be:
Wrong:
sKeyPath = strRegistryFolder & "\" & "9375CFF0413111d3B88A00104B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
objRegistry.DeleteKey HKEY_CURRENT_USER, sKeyPath
Right
sKeyPath = strRegistryFolder & "\" & "9375CFF0413111d3B88A00104B2A6676"
objRegistry.DeleteValue HKEY_CURRENT_USER, sKeyPath, "{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
Greetings
nacken
modified 15-Jun-17 10:59am.
|
|
|
|
|
Hi,
in my environment (Windows 8.1 64-Bit/ Office 2016 32-Bit) the registry key is at:
HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\Profiles\Outlook
Also the keys names in the Ldap Type Key are others:
001e300a -> 001f300a
001e3d13 -> 001f3d13
001e3006 -> 001f3006
001e3d09 -> 001f3d09
001e3001 -> 001f3001
Greetings
|
|
|
|
|
Is there any possibility to add more then one ldap address book by script?
|
|
|
|
|
Hi!
Firstly, i would like to say thank you for this code! It has definitely addressed my issue =)
I would like to add this vbscript to my domain login script but i would like it to check the registry to see if this setting has been added for the user/PC before and if it has then to skip this code but if it hasn't then to add the LDAP information. I am a newbie to vbscript so can you give me the code i need to add to this so it can do a check first?
I hope you understand what i mean?
Thank you
|
|
|
|
|
Which version of Outlook did you build this for? The reason I ask is that I'm comparing the keys you're creating with keys I already have on a machine that has the LDAP directory configured, and they don't correspond.
I'm also looking to incorporate the username and passwords... I see the username key in plain text but I don't see how the pass is stored...
Also, did you ever try to just export the registry key(s) from one machine and install on another?
|
|
|
|
|
Regarding the LDAP password -- I'd like to know this as well. I'm migrating a perfectly working LDAP setup to authenticated from anon (user and pwd blank). The username is a no-brainer, but the password cannot be simply copied. It appears to be salted with something .. unknown. 
|
|
|
|
|
- it is a binary data
- it is coded by Data Protection API (DPAPI)and only way to get a right binary coded password is using CryptProtectData
- there is no way to use CryptProtectData by VBScript (I cann't find it)
2 days of searching an answer and here it is:
On Error Resume Next
const HKEY_CURRENT_USER = &H80000001
Set objShell = WScript.CreateObject("Wscript.Shell")
Set objRegistry = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" & CreateObject("WScript.Network").ComputerName & "\root\default:StdRegProv")
strRegistryFolder = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook"
strMailAccountsSubKey = "9375CFF0413111d3B88A00104B2A6676"
strSearchString = "Service UID"
strLDAPDisplayNameID = "001e3001"
strLDAPServerNameID = "001e6600"
strLDAPDisplayName = "LDAP Address Book"
strLDAPServerName = "ldap.domainname.com"
strLDAPPort = "636"
strLDAPSearchBase = ""
strLDAPUserLogin = "ldap@domainname.com"
strLDAPUserPassword = "MyC00Le$Tp@$$vv0Rd"
strCMD = "powershell.exe -noninteractive -command " & Chr(34) & "$Password = '" & strLDAPUserPassword & "' | ConvertTo-SecureString -AsPlainText -Force | ConvertFrom-SecureString; Write-Host $Password" & Chr(34)
Set objScriptExec = objShell.Exec(strCMD)
objScriptExec.StdIn.Close()
strLDAPUserPassword = objScriptExec.StdOut.ReadAll
If (objScriptExec.status = 0) Then
DELIMITER = "||"
do while len(strLDAPUserPassword) <> 0
current = left(strLDAPUserPassword, 2)
strLDAPUserPassword = right(strLDAPUserPassword, len(strLDAPUserPassword) - len(current))
output = output & "&H" & current & DELIMITER
loop
output = left(output, len(output) - len(DELIMITER) - 5)
objLDAPUserPassword = split(output, DELIMITER)
strFlagCreateAccount = "yes"
Else
strFlagCreateAccount = "no"
End if
objRegistry.EnumKey HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey, arrProfiles
For Each strSubfolder In arrProfiles
objRegistry.GetBinaryValue HKEY_CURRENT_USER, strRegistryFolder & "\" & strMailAccountsSubKey & "\" & strSubfolder, strSearchString, strRetVal
strSubfolderName = ""
For i = lBound(strRetVal) to uBound(strRetVal)
strRetVal_temp = Dec2Hex(strRetVal(i))
If (Len (strRetVal_temp) < 2) Then
strSubfolderName = strSubfolderName & "0" & strRetVal_temp
Else
strSubfolderName = strSubfolderName & strRetVal_temp
End if
Next
If (strSubfolderName <> "") Then
objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPDisplayNameID, strLDAPDisplayNameValue
If (strLDAPDisplayNameValue <> "") Then
If (strLDAPDisplayNameValue = strLDAPDisplayName) Then
strFlagCreateAccount = "no"
End if
End if
objRegistry.GetStringValue HKEY_CURRENT_USER, strRegistryFolder & "\" & LCase (strSubfolderName), strLDAPServerNameID, strLDAPServerNameValue
If (strLDAPServerNameValue <> "") Then
If (strLDAPServerNameValue = strLDAPServerName) Then
strFlagCreateAccount = "no"
End if
End if
End if
Next
If (strFlagCreateAccount = "yes") Then
CreateAccount objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword
End If
Function Dec2Hex (ByVal numAny)
Dim Sign
Const maxNum = 9007199254740991
Const HexChars = "0123456789ABCDEF"
Sign = Sgn(numAny)
numAny = Fix(Abs(CDbl(numAny)))
If numAny > CDbl(maxNum) Then
Wscript.Echo "Dec2Hex Error: " & numAny & " must be greater/less than +/- 9,007,199,254,740,991"
Dec2Hex = Empty
Exit Function
End If
If numAny = 0 Then
Dec2Hex = "0"
Exit Function
End If
While numAny > 0
Dec2Hex = Mid(HexChars, 1 + (numAny - 16 * Fix(numAny / 16)), 1) & Dec2Hex
numAny = Fix(numAny/16)
WEnd
If Sign = -1 Then Dec2Hex = "-" & Dec2Hex
End Function
Function CreateAccount (objRegistry, HKEY_CURRENT_USER, strRegistryFolder, strLDAPDisplayName, strLDAPServerName, strLDAPPort, strLDAPSearchBase, strLDAPUserLogin, objLDAPUserPassword)
sKeyPath = strRegistryFolder & "\" & "e8cb48869c395445ade13e3c1c80d154\"
objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(0,0,0,0)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033e03", Array(&H23,0,0,0)
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3001", "Microsoft LDAP Directory"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3006", "Microsoft LDAP Directory"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e300a", "EMABLT.DLL"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d09", "EMABLT"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0c", Array(&H5c,&Hb9,&H3b,&H24,&Hff,&H71,&H07,&H41,&Hb7,&Hd8,&H3b,&H9c,&Hb6,&H31,&H79,&H92)
sKeyPath = strRegistryFolder & "\" & "5cb93b24ff710741b7d83b9cb6317992\"
objRegistry.CreateKey HKEY_CURRENT_USER, sKeyPath
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00033009", Array(&H20,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "00036623", Array(&H01,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(&H01,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(&H01,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6622", Array(&H01,&H00)
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3001", strLDAPDisplayName
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d09", "EMABLT"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0a", "BJABLR.DLL"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d0b", "ServiceEntry"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6600", strLDAPServerName
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6601", strLDAPPort
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6602", strLDAPUserLogin
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6603", strLDAPSearchBase
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6605", "SMTP"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6606", "mail"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6607", "30"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6608", "100"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6609", "120"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660a", "15"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660b", ""
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660c", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660d", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660e", "NONE"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e660f", "OFF"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6604", "(&(mail=*)(|(mail=%s*)" & "(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6610", "postalAddress"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6611", "cn"
objRegistry.SetStringValue HKEY_CURRENT_USER, sKeyPath, "001e6612", "1"
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001e67f1", Array(&H0a)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d13", Array(&H7b,&H00,&H36,&H00,&H34,&H00,&H38,&H00,&H35,&H00,&H44,&H00,&H32,&H00,&H36,&H00,&H38,&H00,&H2d,&H00,&H43,&H00,&H32,&H00,&H41,&H00,&H43,&H00,&H2d,&H00,&H31,&H00,&H31,&H00,&H44,&H00,&H31,&H00,&H2d,&H00,&H41,&H00,&H44,&H00,&H33,&H00,&H45,&H00,&H2d,&H00,&H31,&H00,&H30,&H00,&H41,&H00,&H30,&H00,&H43,&H00,&H39,&H00,&H31,&H00,&H31,&H00,&H43,&H00,&H39,&H00,&H43,&H00,&H30,&H00,&H7d,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0a", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H2e,&H00,&H44,&H00,&H4c,&H00,&H4c,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d0b", Array(&H53,&H00,&H65,&H00,&H72,&H00,&H76,&H00,&H69,&H00,&H63,&H00,&H65,&H00,&H45,&H00,&H6e,&H00,&H74,&H00,&H72,&H00,&H79,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f6604", Array(&H28,&H00,&H26,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H6d,&H00,&H61,&H00,&H69,&H00,&H6c,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H63,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H7c,&H00,&H28,&H00,&H73,&H00,&H6e,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H28,&H00,&H67,&H00,&H69,&H00,&H76,&H00,&H65,&H00,&H6e,&H00,&H4e,&H00,&H61,&H00,&H6d,&H00,&H65,&H00,&H3d,&H00,&H25,&H00,&H73,&H00,&H2a,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H29,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001f3d09", Array(&H45,&H00,&H4d,&H00,&H41,&H00,&H42,&H00,&H4c,&H00,&H54,&H00,&H00,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,&H54,&H45,&Had,&He1,&H3e,&H3c,&H1c,&H80,&Hd1,&H54)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023615", Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,&Hd3,&H11,&H9d,&H60,&H00,&Hc0,&H4f,&H4c,&H8e,&Hfa)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026617", objLDAPUserPassword
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026631", Array(&H98,&H17,&H82,&H92,&H5b,&H43,&H03,&H4b,&H99,&H5d,&H5c,&Hc6,&H74,&H88,&H7b,&H34)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "101e3d0f", Array(&H02,&H00,&H00,&H00,&H0c,&H00,&H00,&H00,&H17,&H00,&H00,&H00,&H45,&H4d,&H41,&H42,&H4c,&H54,&H2e,&H44,&H4c,&H4c,&H00,&H42,&H4a,&H41,&H42,&H4c,&H52,&H2e,&H44,&Hc,&H4c,&H00)
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "S001e67f1", Array (&H01,&H00,&H00,&H00,&Hd0,&H8c,&H9d,&Hdf,&H01,&H15,&Hd1,&H11,&H8c,&H7a,&H00,&Hc0,&H4f,&Hc2,&H97,&Heb,&H01,&H00,&H00,&H00,&Hb8,&He7,&H82,&Hb0,&H4b,&Hfd,&H01,&H45,&H91,&H17,&H18,&H63,&Hbc,&H54,&H40,&H0b,&H00,&H00,&H00,&H00,&H14,&H00,&H00,&H00,&H53,&H00,&H30,&H00,&H30,&H00,&H31,&H00,&H65,&H00,&H36,&H00,&H37,&H00,&H66,&H00,&H31,&H00,&H00,&H00,&H03,&H66,&H00,&H00,&Hc0,&H00,&H00,&H00,&H10,&H00,&H00,&H00,&H40,&H79,&H50,&H1f,&H85,&H87,&H08,&H1a,&H21,&Had,&Hc9,&Hce,&H5c,&H66,&H05,&H96,&H00,&H00,&H00,&H00,&H04,&H80,&H00,&H00,&Ha0,&H00,&H00,&H00,&H10,&H00,&H00,&H00,&H69,&H7a,&Hca,&He2,&Hdd,&H77,&Ha9,&H9c,&Hb1,&Hc4,&Hbc,&H1c,&Hcd,&He7,&Hcb,&Hdd,&H08,&H00,&H00,&H00,&H8c,&Hd7,&H16,&Hfb,&Hc1,&H4e,&H8b,&H08,&H14,&H00,&H00,&H00,&H14,&Hb6,&Hcb,&H4a,&H6a,&Hc1,&H3e,&H67,&Hec,&H8c,&Hcd,&H2c,&H5c,&H34,&H90,&Heb,&H56,&Hab,&Hb5,&Hc7)
sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
Dim oldLength
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &He8
Backup(oldLength+2) = &Hcb
Backup(oldLength+3) = &H48
Backup(oldLength+4) = &H86
Backup(oldLength+5) = &H9c
Backup(oldLength+6) = &H39
Backup(oldLength+7) = &H54
Backup(oldLength+8) = &H45
Backup(oldLength+9) = &Had
Backup(oldLength+10) = &He1
Backup(oldLength+11) = &H3e
Backup(oldLength+12) = &H3c
Backup(oldLength+13) = &H1c
Backup(oldLength+14) = &H80
Backup(oldLength+15) = &Hd1
Backup(oldLength+16) = &H54
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
sKeyPath = strRegistryFolder & "\" & "9207f3e0a3b11019908b08002b2a56c2\"
objRegistry.getBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &H5c
Backup(oldLength+2) = &Hb9
Backup(oldLength+3) = &H3b
Backup(oldLength+4) = &H24
Backup(oldLength+5) = &Hff
Backup(oldLength+6) = &H71
Backup(oldLength+7) = &H07
Backup(oldLength+8) = &H41
Backup(oldLength+9) = &Hb7
Backup(oldLength+10) = &Hd8
Backup(oldLength+11) = &H3b
Backup(oldLength+12) = &H9c
Backup(oldLength+13) = &Hb6
Backup(oldLength+14) = &H31
Backup(oldLength+15) = &H79
Backup(oldLength+16) = &H92
objRegistry.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
sKeyPath = strRegistryFolder & "\" & "9375CFF0413111d3B88A00104B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
objRegistry.DeleteKey HKEY_CURRENT_USER, sKeyPath
End Function
|
|
|
|
|
Great script!!!,
anyway in my environment the value of objScriptExec.status equals to 1 (not to 0). So i had to change the line to:
If (objScriptExec.status = 1) Then
Greetings
modified 15-Jun-17 11:00am.
|
|
|
|
|
Is it possible to specify the username and password for LDAP authentication. I tried using the Office Resource kit to change prf files but it doesn't let you set the password.
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
