I'm trying to write a script that connects to Active Directory using Administrator credentials. Then searches the entire domain for a specific username, then updates that user's properties. I've written a script that I think should work, but I'm getting "Access Denied" errors, weirdly enough.
Here's the script, which I've put into sections. Because it's supposed to run through SuperOffice, which has it's own unique environment.
Dim strUser, rootDSE, adoConnection, ldapStr, adoRecord, objUser
updateUser()
Public Sub updateUser()
ADUsername = "john.doe"
createADConnection()
If userExistsInAD(ADUsername) = False Then
Exit Sub
End if
objUser.Put "description", "testing"
objUser.SetInfo
End Sub
Public Sub createADConnection()
Set rootDSE = GetObject("LDAP://RootDSE")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADSDSOObject"
adoConnection.Properties("User ID") = "mydomain\administrator"
adoConnection.Properties("Password") = "8g773ggj024g"
adoConnection.Properties("Encrypt Password") = True
adoConnection.Properties("ADSI Flag") = ADS_SERVER_BIND Or ADS_SECURE_AUTHENTICATION
adoConnection.Open "Active Directory Provider"
End Sub
Public Function userExistsInAD(ByVal strUser)
ldapStr = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">;(&(objectCategory=Person)(objectClass=User)(samAccountName=" & strUser & "));adspath;subtree"
Set adoRecord = adoConnection.Execute(ldapStr)
If Not adoRecord.EOF Then
userExistsInAD = True
Exit Function
End if
userExistsInAD = False
End Function
Sounds to me like the account you are running SuperOffice with does not have Domain Admin credentials. Have you tried running it directly with your account?
Related
When I run the following script on it's own by double clicking, it works just fine. It returns the last logged on user as expected. But when I run it from the HTA I have been developing as a front end to all of my scripts, I get a type mismatch error on the "wscript.echo strvalue" line. I have tried everything to get it to work, like changing permissions on mshta.exe to full control for myself. I simply can't get it to run from the HTA without getting an error, but it works 100% as expected on its own. I am completely stumped.
strinput = "myserver"
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strinput & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
Wscript.Echo strValue
By default, Windows 64-bit uses MSHTA.EXE 32-bit. The registry has a separate branches for 64-bit and 32-bit apps, thus WMI can't find the registry value you are looking for.
Save the code below to e. g. C:\test\tmp.hta, try to launch it from explorer by double-click (32-bit by default) - you will get null, and then launch via Run dialog (Win+R) with path: %windir%\system32\mshta.exe "C:\test\tmp.hta" (64-bit), the result will be your username.
<html>
<head>
<script language="vbscript">
Sub window_onload()
Const HKEY_LOCAL_MACHINE = &H80000002
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
document.body.innerText = strValue
End Sub
</script>
</head>
<body>
</body>
</html>
Note that many other stuff within scripts depends on application architecture, e. g. number of ActiveX are available only in 32-bit version, so they should be launched via %windir%\SysWOW64\ (Windows 32-bit on Windows 64-bit subsystem).
Use Msgbox function instead of Wscript.Echo method. HTAs use the Internet Explorer Scripting Object Model which does not contain Wscript object (this belongs to Windows Script Host Object Model).
Read HTA: Why Can’t I Use Wscript.Echo?:
You might have noticed that when it came time to report back the
operating system version we used the VBScript Msgbox function rather
than the more common Wscript.Echo. Why didn’t we use Wscript.Echo?
Here’s why:
As it turns out the various Wscript methods - Wscript.Echo,
Wscript.Sleep, Wscript.Quit, etc. - are designed solely to run under
the Windows Script Host environment. When we’re working in an HTA
we’re not running under WSH; instead we’re running under the MSHTA
process. Because of that the Wscript methods are not available to us
(nor can we create them). Consequently we need to find workarounds for
each method, and Msgbox is a perfectly adequate replacement for
Wscript.Echo. (We’ll talk about workarounds for other methods - such
as Wscript.Sleep - when we get to them.)
The moral of the story: Don’t bother with Wscript.Echo; it won’t work.
Edit: with Wscript.Echo TypeName(strValue) & vbNewLine & VarType(strValue):
==> C:\Windows\System32\cscript.exe D:\VB_scripts\SO\33505295.vbs
String
8
==> C:\Windows\SysWOW64\cscript.exe D:\VB_scripts\SO\33505295.vbs
Null
1
Tried in a simple HTA which gives the same (different) result
==> C:\Windows\System32\mshta.exe 33505295.hta
versus
==> C:\Windows\SysWOW64\mshta.exe 33505295.hta
Conclusion. Check HTA file type association. For instance, ftype htafile in my Windows 8 (64bit) returns (surprisingly?) the same value which causes wrong behaviour on double click:
==> assoc .hta
.hta=htafile
==> ftype htafile
htafile=C:\Windows\SysWOW64\mshta.exe "%1" {1E460BD7-F1C3-4B2E-88BF-4E770A288AF5}%U{1E460BD7-F1C3-4B2E-88BF-4E770A288AF5} %*
I have had the same challenge a few weeks ago.
The following code provided me the possibility to see who is currently logged onto a remote computer.
I hope this can help you.
Sub ActionGetCurrentUser(strCPU) 'strCPU is the computername
set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strCPU & "\root\cimv2")
set Items = objWMI.ExecQuery("Select * From Win32_ComputerSystem")
For Each obj in Items
OutStr = right(obj.username,9)
Next
Resultstring = "Logged in User is: " & OutStr
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strTarget = "LDAP://" & strDNSDomain
' ---------------- Write the User's account & password to a variable -------------------
strCurrentuser = Currentuser.value
strPassword = PasswordArea.value
' ---------------- Connect to Ad Provider ----------------
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User ID") = strCurrentUser ' pass credentials - if you omit this, the search is performed....
objConnection.Properties("Password") = strPassword ' ... with the current credentials
objConnection.Properties("Encrypt Password") = True ' only needed if you set "User ID" and "Password"
objConnection.Open "Active Directory Provider"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConnection
objCmd.CommandText = "SELECT DisplayName FROM '" & strTarget & "' WHERE extensionAttribute11 = '" & OutStr & "'"
Const ADS_SCOPE_SUBTREE = 2
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 30
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCmd.Properties("Cache Results") = False
Set objRecordSet = objCmd.Execute
If objRecordset.Recordcount = 0 then ' If no user is found then the recordcount will be 0
msgbox "No user is logged on"
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
exit sub
End if
Set objRecordSet = objCmd.Execute
objRecordSet.MoveFirst
Resultstring = Resultstring & vbcrlf & "Name: " & objRecordset.fields("DisplayName")
Msgbox Resultstring
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
End Sub
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
Salvete!
On my server I am running hMailServer, and that service uses the local system account.
I need to copy a file to another machine. So I have this a script that will use cmdkey.exe to save the credentials and then copy the file.
If I run this function myself (in a standalone vbs file) whilst logged into the server, it works, but I am admin.
However, if I let the hMailServer service run this function, the function runs, but it always says the destination does not exist.
Notice I have commented out the deletion of the credentials. If I go to the server and run cmdkey /list I see that the credentials were never set, which means the command failed. That means the first setting of the credentials probably failed too, which is why 'objFSO' cannot find the directory.
Again, if I put all this in a separate file and run it as test.vbs by double-clicking the file, it works. But if I use it from within hMailServer, it fails.
I suppose this means the hMailServer (local system account) doesn't have rights to set credentials? How do I get this to work?
option explicit
dim SPcopyMessage
SPcopyMessage = CopyFileToRemoteMachine("SERVER", "mydomain\username", "password", "c:\test2.txt", "\\SERVER\somefolder\otherfolder")
MsgBox SPcopyMessage
function CopyFileToRemoteMachine(whatMachine, whatUsername, whatPassword, whatSourceFile, whatDestination)
dim errormessage, CredentialCreate, CredentialDelete
errormessage = "Sharepoint Mail Delivered"
CredentialCreate = "cmd.exe /c cmdkey /add:" & whatMachine & " /user:" & whatUsername & " /pass:" & whatPassword
Dim objShell, objFSO
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
CALL objShell.Run(CredentialCreate, 0, True) 'add username to the credentials list
If objFSO.FileExists(whatSourceFile) Then
If objFSO.FolderExists(whatDestination) Then
If Right(whatDestination, 1) <> "\" Then
whatDestination = whatDestination & "\"
End If
objFSO.CopyFile whatSourceFile, whatDestination, True
Else
errormessage = "Destination does not exist: " & whatDestination
End If
Else
errormessage = "Source file does not exist: " & whatSourceFile
End If
'CredentialDelete = "cmd.exe /c cmdkey /delete:" & whatMachine
'CALL objShell.Run(CredentialDelete, 0, True)
set objFSO = nothing
set objShell = nothing
CopyFileToRemoteMachine = errormessage
end function
Figured out a way! First, I made sure the destination was shared to the right user account on machine2. Then made the script on machine1 to map the network drive and then copy the file. This will work as long as the N drive is never used for anything else on that machine.
Here is the code is if be helpful to anyone!
function CopyFileToRemoteMachine(whatMachine, whatUsername, whatPassword, whatSourceFile, whatDestination)
dim errormessage, mdrive
errormessage = "File successfully copied"
mdrive = "N:"
Dim objFSO, objNetwork
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("Wscript.Network")
If not objFSO.FileExists(mdrive) Then
objNetwork.MapNetworkDrive mdrive, whatDestination, False, whatUsername, whatPassword
End If
If Right(whatDestination, 1) <> "\" Then
whatDestination = whatDestination & "\"
End If
If objFSO.FileExists(whatSourceFile) Then
If objFSO.FolderExists(whatDestination) Then
objFSO.CopyFile whatSourceFile, whatDestination, True
Else
errormessage = "Destination does not exist: " & whatDestination
End If
Else
errormessage = "Source file does not exist: " & whatSourceFile
End If
objNetwork.RemoveNetworkDrive mdrive,TRUE,TRUE
set objFSO = nothing
set objNetwork = nothing
CopyFileToRemoteMachine = errormessage
end function
In Active Directory, there is a tab called "Dial-In", and under that tab is a radio button control with three settings:
Allow Access
Deny Access
Control access through remote access policy
I'd like to write a VBScript to take a user name, and return the setting for that user.
(I'm actually modifying an existing VBScript, which is why I am forced to use that tool).
What is the best way to do that?
Here is the best solution I was able to come up with. It is easy to modify it to output the setting for all users.
Main
Function Main
'Usage: cscript /nologo lookup.vbs mydomain username
Wscript.Echo CanDialIn(Wscript.Arguments(0), Wscript.Arguments(1))
Main = 0
End Function
Function CanDialIn(domainname, username)
'Take a user name and query whether they have permission to Dial in or not
'http://www.microsoft.com/technet/scriptcenter/resources/qanda/aug05/hey0825.mspx
Const ADS_SCOPE_SUBTREE = 2
Dim objConnection
Dim objCommand
Dim objRecordSet
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
'Three possible values for msNPAllowDialin:
'TRUE = "Allow Access"
'FALSE = "Deny Access"
'EMPTY = "Control access through remote access policy"
objCommand.CommandText = _
"SELECT msNPAllowDialin FROM 'LDAP://dc=" & domainname & ",dc=com' WHERE objectCategory='user' AND sAMAccountName = '" & username & "'"
On Error Resume Next
Set objRecordSet = objCommand.Execute
if objRecordSet.EOF then
CanDialIn = "Could not find user " & username
else
if objRecordSet.Fields("msNPAllowDialin").Value = True then
CanDialIn = "Allow"
else
if objRecordSet.Fields("msNPAllowDialin").Value = False then
CanDialIn = "Deny"
else
CanDialIn = "Control"
end if
end if
end if
End Function
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