I have a program that allows to login by using the windows login information, and I am trying to get the windows groups members when the user enter his password, I wrote a small function similar to my code :
procedure ShowADSPath(UserName, Password: widestring);
var Group : IADs;
begin
try
OleCheck(ADsOpenObject('WinNT://Server/Group1',
UserName,
Password, ADS_SECURE_AUTHENTICATION, IADs, Group));
if (Group <> nil) and (Group.Class_ = 'Group') then
ShowMessage(Group.ADsPath);
Group.release;
Group:= nil;
except
ShowMessage('NOT ACCESSDE');
end;
end;
so when the entered username and password are right the program returns the path for the group
when wrong 'NOT ACCESSED' appears.
the function works well if I enter the right username and password for the first time, or if I enter wrong username and password data it works fine too.
the problem is when I call the function second time it doesn't work as expected like:
when I run my program and first I enter wrong password and call my function 'NOT ACCESSED' will appear as expected, but if I recall the function even with the right password it returns 'NOT ACCESSED' too.
Also when I run my program and first I enter right password and call my function the groups path appears as expected, but if I recall the function with the wrong password it returns the path too.
it looks like my connection data became saved, and I need to free the memory but I don't know how.
any body can help?
Finally I could find a solution for my issue, which looks like a Microsoft API issue described in this article:
http://support.microsoft.com/kb/218497
actually the API function ADsOpenObject is opening a connection with the server using the credentials you pass but it never close that connection, I tried to close it but it doesn't became close in the session, so I used another API to check the existence of the object first, check out this function it worked for me:
procedure ShowADSPath(UserName, Password: widestring);
function CheckObject(APath: String): IDispatch;
var
Moniker: IMoniker;
Eaten: integer;
BindContext: IBindCtx;
Dispatch: IDispatch;
begin
Result := nil;
OleCheck(CreateBindCtx(0, BindContext));
OleCheck(MkParseDisplayName(BindContext, PWideChar(WideString(APath)),
Eaten, Moniker));
OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Dispatch));
Result := Dispatch;
end;
var Group : IADs;
begin
try
if CheckObject('WinNT://Server/Group1,group') <> nil then
OleCheck(ADsOpenObject('WinNT://Server/Group1,group',
UserName,
Password, ADS_SECURE_AUTHENTICATION, IADs, Group));
if (Group <> nil) and (Group.Class_ = 'Group') then
begin
ShowMessage(Group.ADsPath);
Group.release;
Group:= nil;
end;
except
ShowMessage('NOT ACCESSDE');
end;
end;
Related
as the subject say am trying to connect to server using this code in delphi
procedure TmainF.Button1Click(Sender: TObject);
var
rdp1 : TMsRdpClient7NotSafeForScripting ;
begin
rdp1 := TMsRdpClient7NotSafeForScripting.Create(self);
rdp1.Parent := mainF;
rdp1.Server:=server_name;
rdp1.UserName := user.Text;
rdp1.AdvancedSettings7.ClearTextPassword := password.Text;
rdp1.ConnectingText := 'connecting';
rdp1.DisconnectedText := 'disconnected';
rdp1.AdvancedSettings7.AuthenticationLevel:=0;
rdp1.AdvancedSettings7.EnableCredSspSupport:=true;
rdp1.Connect;
end;
the code is working fine but if the user entered a wrong user name or password
the rdp object is showing the remote desktop login prompt box to reenter the user name or password like the image
I want to validate the username and password before connect
or prevent this box and show a custom message from my app
I tried to use OnLogonError() procedure but it's not fired any code
and I read this Question but the code is c# and I confused with .getocx() and I can't find (PromptForCredentials) in (MSTSCLib_TLB.pas)
any help :( ??
sorry for my bad English.
There is an interface IMsRdpClientNonScriptable5 that has the following methods:
Get_AllowPromptingForCredentials()
Set_AllowPromptingForCredentials()
If you call Set_AllowPromptingForCredentials() with the parameter set to false the dialog won't appear.
As for how to get an instance of this interface - easy, you just cast the ControlInterface of your RDP client object:
Ircns5 := rdp1.ControlInterface as IMsRdpClientNonScriptable5;
if Assigned(Ircns5) then
Ircns5.Set_AllowPromptingForCredentials(False);
You could pass the username and password to the Windows API function "LogonUser" before establishing the connection. For this to work the authenticating entity must be available on the user's network.
{$APPTYPE CONSOLE}
uses SysUtils, Windows;
var
hToken : THandle;
begin
if (ParamCount <> 3) then
begin
WriteLn ('LogonUserTest.exe [user name] [domain] [password]');
Halt ($FF);
end; { if }
try
Win32Check (LogonUser (PChar (ParamStr (1)), PChar (ParamStr (2)),
PChar (ParamStr (3)), Logon32_Logon_Interactive,
LOGON32_PROVIDER_DEFAULT, hToken));
WriteLn ('LogonUser success');
CloseHandle (hToken);
except
on E: Exception do
Writeln (E.ClassName, ': ', E.Message);
end; { try / except }
end.
i would like to know whether a user inputs the correct combination of Domain, User and Password for his Active Directory user.
I tried to make a very simple program that is not able to connect but by reading the error message i can know if the user/password is correct.
This is trick based (the logic is on reading the Exception message), anyway i testd this prototype on 2 servers and i noticed that the excpetion messages change from server to server so this is not reliable.
uses adshlp, ActiveDs_TLB;
// 3 TEdit and a TButton
procedure TForm4.Button1Click(Sender: TObject);
Var
aUser : IAdsUser;
pDomain, pUser, pPassword : string;
myResult : HRESULT;
Counter: integer;
begin
pDomain := edtDomain.Text;
pUser:= edtUser.Text;
pPassword := edtPwd.Text;
Counter := GetTickCount;
Try
myResult := ADsOpenObject(Format('LDAP://%s',[pDomain]),Format('%s\%s',[pDomain,pUser]),pPassword,
ADS_READONLY_SERVER,
IAdsUser,aUser);
except
On E : EOleException do
begin
if (GetTickCount - Counter > 3000) then ShowMessage ('Problem with connection') else
if Pos('password',E.Message) > 0 then ShowMessage ('wrong username or password') else
if Pos('server',E.Message) > 0 then ShowMessage ('Connected') else
ShowMessage('Unhandled case');
memLog.Lines.Add(E.Message);
end;
end
end;
The reason why i set "Connected" if the message contain "server" is that on my
local machine (on my company ldap server in fact) in case all is fine (domain, user and password) the server replies "The server requires a safer authentication", so the "server" word is in there, while in other cases it says "wrong user or password". SInce this must work on itlian and english servers i set "server" and "pasword" as reliable words. Anyway i tested on another server that gives differente errors.
I started from a reply to this question to do the above.
How can i check if the user set the correct password or not in a more reliable way using a similar technique?
UPDATE (found solution)
Thanks to the replies i managed to write this function that does what i need. It seems quite reliable up to now, I write here to share, hoping it can help others:
// This function returns True if the provided parameters are correct
// login credentials for a user in the specified Domain
// From empirical tests it seems reliable
function UserCanLogin(aDomain, aUser, aPassword: string): Boolean;
var
hToken: THandle;
begin
Result := False;
if (LogonUser(pChar(aUser), pChar(aDomain), pChar(aPassword), LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, hToken)) then
begin
CloseHandle(hToken);
Result := True;
end;
end;
You need to check the error code that ADsOpenObject returns. do not base your error checking on the returned exception messages.
if the function succeeded it will return S_OK, otherwise you need to refer to ADSI Error Codes, specifically, the LDAP error codes for ADSI
When an LDAP server generates an error and passes the error to the
client, the error is then translated into a string by the LDAP client.
This method is similar to Win32 error codes for ADSI. In this example,
the client error code is the WIN32 error 0x80072020.
To Determine the LDAP error codes for ADSI
Drop the 8007 from the WIN32 error code. In the example, the remaining hex value is 2020.
Convert the remaining hex value to a decimal value. In the example, the remaining hex value 2020 converts to the decimal value
8224.
Search in the WinError.h file for the definition of the decimal value. In the example, 8224L corresponds to the error
ERROR_DS_OPERATIONS_ERROR.
Replace the prefix ERROR_DS with LDAP_. In the example, the new definition is LDAP_OPERATIONS_ERROR.
Search in the Winldap.h file for the value of the LDAP error definition. In the example, the value of LDAP_OPERATIONS_ERROR in
the Winldap.h file is 0x01.
For a 0x8007052e result (0x052e = 1326) for example you will get ERROR_LOGON_FAILURE
From your comment:
Since the function always raises an exception i am not able to read
the code
You are getting an EOleException because your ADsOpenObject function is defined with safecall calling convention. while other implementations might be using stdcall. when using safecall Delphi will raise an EOleException and the HResult will be reflected in the EOleException.ErrorCode, otherwise (stdcall) will not raise an exception and the HResult will be returned by the ADsOpenObject function.
i would like to know whether a user inputs the correct combination of
Domain, User and Password for his Active Directory user.
You can use LogonUser function to validate user login e.g. :
if (LogonUser(pChar(_Username), pChar(_ADServer), pChar(_Password), LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, hToken)) then
begin
CloseHandle(hToken);
//...
//DoSomething
end
else raise Exception.Create(SysErrorMessage(GetLastError));
Note: You must use LogonUser within a domain machine to be able to use the domain login or the function will always return The user name or password is incorrect
The alternative is using TLDAPSend e.g. :
function _IsAuthenticated(const lpszUsername, lpszDomain, lpszPassword: string): Boolean;
var
LDAP : TLDAPSend;
begin
Result := False;
if ( (Length(lpszUsername) = 0) or (Length(lpszPassword) = 0) )then Exit;
LDAP := TLDAPSend.Create;
try
LDAP.TargetHost := lpszDomain;
LDAP.TargetPort := '389';
....
LDAP.UserName := lpszUsername + #64 + lpszDomain;;
LDAP.Password := lpszPassword;
Result := LDAP.Login;
finally
LDAP.Free;
end;
end;
How can i check if the user set the correct password or not in a more
reliable way using a similar technique?
Try to use FormatMessage function
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
nil,
myResult,
LANG_ENGLISH or SUBLANG_ENGLISH_US,
lpMsg,
0,
nil);
MessageBox(0, lpMsg, 'Msg', 0);
I get (HRESULT) 0x8007052e (2147943726) "unknown user name or bad password" when I use a wrong password. And there is no EOleException, try:
hr := ADsOpenObject('LDAP://'+ ADomain + '/OU=Domain Controllers,' + APath,
AUser, APwd,
ADS_SECURE_AUTHENTICATION or ADS_READONLY_SERVER,
IID_IADs, pObject);
if (hr=HRESULT(2147943726)) then ShowMessage ('wrong username or password')
I was using an example from here :
establishing connection
Did it this way :
procedure TDataModule2.DataModuleCreate(Sender: TObject);
begin
with FDGUIxLoginDialog1.VisibleItems do begin
Clear;
Add('Server=Strežnik');
Add('User_name=Uporabnik');
Add('Password=Geslo');
Add('Database=Baza');
end;
try
FDConnection1.Connected := True;
except
on E: EAbort do
application.terminate; // user pressed Cancel button in Login dialog
on E:EFDDBEngineException do
case E.Kind of
ekUserPwdInvalid: ; // user name or password are incorrect
//ekUserPwdExpired: ; // user password is expired
ekServerGone: ; // DBMS is not accessible due to some reason
else
// other issues
end;
end;
end;
However, application will not terminate after hitting cancel in the login dialog but shows my main form. What should I do to correct this ?
Also, how can I flash a message if the password was wrong, in this scenario ?
Firedac is connecting to SQL Server.
ps
Even this will not work :
.....
except
on E: EFDDBEngineException do
if E.Kind = ekUserPwdInvalid then
begin
ShowMessage('A user name or a password are invalid');
Abort;
end;
An application usually quits by closing its main form.
You should never let an application quit by issuing an exception; it's bad form.
EAbort is not an exception that gets issued by the login dialog. In fact under normal circumstances te login dialog will not issue any exception.
If the user presses Cancel then the connection will not get ehm.. connected, you can test that.
Here's a list of all the errors TFDConnection can generate.
The following code should work:
type
TAction = (aSuccess, aGiveup, aWrongPassword, aPasswordExpired);
procedure TDataModule2.DataModuleCreate(Sender: TObject);
var
VI: TStrings;
WhatToDo: TAction;
begin
WhatToDo:= aSuccess;
VI:= FDGUIxLoginDialog1.VisibleItems;
VI.Clear;
VI.Add('Server=Strežnik');
VI.Add('User_name=Uporabnik');
VI.Add('Password=Geslo');
VI.Add('Database=Baza');
try
FDConnection1.Connected := True;
except
on E:EFDDBEngineException do case E.Kind of
ekUserPwdInvalid: WhatToDo:= aWrongPassword;
ekUserPwdExpired: WhatToDo:= aPasswordExpired;
else WhatToDo:= aGiveUp;
end; {case}
end;
if Not(FDConnection1.Connected) then WhatToDo:= aGiveUp;
case Action of
aWrongPassword: begin
ShowMessage('You've entered a wrong username or password please try again');
DataModuleCreate(Sender);
Action:= aSuccess;
end;
aPasswordExpired: ShowMessage('You password has expired, please request a new one from the PHB');
end;
if Action <> aSuccess then Application.Terminate;
end;
Comments about coding style
Do not use with. With is evil use a temporary variable instead and use that to reference the nested variable(s).
Terminating on an error without issuing an error is really silly.
No user is going to be happy having an application die on them without any explanation why.
You should never terminate on a wrong password or username.
As least give the user the change to try again 3 or 4 times.
If he doesn't get it right by then issue the "wrong username or password" error message and quit.
Never tell the user which (username or password) is wrong, an attacker can use that to generate a list of usernames.
I would like to create a type of login window in Delphi. Unfortunately I can't get it to match the username and password.
I have a basic .mdb database, with an Users table. In this table, there is a Username and Password. I want Delphi to check the username and password in the database and if it matches those in the edit boxes, it goes to the next form or shows a message, otherwise it does nothing. When I enter the database's first row, username and password values, I get success, but with the second, nothing. I feel like I need a way to get it to move on to the second rows values and check those and so on. There is also currently no relationships in the database.
This is my layout of Data Access: ADOConnection -> ADOTable -> DataSource
Thanks in advance!
As per your guess, one solution can be to move record by record to check each one. Example:
function MatchPass(Table: TADOTable; const Name, Pass: string): Boolean;
begin
Result := False;
Table.First;
while not Table.Eof do begin
if Table.FieldByName('Username').AsString = Name then begin
Result := Table.FieldByName('Password').AsString = Pass;
Exit;
end;
Table.Next;
end;
end;
Can be called like:
if MatchPass(ADOTable1, Edit1.Text, Edit2.Text) then
..
Another solution can be to let the ADOTable search for a corresponding record:
function MatchPass(Table: TADOTable; const Name, Pass: string): Boolean;
begin
Result := Table.Locate('Username;Password', VarArrayOf([Name, Pass]), []);
end;
I have the need to restrict specific functions of an application based on the location of the currently logged in user. As I have to implement this logic in Delphi, I'd prefer not to go overboard with full active directory/LDAP queries.
My curent thought is to utilize DsGetDcName, and use the GUID returned in the DOMAIN_CONTROLLER_INFO structure and compare it to a hard coded constant. It seems to reason that a domain GUID would only change if the domain is recreated, so this would provide functionality that I desire with limited overhead. My only concern is that I can't find any documentation on MSDN confirming my assumption.
type
EAccessDenied = Exception;
EInvalidOwner = Exception;
EInsufficientBuffer = Exception;
ELibraryNotFound = Exception;
NET_API_STATUS = Integer;
TDomainControllerInfoA = record
DomainControllerName: LPSTR;
DomainControllerAddress: LPSTR;
DomainControllerAddressType: ULONG;
DomainGuid: TGUID;
DomainName: LPSTR;
DnsForestName: LPSTR;
Flags: ULONG;
DcSiteName: LPSTR;
ClientSiteName: LPSTR;
end;
PDomainControllerInfoA = ^TDomainControllerInfoA;
const
NERR_Success = 0;
procedure NetCheck(ErrCode: NET_API_STATUS);
begin
if ErrCode <> NERR_Success then
begin
case ErrCode of
ERROR_ACCESS_DENIED:
raise EAccessDenied.Create('Access is Denied');
ERROR_INVALID_OWNER:
raise EInvalidOwner.Create('Cannot assign the owner of this object.');
ERROR_INSUFFICIENT_BUFFER:
raise EInsufficientBuffer.Create('Buffer passed was too small');
else
raise Exception.Create('Error Code: ' + IntToStr(ErrCode) + #13 +
SysErrorMessage(ErrCode));
end;
end;
end;
function IsInternalDomain: Boolean;
var
NTNetDsGetDcName: function(ComputerName, DomainName: PChar; DomainGuid: PGUID; SiteName: PChar; Flags: ULONG; var DomainControllerInfo: PDomainControllerInfoA): NET_API_STATUS; stdcall;
NTNetApiBufferFree: function (lpBuffer: Pointer): NET_API_STATUS; stdcall;
LibHandle: THandle;
DomainControllerInfo: PDomainControllerInfoA;
ErrMode: Word;
const
NTlib = 'NETAPI32.DLL';
DS_IS_FLAT_NAME = $00010000;
DS_RETURN_DNS_NAME = $40000000;
INTERNAL_DOMAIN_GUID: TGUID = '{????????-????-????-????-????????????}';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
ErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
LibHandle := LoadLibrary(NTlib);
SetErrorMode(ErrMode);
if LibHandle = 0 then
raise ELibraryNotFound.Create('Unable to map library: ' + NTlib);
try
#NTNetDsGetDcName := GetProcAddress(Libhandle, 'DsGetDcNameA');
#NTNetApiBufferFree := GetProcAddress(Libhandle,'NetApiBufferFree');
try
NetCheck(NTNetDsGetDcName(nil, nil, nil, nil, DS_IS_FLAT_NAME or DS_RETURN_DNS_NAME, DomainControllerInfo));
Result := (DomainControllerInfo.DomainName = 'foo.com') and (CompareMem(#DomainControllerInfo.DomainGuid,#INTERNAL_DOMAIN_GUID, SizeOf(TGuid)));//WideCharToString(pDomain);
finally
NetCheck(NTNetApiBufferFree(DomainControllerInfo));
end;
finally
FreeLibrary(LibHandle);
end;
end
else
Result := False;
end;
Added a related question on ServerFault as suggested.
Found another interesting read on Technet which also seems to hint at me being right, but isn't specifically scoped at domain SID's.
Create a service account on the domain;
Get the GUID of the service account and encrypt it and save it somewhere (registry) maybe as part of enterprise install process to validate a license agreement.
On startup of the client app query for the Domain Service Account GUID and validate it with the saved GUID.
Or create your own enterprise 'key' server.
Doing an LDAP query is easier than doing all the domain controller crap.
If I correct understand your requirement the best API in your case is GetUserNameEx. You can choose the value of NameFormat parameter of the type EXTENDED_NAME_FORMAT which you can better verify. Another function GetComputerNameEx is helpful if you want additionally verify the information about the computer where the program is running.
I have the need to restrict specific
functions of an application based on
the location of the currently logged
in user
If you are trying to find out the location of the currently logged in user, you shouldn't be using DsGetDcName.
Your computer can be joined to domainA. Your logon user can be from domainB. Calling DsGetDcName on your computer doesn't give you domainB GUID but it will give you domainA GUID
Therefore, I think you should use LookupAccountName instead. The LookupAccountName gives you the currently logged in user's SID. Then, you can extract the domain SID from the user SID. That domain SID is really the domain where this user coming from. For the details of how to extract a domain SID from a user SID, please check here
Regarding to your original question about the uniqueness of the domain GUID, I am sorry that I don't have answer on it. AFAIK, there is no tool available allowing you to change the domain SID nor the GUID. I am not sure how hard to hack into it and change it.