FAQ VCL
Диалоги

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как показать диалог "Open With"?

uses
  {...,} ShellAPI;

procedure OpenWith( FileName: string );
begin
   ShellExecute( Application.Handle, 'open', PChar( 'rundll32.exe' ),
      PChar( 'shell32.dll,OpenAs_RunDLL ' + FileName ), nil, SW_SHOWNORMAL );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   OpenWith( 'c:\boot.ini' );
end;


Как открыть диалог свойств аудио?

uses
  {...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShellExecute( Application.Handle, 'open', PChar( 'rundll32.exe' ),
      PChar( 'shell32.dll,Control_RunDLL mmsys.cpl'), nil, SW_SHOWNORMAL );
end;


Как вызвать диалог "Найти файлы и паки" проводника?

// Способ первый
uses
  {...,} DDEMan;

procedure SearchInFolder(Folder: string);
begin
   with TDDEClientConv.Create( Form1 ) do
   begin
      ConnectMode := ddeManual;
      ServiceApplication := 'Explorer.exe';
      SetLink( 'Folders', 'AppProperties' );
      OpenLink;
      ExecuteMacro( PChar( '[FindFolder(, ' + Folder + ')]' ), false );
      CloseLink;
      Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   SearchInFolder( 'c:\' );
end;

// Способ второй
uses
  {...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShellExecute( Handle, 'find', 'C:\Windows', nil, nil, SW_SHOW );
end;

// Способ третий
uses
  {...,} DDEMan;

procedure WindowsSuchenDialog( Verzeichnis, Suchstring: string );
var
  hOtherWin, hFocusWin: HWND;
  OtherThreadID, iTimeOut: Integer;
  aDwordVar: DWORD;
  buf: array [0..40] of Char;
  sVerz: string;
begin
   with TDDEClientConv.Create( nil ) do
   begin
      ConnectMode := ddeManual;
      ServiceApplication := 'explorer.exe';
      SetLink( 'Folders', 'AppProperties' );
      OpenLink;
      sVerz := IncludeTrailingBackslash( Verzeichnis );
      ExecuteMacro( PChar('[FindFolder(, '+ sVerz +')]'), false );
      CloseLink;
      Free;
   end;
   iTimeOut := 0;
   repeat
      {Warten, bis der Such Dialog erscheint.
      Unter Win95/98/NT4 hat der Suchdilaog die Klasse #32770.
      Unter ME/2000/XP ist die Suche in den Explorer integriert,
      darum auf CabinetWClass warten}
      Sleep( 100 );
      hOtherWin := GetForegroundWindow;
      buf[0] := #0;
      GetClassName( hOtherWin, buf, 60 );
      Inc( iTimeOut );
   until ( StrComp( buf, '#32770' ) = 0 ) or ( StrComp( buf, 'CabinetWClass' ) = 0 ) or ( iTimeOut > 20 );
   if iTimeOut > 20 then Exit;
   repeat
      { Wait until it is visible }
      { Warten, bis das Fenster erscheint }
      Sleep( 100 );
   until IsWindowVisible( hOtherWin );

   { Handle vom Control finden, welches den Fokus besitzt }
   OtherThreadID := GetWindowThreadProcessID( hOtherWin, @aDwordvar );
   if AttachThreadInput( GetCurrentThreadID, OtherThreadID, true ) then
   begin
      hFocusWin := GetFocus;
      if hFocusWin <> 0 then
      try
         SendMessage( hFocusWin, WM_SETTEXT, 0, Longint( PChar( Suchstring ) ) );
      finally
         AttachThreadInput( GetCurrentThreadID, OtherThreadID, false );
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   WindowsSuchenDialog( 'c:\temp', 'test.txt' );
end;


Как показать диалог выбора пользователей?

uses
  {...,} ActiveX;

const
  CLSID_DsObjectPicker: TGUID = (
    D1:$17d6ccd8; D2:$3b7b; D3:$11d2; D4:($b9,$e0,$00,$c0,$4f,$d8,$db,$f7));

  IID_IDsObjectPicker: TGUID = (
    D1:$0c87e64e; D2:$3b7a; D3:$11d2; D4:($b9,$e0,$00,$c0,$4f,$d8,$db,$f7));

  ANYSIZE_ARRAY = 1;

  CFSTR_DSOP_DS_SELECTION_LIST = 'CFSTR_DSOP_DS_SELECTION_LIST';

const
  DSOP_SCOPE_TYPE_TARGET_COMPUTER              = $00000001;
  DSOP_SCOPE_TYPE_USER_ENTERED_DOWNLEVEL_SCOPE = $00000200;

  DSOP_FILTER_USERS                            = $00000002;

  DSOP_DOWNLEVEL_FILTER_USERS                  = DWORD($80000001);

  DSOP_FLAG_SKIP_TARGET_COMPUTER_DC_CHECK      = $00000002;

type
  LPLPWSTR = ^PWideChar;

  TDsOpUpLevelFilterFlags = record
    flBothModes: ULONG;
    flMixedModeOnly: ULONG;
    flNativeModeOnly: ULONG;
  end;

  TDsOpFilterFlags = record
    Uplevel: TDsOpUpLevelFilterFlags;
    flDownlevel: ULONG;
  end;

  PDsOpScopeInitInfo = ^TDsOpScopeInitInfo;
  TDsOpScopeInitInfo = record
    cbSize: ULONG;
    flType: ULONG;
    flScope: ULONG;
    FilterFlags: TDsOpFilterFlags;
    pwzDcName: PWideChar;
    pwzADsPath: PWideChar;
    hr: HRESULT;
  end;

  TDsOpInitInfo = record
    cbSize: ULONG;
    pwzTargetComputer: PWideChar;
    cDsScopeInfos: ULONG;
    aDsScopeInfos: PDsOpScopeInitInfo;
    flOptions: ULONG;
    cAttributesToFetch: ULONG;
    apwzAttributeNames: LPLPWSTR;
  end;

  TDsSelection = record
    pwzName: PWideChar;
    pwzADsPath: PWideChar;
    pwzClass: PWideChar;
    pwzUPN: PWideChar;
    pvarFetchedAttributes: POleVariant;
    flScopeType: ULONG;
  end;

  PDSSelectionList = ^TDsSelectionList;
  TDsSelectionList = record
    cItems: ULONG;
    cFetchedAttributes: ULONG;
    aDsSelection: array [0..ANYSIZE_ARRAY - 1] of TDsSelection;
  end;

  IDsObjectPicker = interface (IUnknown)
  ['{0c87e64e-3b7a-11d2-b9e0-00c04fd8dbf7}']
    function Initialize(const pInitInfo: TDsOpInitInfo): HRESULT; stdcall;
    function InvokeDialog(hwndParent: HWND; out ppdoSelections: IDataObject): HRESULT; stdcall;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

{...}

implementation

function InitObjectPicker(Picker: IDsObjectPicker): HRESULT;
var
  ScopeInit: array [0..0] of TDSOPScopeInitInfo; // Объект, который указывает что будем выбирать
  InitInfo: TDSOPInitInfo; // Информация об инициализации
begin
   if nil = Picker then
      Result := E_INVALIDARG
   else
   begin
      ZeroMemory( @ScopeInit, SizeOf( ScopeInit ) ); // Заполняем нулями
      ScopeInit[0].cbSize := SizeOf( TDSOPScopeInitInfo ); // Заполняем структуру TDSOPScopeInitInfo
      ScopeInit[0].flType := DSOP_SCOPE_TYPE_TARGET_COMPUTER;
      ScopeInit[0].flScope := DSOP_SCOPE_TYPE_USER_ENTERED_DOWNLEVEL_SCOPE;
      ScopeInit[0].FilterFlags.Uplevel.flBothModes := DSOP_FILTER_USERS;
      ScopeInit[0].FilterFlags.flDownlevel := DSOP_DOWNLEVEL_FILTER_USERS;

      ZeroMemory( @InitInfo, SizeOf( InitInfo ) ); // Заполняем структуру TDSOPInitInfo
      InitInfo.cbSize := SizeOf( InitInfo );
      InitInfo.cDsScopeInfos := SizeOf( ScopeInit ) div SizeOf( TDSOPScopeInitInfo );
      InitInfo.aDsScopeInfos := @ScopeInit;
      InitInfo.flOptions := DSOP_FLAG_SKIP_TARGET_COMPUTER_DC_CHECK;
      // Инициализируем объект выбора
      Result := Picker.Initialize( InitInfo );
   end;
end;

function ProcessSelectedObjects(DatObj: IDataObject): HRESULT;
var
  StgMed: TStgMedium; // Объект хранения данных
  FmtEtc: TFormatEtc; // Формат ыввода данных
  SelLst: PDSSelectionList; // Выбранные объекты
  Index: ULONG;
  Text: string;
begin
   // Проверка на "дурака"
   if nil = DatObj then
      Result := E_INVALIDARG
   else
   begin
      with FmtEtc do
      begin
         // Регистрируем формат вывода данных
         cfFormat := RegisterClipboardFormat( CFSTR_DSOP_DS_SELECTION_LIST );
         ptd := nil;
         dwAspect := DVASPECT_CONTENT;
         lindex := -1;
         tymed := TYMED_HGLOBAL;
      end;
      Result := DatObj.GetData( FmtEtc, StgMed );
      if Succeeded( Result ) then
      begin
         // Получаем результат вызора в удобоваримом формате
         SelLst := PDsSelectionList( GlobalLock( StgMed.hGlobal ) );
         // и если не nil обрабатываем его
         if SelLst <> nil then
            try
               Text := '';
               for Index := 0 to SelLst.cItems-1 do
               begin
                  Text := Text + Format( 'Object : %u'#13#10 +
                                         '  Name : %s'#13#10 +
                                         '  Class: %s'#13#10 +
                                         '  Path : %s'#13#10 +
                                         '  UPN  : %s'#13#10, [
                  Index,
                  WideCharToString( SelLst.aDsSelection[Index].pwzName ),
                  WideCharToString( SelLst.aDsSelection[Index].pwzClass ),
                  WideCharToString( SelLst.aDsSelection[Index].pwzADsPath ),
                  WideCharToString( SelLst.aDsSelection[Index].pwzUPN )] );
               end;
               ShowMessage( Text );
            finally
               GlobalUnlock( StgMed.hGlobal );
            end
         else
            Result := E_POINTER;

         ReleaseStgMedium(StgMed);
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Picker: IDsObjectPicker;
  DatObj: IDataObject;
begin
   // Инициализируем COM+
   if Succeeded( CoInitialize( nil ) ) then
   try
      // Создаем Picker как объект COM+
      if Succeeded( CoCreateInstance( CLSID_DsObjectPicker, nil,
                    CLSCTX_INPROC_SERVER, IID_IDsObjectPicker, Picker ) ) then
         try
            // Если инициализация Picker успешна вызываем сам диалог
            if Succeeded( InitObjectPicker( Picker ) ) then
               case Picker.InvokeDialog( Self.Handle, DatObj ) of
                  S_OK:
                     try
                        // Вызов диалога
                        ProcessSelectedObjects( DatObj );
                     finally
                        // Освобождаем DatObj
                        DatObj := nil;
                     end;
                  S_FALSE: ShowMessage( 'Ничего не выбрано' );
               end;
         finally
            Picker := nil;
         end;
   finally
      CoUninitialize;
   end;
end;


Как показать полупрозрачный MessageBox?

const
  WM_MSGBOX = WM_USER + 1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure MsgBoxShow( var Msg: TMessage ); message WM_MSGBOX;
  public
  end;

implementation

procedure MakeTransp( Wnd: HWND; Value: Byte );
var
 ExStyle: Longint;
begin
   ExStyle := GetWindowLong( Wnd, GWL_EXSTYLE );
   if ExStyle and WS_EX_LAYERED = 0 then
   begin
      ExStyle := ExStyle or WS_EX_LAYERED;
      SetwindowLong( Wnd, GWL_EXSTYLE, ExStyle );
   end;
   SetLayeredWindowAttributes( Wnd, 0, Value, LWA_ALPHA );
end;

procedure TForm1.MsgBoxShow(var Msg: TMessage);
var
  MsgbHandle: HWND;
begin
   MsgbHandle := GetActiveWindow;
   if MsgbHandle <> 0 then
      MakeTransp( MsgbHandle, 128 );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   PostMessage( Handle, WM_USER + 1, 0, 0 );
   MessageBox( Handle, 'This Is A Transparent Message Box', '50% MessageBox.', MB_OK or MB_ICONWARNING );
end;


Как изменить заголовок диалогового окна печати?

procedure TForm1.PrintDialog1Show(Sender: TObject);
begin
   if Sender is TPrintDialog then
      SetWindowText( TPrintDialog( Sender ).Handle, 'Как Вы хотите распечатать документ?' );
end;


Как показать системный диалог ввода логина/пароля?

// Способ первый (Windows XP и выше)
function LoginUser(const ACaption, ADescription: string; var AUser,
  APassword: string; var ASavePassword: Boolean): Boolean;
type
  PCredUIInfo = ^TCredUIInfo;
  TCredUIInfo = record
    cbSize: DWORD;
    hwndParent: HWND;
    pszMessageText: PChar;
    pszCaptionText: PChar;
    hbmBanner: HBITMAP;
  end;
var
  Lib: HMODULE;
  CredUIPromptForCredentials: function(pUiInfo: PCredUIInfo; pszTargetName: PChar;
    pContext: Pointer; dwAuthError: DWORD; pszUserName: PChar; ulUserNameBufferSize: ULONG;
    pszPassword: PChar; ulPasswordBufferSize: ULONG; var pfSave: BOOL; dwFlags: DWORD): DWORD; stdcall;
  CredInfo: TCredUIInfo;
  User, Password: string;
  Save: BOOL;
const
  CREDUI_MAX_USERNAME_LENGTH               = 256; // does not include the terminating null character.
  CREDUI_MAX_PASSWORD_LENGTH               = 256; // does not include the terminating null character.
  // Maximum length of the UserName field.  The worst case is <User>@<DnsDomain>
  MAXBUFLEN                                = CREDUI_MAX_USERNAME_LENGTH + 1 + CREDUI_MAX_PASSWORD_LENGTH;
  credui                                   = 'credui.dll';
  CredUIPromptForCredentialsName           = {$IFDEF UNICODE}
                                             'CredUIPromptForCredentialsW'
                                             {$ELSE}
                                             'CredUIPromptForCredentialsA'
                                             {$ENDIF};
  CREDUI_FLAGS_INCORRECT_PASSWORD          = $00001;
  CREDUI_FLAGS_DO_NOT_PERSIST              = $00002;
  CREDUI_FLAGS_REQUEST_ADMINISTRATOR       = $00004;
  CREDUI_FLAGS_EXCLUDE_CERTIFICATES        = $00008;
  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;
  CREDUI_FLAGS_SERVER_CREDENTIAL           = $04000;
  CREDUI_FLAGS_EXPECT_CONFIRMATION         = $20000;
  CREDUI_FLAGS_GENERIC_CREDENTIALS         = $40000;
  CREDUI_FLAGS_USERNAME_TARGET_CREDENTIALS = $80000;
  CREDUI_FLAGS_KEEP_USERNAME               = $100000;
begin
   Lib := SafeLoadLibrary(credui);
   if Lib <> 0 then
      try
         CredUIPromptForCredentials := GetProcAddress(Lib, CredUIPromptForCredentialsName);
         if Assigned(CredUIPromptForCredentials) then
         begin
            FillChar(CredInfo, SizeOf(CredInfo), 0);
            CredInfo.cbSize := SizeOf(CredInfo);
            if Screen.FocusedForm <> nil then
               CredInfo.hwndParent := Screen.FocusedForm.Handle
            else
            if Screen.ActiveForm <> nil then
               CredInfo.hwndParent := Screen.ActiveForm.Handle
            else
               CredInfo.hwndParent := 0;
            CredInfo.pszCaptionText := PChar(ACaption);
            CredInfo.pszMessageText := PChar(ADescription);

            User := AUser + #0;
            Password := APassword + #0;
            Save := ASavePassword;
            SetLength(User, MAXBUFLEN);
            SetLength(Password, MAXBUFLEN);

            case CredUIPromptForCredentials(@CredInfo, nil, nil, 0, PChar(User),
               MAXBUFLEN, PChar(Password), MAXBUFLEN, Save,
               CREDUI_FLAGS_ALWAYS_SHOW_UI or CREDUI_FLAGS_DO_NOT_PERSIST or
               CREDUI_FLAGS_SHOW_SAVE_CHECK_BOX or CREDUI_FLAGS_GENERIC_CREDENTIALS) of
               NO_ERROR: begin
                  AUser := PChar(User);
                  APassword := PChar(Password);
                  ASavePassword := Save;
                  Result := True;
                  Exit;
               end;
               ERROR_CANCELLED:
                  Result := False;
               else
                  raise Exception.Create('CredUIPromptForCredentials failed');
            end;
         end
         else
            RaiseLastOSError;
      finally
         FreeLibrary(Lib);
      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Username, Password: string;
  Token: NativeUInt;
  SavePassword: Boolean;
begin
   Username := 'some_user';
   Password := 'some_password';
   if not LoginUser('Авторизация', 'Введите данные вашей учётки:',
      Username, Password, SavePassword) then
      Exit;

   if not LogonUser(@Username[1], nil, @Password[1], LOGON32_LOGON_INTERACTIVE,
      LOGON32_PROVIDER_DEFAULT, Token) then
      raise Exception.Create('Invalid login or password')
   else
      ShowMessage('Успешная авторизация!');

   // OK!
end;

// Способ второй (Windows Vista и выше)
function LoginUser(const ACaption, ADescription: string;
  AAuthError: Cardinal; var AUser, APassword, ADomain: string;
  var ASavePassword: Boolean): Boolean;
type
  PCredUIInfo = ^TCredUIInfo;
  TCredUIInfo = record
    cbSize: DWORD;
    hwndParent: HWND;
    pszMessageText: PChar;
    pszCaptionText: PChar;
    hbmBanner: HBITMAP;
  end;
const
  CRED_MAX_USERNAME_LENGTH              = 256;
  CREDUI_MAX_PASSWORD_LENGTH            = 256;
  CRED_MAX_DOMAIN_TARGET_NAME_LENGTH    = 256;
  credui                                = 'credui.dll';
  CredUIPromptForWindowsCredentialsName = {$IFDEF UNICODE}
                                          'CredUIPromptForWindowsCredentialsW'
                                          {$ELSE}
                                          'CredUIPromptForWindowsCredentialsA'
                                          {$ENDIF};
  CredUnPackAuthenticationBufferName    = {$IFDEF UNICODE}
                                          'CredUnPackAuthenticationBufferW'
                                          {$ELSE}
                                          'CredUnPackAuthenticationBufferA'
                                          {$ENDIF};
  CREDUIWIN_GENERIC                     = $00000001;
  CREDUIWIN_CHECKBOX                    = $00000002;
  CREDUIWIN_AUTHPACKAGE_ONLY            = $00000010;
  CREDUIWIN_IN_CRED_ONLY                = $00000020;
  CREDUIWIN_ENUMERATE_ADMINS            = $00000100;
  CREDUIWIN_ENUMERATE_CURRENT_USER      = $00000200;
  CREDUIWIN_SECURE_PROMPT               = $00001000;
  CREDUIWIN_PREPROMPTING                = $00002000;
  CREDUIWIN_PACK_32_WOW                 = $10000000;
var
  Lib: HMODULE;
  CredUIPromptForWindowsCredentials: function(
    var pUiInfo: TCredUIInfo; dwAuthError: DWORD; var pulAuthPackage: NativeUInt;
    pvInAuthBuffer: PCardinal; ulInAuthBufferSize: ULONG;
    out ppvOutAuthBuffer: Cardinal; out pulOutAuthBufferSize: ULONG;
    pfSave: PVOID; dwFlags: DWORD): DWORD; stdcall;
  CredUnPackAuthenticationBuffer: function(
    dwFlags: DWORD; pAuthBuffer: PVOID; cbAuthBuffer: DWORD;
    pszUserName: LPTSTR; var pcchMaxUserName: DWORD;
    pszDomainName: LPTSTR; var pcchMaxDomainname: DWORD;
    pszPassword: LPTSTR; var pcchMaxPassword: DWORD
    ): LONGBOOL; stdcall;
  CredInfo: TCredUIInfo;
  lUserName, lPassword, lDomain: array [Byte] of Char;
  lMaxUserName, lMaxDomainName, lMaxPassword: DWORD;
  User, Password: string;
  lAuthPackage: NativeUInt;
  lOutBuffer: Cardinal;
  lOutBufferSize: DWORD;
  Save: BOOL;
begin
   Lib := SafeLoadLibrary(credui);
   if Lib <> 0 then
      try
         CredUIPromptForWindowsCredentials := GetProcAddress(Lib, CredUIPromptForWindowsCredentialsName);
         CredUnPackAuthenticationBuffer := GetProcAddress(Lib, CredUnPackAuthenticationBufferName);
         if Assigned(CredUIPromptForWindowsCredentials) and Assigned(CredUnPackAuthenticationBuffer) then
         begin
            FillChar(CredInfo, SizeOf(CredInfo), 0);
            CredInfo.cbSize := SizeOf(CredInfo);
            if Screen.FocusedForm <> nil then
               CredInfo.hwndParent := Screen.FocusedForm.Handle
            else
            if Screen.ActiveForm <> nil then
               CredInfo.hwndParent := Screen.ActiveForm.Handle
            else
               CredInfo.hwndParent := 0;
            CredInfo.pszCaptionText := PChar(ACaption);
            CredInfo.pszMessageText := PChar(ADescription);

            lAuthPackage := 0;
            case CredUIPromptForWindowsCredentials(
               CredInfo, AAuthError, lAuthPackage, nil, 0,
               lOutBuffer, lOutBufferSize, @ASavePassword,
               CREDUIWIN_GENERIC or CREDUIWIN_CHECKBOX) of
               NO_ERROR: begin
                  ZeroMemory(@lUserName, SizeOf(lUserName));
                  ZeroMemory(@lPassword, SizeOf(lPassword));
                  ZeroMemory(@lDomain, SizeOf(lDomain));

                  Result := CredUnPackAuthenticationBuffer(
                     0, Pointer(lOutBuffer), lOutBufferSize,
                     @lUserName, lMaxUserName,
                     @lDomain, lMaxDomainName,
                     @lPassword, lMaxPassword);
                     if Result then
                     begin
                        AUser := String(lUserName);
                        APassword := String(lPassword);
                        ADomain := String(lDomain);
                        Result := True;
                     end;

               end;
               ERROR_CANCELLED:
                  Result := False;
               else
                  raise Exception.Create('CredUIPromptForWindowsCredentials failed');
            end;
         end
         else
            RaiseLastOSError;
      finally
         FreeLibrary(Lib);
      end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Username, Password, Domain: string;
  Token: NativeUInt;
  SavePassword: Boolean;
begin
   if not LoginUser('Авторизация', 'Введите данные вашей учётки:', $963 {или 0},
      Username, Password, Domain, SavePassword) then
      Exit;

   if not LogonUser(@Username[1], nil, @Password[1], LOGON32_LOGON_INTERACTIVE,
      LOGON32_PROVIDER_DEFAULT, Token) then
      raise Exception.Create('Invalid login or password')
   else
      ShowMessage('Успешная авторизация!');

   // OK!
end;


Как показать Messagebox без кнопок, закрывающийся по истечении указанного времени?

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure WMUser(var Message: TMessage); message WM_USER;
  public
  end;

var
  Form1: TForm1;

implementation

  function MessageBoxTimeOutA(hWnd: HWND; lpText: PChar; lpCaption: PChar;
    uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
    external user32 name 'MessageBoxTimeoutA';

  function MessageBoxTimeOutW(hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar;
    uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
    external user32 name 'MessageBoxTimeoutW';

  function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
    uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
    external user32 name 'MessageBoxTimeoutW';

procedure TForm1.Button1Click(Sender: TObject);
begin
   PostMessage(Handle, WM_USER, 0, 0);
   MessageBoxTimeOut(Handle, 'MessageBox без кнопки',
    'Тест', MB_ICONINFORMATION, 0, 3000);
end;

// При желании можно уменьшить
// высоту диалога
{.$DEFINE CHANGE_MESSAGE_HEIGHT}

procedure TForm1.WMUser(var Message: TMessage);
var
  hDlgHandle: THandle;
  {$IFDEF CHANGE_MESSAGE_HEIGHT}
  r: TRect;
  {$ENDIF}
begin
   hDlgHandle := GetForegroundWindow;
   ShowWindow(FindWindowEx(hDlgHandle, 0, 'BUTTON', nil), SW_HIDE);

   {$IFDEF CHANGE_MESSAGE_HEIGHT}
   GetWindowRect(hDlgHandle, r);
   with r do
      SetWindowPos(hDlgHandle, 0, Left, Top,
         Right - Left, Bottom - Top - 48, SWP_NOSENDCHANGING);
   {$ENDIF}
end;

При использовании материала - ссылка на сайт обязательна