Finally, I wrote a working code with auth by password. Problems with (writing password to registry):
- 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
|