Delphi-PRAXiS - Delphi Windows Dialog "Verbindung zu xyz wird hergestellt" erzeugen

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