Кнопка выключения компа!

Тема в разделе "Delphi - Система", создана пользователем -, 29 май 2007.

Статус темы:
Закрыта.
  1. Гость

    Дайте пожалуйтста к оды событий TForm1.Button1(2)Click, выключения и перезагрузки компа. Хочу одну шутку сделать))
     
  2. DIR3ct0r

    DIR3ct0r Гость

    Для NT-ей необходимо сначала получить привилегии, потом пользовать функцию ExitWindowsEx.....а вобще на эту тему много информации, пользуй поисковики....
     
  3. CronEtc

    CronEtc Гость

    Программистыч Вот пример решения твоей задачи....

    Код (Text):
    function GetWinVersion: string;
    var
    VersionInfo: TOSVersionInfo;
    OSName: string;
    begin
    VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
    if Windows.GetVersionEx( VersionInfo ) then
    begin
    with VersionInfo do
    begin
    case dwPlatformId of
    VER_PLATFORM_WIN32s: OSName := 'Win32s';
    VER_PLATFORM_WIN32_WINDOWS: OSName := 'Windows 95';
    VER_PLATFORM_WIN32_NT: OSName := 'Windows NT';
    end; // case dwPlatformId
    Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) +
    #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')';
    end; // with VersionInfo
    end // if GetVersionEx
    else
    Result := '';
    end;
    procedure ShutDown;
    const
    SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration
    var
    hToken: THandle;
    tkp: TTokenPrivileges;
    tkpo: TTokenPrivileges;
    zero: DWORD;
    begin
    if Pos('Windows NT', GetWinVersion) = 1 then // we've got to do a whole buch of things
    begin
    zero := 0;
    if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
    MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
    Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
    if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
    MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
    Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
    // SE_SHUTDOWN_NAME
    if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) then
    begin
    MessageBox(0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK);
    Exit;
    end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid )
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    AdjustTokenPrivileges(hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero);
    if Boolean(GetLastError()) then
    begin
    MessageBox(0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK);
    Exit;
    end // if Boolean( GetLastError() )
    else
    ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
    end // if OSVersion = 'Windows NT'
    else
    begin // just shut the machine down
    ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
    end; // else
    end;


    procedure TForm1.Button1Click(Sender: TObject);
    begin
    ShutDown;
    end;
     
Загрузка...
Похожие Темы - Кнопка выключения компа
  1. azzza
    Ответов:
    9
    Просмотров:
    517
  2. xbeetle
    Ответов:
    15
    Просмотров:
    927
  3. Markiz
    Ответов:
    4
    Просмотров:
    1.391
  4. YGol
    Ответов:
    9
    Просмотров:
    1.343
  5. Rosna
    Ответов:
    11
    Просмотров:
    2.278
Статус темы:
Закрыта.

Поделиться этой страницей