Windows Dialog "Verbindung zu xyz wird hergestellt" erzeugen

[timog]

Stimmt schon, hatte an einen Typecast mit PChar(strUsername) gedacht. Hier einmal eine Beispiel unit (nicht von mir, sondern nur angepasst aus der Newsgroupdiskussion).

Delphi-Quellcode:

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.

Und der Aufruf dann so:

Delphi-Quellcode:

procedure TformMain.Button1Click(Sender: TObject);
var
   Dlg: TLogOnDialog;
begin
  Dlg := TLogOnDialog.Create( nil);
  try
    Dlg.Title    := Application.Title;
    Dlg.Prompt   := 'Bitte Benutzernamen eingeben';
    Dlg.UserName := 'Administrator';
    Dlg.useLocalAdministrators := True;
    if Dlg.Execute then
      begin
        Memo1.Lines.Add(Dlg.UserName);
        Memo1.Lines.Add(Dlg.Domain);
        Memo1.Lines.Add(Dlg.Password);
      end
    else
      Memo1.Lines.Add('Abbruch');
  finally
    Dlg.Free
  end
end;

Klappt bei mir ohne Probleme...

Viel Erfolg noch!

Timo