I am trying to port over Thunderbird/Firefox profile customization scripts from OS X to Windows 7. On OS X they are super simple, using ldapsearch -x -h ldap.place.edu uid="username" to retrieve the email address, real name etc from the OpenLDAP server then throwing these variables into the various configuration files before the applications are loaded.
On Windows this is much more complex, I started trying to use the search.vbs activedirectory/ldap tool that comes with Windows Server 2003 but it doesn't work properly, I also tried simply writing a quick vbs script to connect and query but I always get errors either that the server won't process the request or that just fails... here is my latest vbs script that totally flunks out...
Dim oConn,oRS,vSearch,vCount,vMailList,vValue,vProblem,vMsg
vProblem = False
vSearch = "(uid=username)"
Set oConn = CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOObject"
oConn.Open "ADs Provider", "ou=people,dc=place,dc=edu"
Set oRS = oConn.Execute("<LDAP://ldap.place.edu/dc=edu/dc=place>;" & vSearch &_";cn,mail")
vCount = 1
While not oRS.EOF
For Each vValue in oRS.Fields(0).value
WScript.Echo vValue
Next
vCount = vCount + 1
oRS.MoveNext
Wend
Figured it out a little while back and totally forgot about this, so here it is. I realised I was trying to connect to a anonymous server but was providing a DN while implies a password level of authentication instead of the simple version I needed.
'Server name
sRoot = "LDAP://server"
Dim oDS: Set oDS = GetObject("LDAP:")
'Don't provide a DN for anonymous authentication, also &H0010 implies simple auth mode
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, "", "", &H0010)
Dim oConn: Set oConn = CreateObject("ADODB.Connection")
oConn.Provider = "ADSDSOObject"
oConn.Open "Ads Provider", sDN
Dim rs
'Execute query
Set rs = oConn.Execute("<" & sRoot & ">;(uid=testuser);cn,mail;subtree")
'retrieve values
z = rs.Fields.Item(0).Value
x = rs.Fields.Item(1).Value
Related
I have a script that connects to AD and queries LDAP. The script works as long as you have the proper credentials and are connected to AD. This script runs with a variety of subs and I am trying to make the script more robust to be able to run in multiple environment that may not have AD.
On Error Resume Next
Dim tempResult
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.CommandTimeout = 10
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on user objects.
strFilter = ""
' Comma delimited list of attribute values to retrieve.
strAttributes = "comment,c,co,countryCode,department,description,directReports,displayName,distinguishedName,info,lastLogon,lastLogonTimestamp,mail,manager,memberOf,msExchHomeServerName,name,objectCategory,objectClass,operatingSystem,operatingSystemServicePack,operatingSystemVersion,ou,pwdLastSet,sAMAccountName,title,userAccountControl,userPrincipalName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
if Err<>0 Then
'log error information
End If
Err.Clear
On Error GoTo 0
However when i have the script wrapped in the On Error Resume Next the script will hang when running on a machine that isn't connected to AD or doesn't have sufficient privileges on AD. Any ideas to be able to make this portion of the script run and continue if there is an error? Again if there is an error i don't care about getting any results i just want the script to continue on it's merry way.
The company where I work has an old VB6 application that they want to force to use TSL, rather than SSL. I looked at the code, and told them they should be fine. The code does a post to the client website using HTTPS. It doesn't specify what encryption to use.
This is the relevant code:
Sub PostXML()
Dim XMLHttpRequest As MSXML2.XMLHTTP
Dim TempString As String
Dim strURL As String
Dim strArgs As String
strURL = gPostWebServer & "/" & gPostFile
'ARB 1/8/2004 This is to trap if send fails and allow it to continue.
On Error GoTo errorHandler:
If Not XMLHttpRequest Is Nothing Then Set XMLHttpRequest = Nothing
Set XMLHttpRequest = New MSXML2.XMLHTTP
strArgs = "?Username=" & gPostUserName & "&Password=" & gPostPassword
XMLHttpRequest.Open "POST", strURL & strArgs, False
XMLHttpRequest.send dom_GlobalXMLObject
If XMLHttpRequest.Status >= 400 And XMLHttpRequest.Status <= 599 Then
TempString = "Client Website is not available. Order was not posted successfully ..."
flgOrderPostSuccess = False
strOrderPostError = TempString
Else
TempString = XMLHttpRequest.responseText
'Parse the response
Dim sValid As String
Dim sComments As String
Dim sTimeStamp As String
Dim oRoot As MSXML2.IXMLDOMElement
Dim lNodes As MSXML2.IXMLDOMNodeList
Dim oNodes As MSXML2.IXMLDOMElement
Dim lNodes1 As MSXML2.IXMLDOMNodeList
Dim oNodes1 As MSXML2.IXMLDOMElement
Dim lNodes2 As MSXML2.IXMLDOMNodeList
Dim oNodes2 As MSXML2.IXMLDOMElement
Call Set_Global_XML_Object
dom_GlobalXMLObject.loadXML (TempString)
dom_GlobalXMLObject.Save (Report_Folder & "\Response.xml")
'Get the root of the XML tree.
Set oRoot = dom_GlobalXMLObject.documentElement
If Not oRoot Is Nothing Then
Set lNodes = oRoot.childNodes
For Each oNodes In lNodes
Select Case oNodes.nodeName
Case "Acknowledgement"
Set lNodes1 = oNodes.childNodes
For Each oNodes1 In lNodes1
Select Case oNodes1.nodeName
Case "Received"
sTimeStamp = Trim(oNodes1.nodeTypedValue)
Case "Validated"
sValid = Trim(oNodes1.nodeTypedValue)
Case "Errors"
Set lNodes2 = oNodes1.childNodes
For Each oNodes2 In lNodes2
Select Case oNodes2.nodeName
Case "Description"
sComments = sComments & vbCrLf & Trim(oNodes2.nodeTypedValue)
End Select
Set oNodes2 = Nothing
Next
Set lNodes2 = Nothing
End Select
Set oNodes1 = Nothing
Next
Set lNodes1 = Nothing
End Select
Next
If UCase(sValid) = "YES" Then
TempString = sTimeStamp & " " & "Order uploaded successfully"
flgOrderPostSuccess = True
strOrderPostError = ""
Else
TempString = "Order had following problems:" & vbCrLf
TempString = TempString & sComments
strOrderPostError = TempString
End If
Else 'Non XML response
TempString = Replace(TempString, vbCr, vbCrLf)
TempString = "Order had following problems:" & vbCrLf & TempString
strOrderPostError = TempString
End If
End If
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Set oRoot = Nothing
Set lNodes = Nothing
Set oNodes = Nothing
Set lNodes1 = Nothing
Set oNodes1 = Nothing
Set lNodes2 = Nothing
Set oNodes2 = Nothing
Set XMLHttpRequest = Nothing
Exit Sub
errorHandler:
TempString = Err.DESCRIPTION
If InStr(1, TempString, "Method") > 0 Or InStr(1, Err.DESCRIPTION, "failed") > 0 Then
TempString = "Client Website was not found. Order was not posted successfully..."
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Exit Sub
End If
End Sub
When the client switched from SSL to TSL last weekend, everything worked, except the posts from this one old VB6 app. (So I'm told, anyways. This isn't an application I've supported before.)
We have other VB6 apps that I maintain, but none do a POST out of VB6. All of them use BizTalk for posting.
The client has given us until next Wednesday to fix our app. So, the powers that be want me to force the app to use TSL.
Normally, I don't have problems with VB6, but I've never tried forcing the encryption used to POST. Generally, when we did POST out of the other VB6 apps, they negotiated with Windows on their own, and took care of things. While I've seen successful attempts to force VB6 to use TSL when sending an email, I've never seen anyone do it for POSTing.
All that being said, does anyone know how to force VB6 to use TSL when POSTing?
Thanks
With SChannel you cannot control available/used protocols and ciphers at an application level, you have to configure SChannel protocols/ciphers on the Win2003 box at system level. Here is KB on the subject: http://support.microsoft.com/kb/245030
To disable SSLv3 for both inbound and outbound connections merge something like this in registry (and reboot):
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Client]
"DisabledByDefault"=dword:00000001
"Enabled"=dword:00000000
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Server]
"Enabled"=dword:00000000
"DisabledByDefault"=dword:00000001
While there make sure SSLv2 is nuked too.
You might prefer to use IISCrypto -- a nice utility that makes SSL/TLS protocols/ciphers registry config trivial.
and it is getting successfully executed but i am not able to see the mailbox created. Actually i am using exchange server 2010 and server 2008r2 i am using the command CreateMailBox , but it says it does not support the property/object. So please help me writing a vbscript to create a Mailbox for exchange 2010 and server 2008 R2.
Here is my script
Dim oIADSUser
Dim oMailbox
Set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")
'MsgBox FindAnyMDB("CN=Configuration," & strDefaultNC)
'TODO: Use the newly created domain user account to replace the "UserName".
Set oIADSUser = GetObject("LDAP://CN=UserName,CN=Users," & strDefaultNC)
Set oMailBox = oIADSUser
oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
oIADSUser.SetInfo
Function FindAnyMDB(strConfigurationNC)
Dim oConnection
Dim oCommand
Dim oRecordSet
Dim strQuery
' Open the Connection.
Set oConnection = CreateObject("ADODB.Connection")
set oCommand = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.Recordset")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
' Build the query to find the private MDB.
strQuery = "<LDAP://" & strConfigurationNC & ">; (objectCategory=msExchPrivateMDB);name,adspath;subtree"
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set oRecordSet = oCommand.Execute
' If you have an MDB, return the first one.
If Not oRecordSet.EOF Then
oRecordSet.MoveFirst
FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
Else
FindAnyMDB = ""
End If
'Clean up.
oRecordSet.Close
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
End Function
From everything I've seen, vbscript isn't supported with the move to PowerShell. You could use vbs to call PowerShell and run the appropriate cmdlet if you really need to use vbscript. Other than that you'll probably want to look at a different solution.
$password = Read-Host "Enter password" -AsSecureString
New-Mailbox -UserPrincipalName testuser#mlexchange.net -Alias testuser -Database "Mailbox Database 2048259302" -Name testuser –OrganizationalUnit Users -Password $password -FirstName test -LastName user -DisplayName "Test User" -ResetPasswordOnNextLogon $true
I am experiencing difficulty with the following VBS
set conn = createobject("ADODB.Connection")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
strQueryDL = "<LDAP://company.address.com/cn=address>;(&(objectCategory=person)(objectClass=user));distinguishedName,adspath;subtree"
set objCmd = createobject("ADODB.Command")
objCmd.ActiveConnection = Conn
objCmd.Properties("SearchScope") = 2 ' we want to search everything
objCmd.Properties("Page Size") = 500 ' and we want our records in lots of 500
objCmd.CommandText = strQueryDL
Set objRs = objCmd.Execute
While Not objRS.eof
wscript.echo objRS.Fields("distinguishedName")
' do something with objRS.Fields("distinguishedName")'
objRS.MoveNext
Wend
Please help me, I just started vbscripting and this was from an answer in this website.
wscript.echo objRS.Fields("distinguishedName")
The error was from the above line/code. How do I display out the field or convert it to display?
LDAP://company.address.com/cn=address is not a valid LDAP URL (see here). The search base must be a distinguished name, e.g.:
LDAP://company.address.com/cn=address,dc=address,dc=com
The distinguished name of the domain (dc=address,dc=com) can be obtained like this:
Set rootDSE = GetObject("LDAP://RootDSE")
WScript.Echo rootDSE.Get("defaultNamingContext")
I have code that works correctly to connect to an Active Directory server:
Dim oDSObj: Set oDSObj = GetObject("LDAP:")
Dim oAuth: Set oAuth = oDSObj.OpenDSObject("LDAP://ldap.domain.com", "DOMAIN\username", "password", 1)
However, I can't seem to figure out the syntax to make this work against an OpenLDAP Server:
Dim oDSObj: Set oDSObj = GetObject("LDAP:")
Dim oAuth: Set oAuth = oDSObj.OpenDSObject("LDAP://ldap.domain.com/ou=Users", "username", "password", 1)
To be honest, I'm a bit of a n00b when it comes to LDAP, so I don't understand what dc vs cn vs ou means (I know they stand for org unit, common name etc) but I don't get when you need to tack that on to queries.
Once I connect to the Active Directory server, the following code queries it:
dc = ""
Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Provider = "ADSDSOObject"
oConn.Open "Ads Provider", "DOMAIN\username", "password" '
Dim rs: Set rs = oConn.Execute("<LDAP://ldap.domain.com" & dc & ">;(& (objectCategory=person)(objectClass=user)(sAMAccountName=" & GetLDAPUserName(sPerson) & "));name,mail,telephoneNumber;subtree")
But I realize that sAMAccountName is an AD specific thing, so the openLDAP code will need a different syntax.
The user is 'ldapuser' with a password of 'password', stored here:
ou=Users,dc=domain,dc=com
What is the code to connect to that LDAP server and query for account info?
I finally figured it out:
sUser = "myusername"
sDN = "cn=" & sUser & ",ou=people,dc=company,dc=com"
sRoot = "LDAP://ldapservername.com/dc=company,dc=com"
Dim oDS: Set oDS = GetObject("LDAP:")
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, sDN, "password", &H0200)
Dim oConn: Set oConn = CreateObject("ADODB.Connection")
oConn.Provider = "ADSDSOObject"
oConn.Open "Ads Provider", sDN, "password"
Dim rs
Set rs = oConn.Execute("<" & sRoot & ">;(uid=" & sUser & ");cn,mail,telephoneNumber;subtree")
wscript.echo rs("cn").value
wscript.echo rs("mail").value
wscript.echo rs("telephoneNumber").value
Thanx a lot for your code Michael. I've modified it to simply authenticate users (user-password) using the central OpenLDAP server. Here is the code that worked for me (MSAccess 2003):
sUser = "TheUserName"
sDN = "uid=" & sUser & ",o=users,dc=MyDomain,dc=it"
sRoot = "LDAP://MyLDAPServer/o=users,dc=MyDomain,dc=it"
Dim oDS: Set oDS = GetObject("LDAP:")
On Error GoTo AuthError
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, sDN, "ThePassword", &H200)
On Error GoTo 0
MsgBox "Login Successful"
Exit Sub
AuthError:
If Err.Number = -2147023570 Then
MsgBox "Wrong Username or password !!!"
End If
On Error GoTo 0