unit uSBD_LogOn2;
interface
uses Classes, Windows, Dialogs;
type
TUserTestResult = (rFail, rPass, rCancel);
const
Default_LogOnDlgTitle = '
';
Default_LogOnDlgCaption = '
';
type
TLogOnDialog =
class( TCommonDialog)
private
FUserName : widestring;
FDomain : widestring;
FPassword : widestring;
FTitle : widestring;
FPrompt : widestring;
FLogOnResult: TUserTestResult;
FuseLocalAdmin: boolean;
function DoExecute: boolean;
public
constructor Create( AOwner: TComponent);
override;
function Execute: Boolean;
override;
procedure Burn;
property Password : widestring
read FPassword
write FPassword;
property LogOnResult: TUserTestResult
read FLogOnResult
write FLogOnResult;
published
property UserName : widestring
read FUserName
write FUserName;
property Domain : widestring
read FDomain
write FDomain;
property Title : widestring
read FTitle
write FTitle;
property Prompt : widestring
read FPrompt
write FPrompt;
property useLocalAdministrators: boolean
read FuseLocalAdmin
write FuseLocalAdmin;
end;
// TO DO: Get the list of administrator UserName/Domain.
implementation
// Refer:
// [url]http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seca[/url]...
// security/impersonateloggedonuser.asp
// [url]http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seca[/url]...
// security/logonuser.asp
// [url]http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seca[/url]...
// security/creduipromptforcredentials.asp
// [url]http://msdn.microsoft.com/library/default.asp?url=/library/en-us/secbp/[/url]
// security/asking_the_user_for_credentials.asp
uses SysUtils;
type
TCredUI_InfoA =
packed record
cbSize: DWord;
hwndParent: HWND;
pszMessageText: PAnsiChar;
pszCaptionText: PAnsiChar;
hbmBanner: HBitMap
end;
PCredUI_InfoA = ^TCredUI_InfoA;
TCredUI_InfoW =
packed record
cbSize: DWord;
hwndParent: HWND;
pszMessageText: PWideChar;
pszCaptionText: PWideChar;
hbmBanner: HBitMap
end;
PCredUI_InfoW = ^TCredUI_InfoW;
TCredUIPromptForCredentials_FuncA =
function(
var pUiInfo: TCredUI_InfoA;
pszTargetname: PAnsiChar;
Reserved: THandle;
dsAuthError: DWord;
pszUersName: PAnsiChar;
ulUserNameMaxChars: ulong;
pszPassword: PAnsiChar;
ulPasswordMaxChars: ulong;
var pfSave: bool;
dwFlags: DWord): DWord;
stdcall;
TCredUIPromptForCredentials_FuncW =
function(
var pUiInfo: TCredUI_InfoW;
pszTargetname: PWideChar;
Reserved: THandle;
dsAuthError: DWord;
pszUersName: PWideChar;
ulUserNameMaxChars: ulong;
pszPassword: PWideChar;
ulPasswordMaxChars: ulong;
var pfSave: bool;
dwFlags: DWord): DWord;
stdcall;
// StrLenLimit: Scan Src for a null terminator up to MaxLen bytes
function StrLenLimit(Src: PChar; MaxLen: Cardinal): Cardinal;
begin
if Src =
nil then
begin
Result := 0;
Exit;
end;
Result := MaxLen;
while (Src^ <> #0)
and (Result > 0)
do
begin
Inc(Src);
Dec(Result);
end;
Result := MaxLen - Result;
end;
procedure BurnWideString(
var SensitiveValue: widestring);
var
L: integer;
begin
L := Length( SensitiveValue);
if L = 0
then exit;
FillChar( SensitiveValue, L * SizeOf( WideChar), #0);
SensitiveValue := '
'
end;
type
TDialogFunc =
function(
var DialogData): Bool
stdcall;
function Global_DialogFunc (
var DialogData): Bool
stdcall;
begin
result := TLogOnDialog( DialogData).DoExecute
end;
{ TLogOnDialog }
procedure TLogOnDialog.Burn;
begin
BurnWideString( FUsername);
BurnWideString( FDomain);
BurnWideString( FPassword)
end;
constructor TLogOnDialog.Create( AOwner: TComponent);
begin
inherited;
FUserName := '
';
FDomain := '
';
FPassword := '
';
FTitle := Default_LogOnDlgTitle;
FPrompt := Default_LogOnDlgCaption;
FLogOnResult := rCancel;
FuseLocalAdmin := False
end;
const
CRED_MAX_GENERIC_TARGET_NAME_LENGTH = 32767;
CRED_MAX_DOMAIN_TARGET_NAME_LENGTH = 256 + 1 + 80;
CRED_MAX_USERNAME_LENGTH = 256 + 1 + 256;
CRED_MAX_CREDENTIAL_BLOB_SIZE = 512;
CREDUI_MAX_MESSAGE_LENGTH = 32767;
CREDUI_MAX_CAPTION_LENGTH = 128;
CREDUI_MAX_GENERIC_TARGET_LENGTH = CRED_MAX_GENERIC_TARGET_NAME_LENGTH;
CREDUI_MAX_DOMAIN_TARGET_LENGTH = CRED_MAX_DOMAIN_TARGET_NAME_LENGTH;
CREDUI_MAX_USERNAME_LENGTH = CRED_MAX_USERNAME_LENGTH;
CREDUI_MAX_PASSWORD_LENGTH = CRED_MAX_CREDENTIAL_BLOB_SIZE
div 2;
CREDUI_FLAGS_INCORRECT_PASSWORD = $00001;
// indicates the username is valid, but password is not
CREDUI_FLAGS_DO_NOT_PERSIST = $00002;
// Do not show "Save" checkbox, and do not persist credentials
CREDUI_FLAGS_REQUEST_ADMINISTRATOR = $00004;
// Populate list box with admin accounts
CREDUI_FLAGS_EXCLUDE_CERTIFICATES = $00008;
// do not include certificates in the drop list
CREDUI_FLAGS_REQUIRE_CERTIFICATE = $00010;
CREDUI_FLAGS_SHOW_SAVE_CHECK_BOX = $00040;
CREDUI_FLAGS_ALWAYS_SHOW_UI = $00080;
CREDUI_FLAGS_REQUIRE_SMARTCARD = $00100;
CREDUI_FLAGS_PASSWORD_ONLY_OK = $00200;
CREDUI_FLAGS_VALIDATE_USERNAME = $00400;
CREDUI_FLAGS_COMPLETE_USERNAME = $00800;
CREDUI_FLAGS_PERSIST = $01000;
// Do not show "Save" checkbox, but persist credentials anyway
CREDUI_FLAGS_SERVER_CREDENTIAL = $04000;
CREDUI_FLAGS_EXPECT_CONFIRMATION = $20000;
// do not persist unless caller later confirms credential via CredUIConfirmCredential() api
CREDUI_FLAGS_GENERIC_CREDENTIALS = $40000;
// Credential is a generic credential
CREDUI_FLAGS_USERNAME_TARGET_CREDENTIALS = $80000;
// Credential has a username as the target
CREDUI_FLAGS_KEEP_USERNAME = $100000;
// don't allow the user to change the supplied username
procedure PrepareStringBufferW(
var Buffer: widestring;
const Source: widestring; MaxLen: integer);
var
L: integer;
begin
SetLength( Buffer, MaxLen);
UniqueString( Buffer);
FillChar( Buffer[1], MaxLen * SizeOf( WideChar), #0);
L := Length( Source);
if L > MaxLen
then
L := MaxLen;
if L > 0
then
Move( Source[1], Buffer[1], L * SizeOf( WideChar))
end;
function TLogOnDialog.DoExecute: boolean;
var
hCredui: THandle;
CredUIPromptForCredentials_FuncW: TCredUIPromptForCredentials_FuncW;
CredUI_InfoW: TCredUI_InfoW;
pfSave: bool;
wTargetname: widestring;
wUserName: widestring;
wPassword: widestring;
DlgResult: DWord;
Lib: HMODULE;
dwFlags: DWord;
begin
Lib := 0;
pfSave := False;
wTargetname := FDomain;
UniqueString( wTargetName);
PrepareStringBufferW( wUserName, FUserName, CREDUI_MAX_USERNAME_LENGTH);
PrepareStringBufferW( wPassword, '
' , CREDUI_MAX_PASSWORD_LENGTH);
CredUI_InfoW.cbSize := SizeOf( CredUI_InfoW);
CredUI_InfoW.hwndParent := 0;
CredUI_InfoW.pszMessageText := PWideChar( FPrompt );
CredUI_InfoW.pszCaptionText := PWideChar( FTitle);
CredUI_InfoW.hbmBanner := 0;
dwFlags := CREDUI_FLAGS_ALWAYS_SHOW_UI + CREDUI_FLAGS_DO_NOT_PERSIST +
CREDUI_FLAGS_GENERIC_CREDENTIALS;
if FuseLocalAdmin
then
Inc( dwFlags, CREDUI_FLAGS_REQUEST_ADMINISTRATOR);
hCredui := GetModuleHandle( '
credui.dll');
try
if hCredui <> 0
then
CredUIPromptForCredentials_FuncW := GetProcAddress( hCredui,'
CredUIPromptForCredentialsW')
else
begin
Lib := windows.LoadLibrary( '
credui.dll');
if Lib <> 0
then
CredUIPromptForCredentials_FuncW := GetProcAddress( Lib,
'
CredUIPromptForCredentialsW')
else
CredUIPromptForCredentials_FuncW :=
nil
end;
if assigned( CredUIPromptForCredentials_FuncW)
then
begin
DlgResult := CredUIPromptForCredentials_FuncW(
CredUI_InfoW, PWideChar( wTargetname), 0, 0, PWideChar( wUserName),
CREDUI_MAX_USERNAME_LENGTH + 1, PWideChar( wPassword),
CREDUI_MAX_PASSWORD_LENGTH + 1, pfSave, dwFlags);
SetLength( wUserName, Length( PWideChar( wUserName)));
SetLength( wPassword, Length( PWideChar( wPassword)));
case DlgResult
of
ERROR_CANCELLED:
begin
FLogOnResult := rCancel;
result := False
end;
NO_ERROR :
begin
FLogOnResult := rPass;
result := True;
FUserName := wUserName;
FPassword := wPassword
end;
ERROR_INVALID_FLAGS, ERROR_INVALID_PARAMETER,
ERROR_NO_SUCH_LOGON_SESSION:
begin
FLogOnResult := rFail;
result := False
end;
else
begin
FLogOnResult := rFail;
result := False
end
end
end
else
begin
FLogOnResult := rFail;
result := False
end
finally
if Lib <> 0
then
windows.FreeLibrary( Lib)
end
end;
function TLogOnDialog.Execute: Boolean;
var
SelfRef: TLogOnDialog;
begin
FLogOnResult := rCancel;
SelfRef := self;
result := TaskModalDialog( @Global_DialogFunc, SelfRef)
end;
end.