Управление питанием.

← →
Galiaf (2005-08-08 21:07) [0]

Вот я нашёл в литературе код для создания компонента управления питания, компонен это конечно лишнее мне надо только процедурка, вот я немного посидел и получилось что-то вроде того

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MMSystem{, WinTypes, WinProcs/}; type TAction =(actLogOFF,actShutDown,actReBoot,actForce,actPowerOFF,actForceIfHung,actMonitorOFF,actMonitorON,actCDEject,actCDUnEject ); type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } procedure PowerControll(value: taction); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } procedure TForm1.PowerControll(value: taction); begin with (Owner as TForm) do case value of actLogOff: ExitWindowsEx(EWX_LOGOFF,1);//вроде работает actShutDown: ExitWindowsEx(EWX_SHUTDOWN,1);//не работает actReBoot: ExitWindowsEx(EWX_REBOOT,1);//не работает actForce: ExitWindowsEx(EWX_FORCE,1);//вроде работает actPowerOff: ExitWindowsEx(EWX_POWEROFF,1);//не работает actForceIfHung: ExitWindowsEx(EWX_FORCEIFHUNG,1);//вроде работает actMonitorOFF: SendMessage(Application.MainForm.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);//не работает actMonitorON: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);//не работает actCDEject: mciSendstring("SET CDAUDIO DOOR OPEN WAIT",nil,0, Handle);//вроде работает actCDUnEject: mciSendstring("SET CDAUDIO DOOR CLOSED WAIT",nil,0, Handle);//вроде работает end; {Case} end; procedure TForm1.Button1Click(Sender: TObject); begin powercontroll(actMonitorOFF) end; end.

Из всего этого мне надо: перезагрузка, ждущий режим, выключение компьютера, выключение/включение монитора, а они как на зло не работают, может у меня что не так? Помогите с ошибкой.

← →
Eraser © (2005-08-08 21:24) [1]

Galiaf (08.08.05 21:07)
может у меня что не так?

Просто нету соответствующих прав на отключение.
uses Windows; procedure RebootSystem; var handle, ph: THandle; pid, n: DWORD; luid: TLargeInteger; priv: TOKEN_PRIVILEGES; dummy: PTokenPrivileges; ver: TOSVERSIONINFO; begin ver.dwOSVersionInfoSize := Sizeof(ver); GetVersionEx(ver); if ver.dwPlatformId=VER_PLATFORM_WIN32_NT then begin pid := GetCurrentProcessId; if OpenProcessToken(ph, TOKEN_ADJUST_PRIVILEGES, handle) then if LookupPrivilegeValue(nil, "SeShutdownPrivilege", luid) then begin priv.PrivilegeCount := 1; priv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; priv.Privileges[0].Luid := luid; dummy := nil; AdjustTokenPrivileges(handle, false, priv, 0, dummy^, n); end; end; ExitWindowsEx(EWX_REBOOT, 0); end;

← →
kami © (2005-08-08 21:26) [2]

Ну на счет EWX_POWEROFF и иже с ними неоднократно говорили - нужна привилегия SE_SHUTDOWN_NAME.
А SC_MONITORPOWER
Sets the state of the display. This command supports devices that have power-saving features, such as a battery-powered personal computer.
The lParam parameter can have the following values:
1 - the display is going to low power
2 - the display is being shut off
(с) Первоисточник

← →
Galiaf (2005-08-08 21:29) [3]

Отвратительно, значит покороче никак?

← →
kami © (2005-08-08 21:33) [4]

> покороче никак?

Хе.
Вынеси получение привилегии в отдельную процедуру - будет "покороче".

← →
Eraser © (2005-08-08 21:34) [5]

kami © (08.08.05 21:26) [2]

Может быть... код просто тупо скопировал с FAQ.

← →
kami © (2005-08-08 21:42) [6]

2 [5] Eraser ©
Дык... собственно, не понял : претензий к коду - никаких, в фолиантах Microsoft все буква в букву. Просто предложил, чтобы основная процедура была покороче, вынести это в отдельную процедуру, типа
GetMePrivilege{ и быстро!};
case... :))

← →
kami © (2005-08-08 21:45) [7]

[0] Galiaf

> ExitWindowsEx(EWX_FORCEIFHUNG,1);//вроде работает

К стати, не понял... это, вроде, просто добавочный флаг - как он работает самостоятельно?

← →
Eraser © (2005-08-08 21:45) [8]

kami © (08.08.05 21:42) [6]

Да эт я протормозил )

← →
Galiaf (2005-08-08 21:57) [9]

Чёт я попробовал код Eraser-а? а он неработает :(. Я чувствую себя некчёмным.

← →
kami © (2005-08-08 22:06) [10]

Теперь моя очередь (2 Eraser) :)) Copy-Paste из моей проги
function TTCPParser.GrantShutdownAccess: Boolean;
{(c) чей-то с форума, в принципе вроде, аналогично [1]}
var
hToken: THandle;
lpVersionInformation: TOSVersionInfo;
tkp: TTokenPrivileges;
RetLen: DWORD;
PreviousState: TTokenPrivileges;
begin
lpVersionInformation.dwOSVersionInfoSize:=SizeOf (lpVersionInformation);
Result:=GetVersionEx (lpVersionInformation);
if not Result then
Exit;
if (lpVersionInformation.dwPlatformId = VER_PLATFORM_WIN32_NT) then
begin
if not OpenProcessToken (GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY, hToken) then
begin
Result:=False;
Exit;
end;
Result:=LookupPrivilegeValue (nil, "SeShutdownPrivilege",
tkp.Privileges[0].Luid);
if not Result then
Exit;
PreviousState:=tkp;
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
if not (AdjustTokenPrivileges (hToken, False, tkp, SizeOf (PreviousState),
PreviousState, RetLen)) then
begin
Result:=False;
Exit;
end;
end;
Result:=True;
end;

procedure TTCPParser.DoShutdownPC;
var
ForceAppClosed,RebootAfterShutdown:Bool;
begin
ForceAppClosed:=DataHeader.Unknown2;
case DataHeader.Command of
RebootPC:RebootAfterShutDown:=True;
ShutDownPC:RebootAfterShutDown:=false;
else
exit;
end;
if GrantShutdownAccess then
InitiateSystemShutdown(nil,nil,0,ForceAppClosed,RebootAfterShutDown);
end;

И все-же интересно получить ответ на [7]

мнэээ... Прошу прощения, код-то работает, но вот в основном-то он предназначен для "гашения" из сервиса, а так вместо InitiateSystemShutdown вполне хватит ExitWindowsEx.

← →
Galiaf (2005-08-08 22:18) [12]

Если Вы имеете в виду что делает "ExitWindowsEx(EWX_FORCEIFHUNG,1);//вроде работает", в принципе все где написано "вроде работает" просто выходит из системы(на страницу приветствия), если Вы имели в иду нечто другое, то тут уже никак помоч немогу(потому что незнаю(неопытный я)).
Кстати с процедуркой DoShutdownPC проблемы нарисовались, что есть DataHeader, мой делфи говорит "кака", всмысле подчёркивает красной полоской такой.

← →
Galiaf (2005-08-08 22:19) [13]

Есть идеи как МНЕ помоч?

Я же говорю, что это copy-paste из моей проги.
Названия ForceAppClosed и RebootAfterShutDown по-моему, говорят сами за себя. Тем более, что это булевские переменные - установи ForceAppClosed:=True если нужно прервать приложения, и RebootAfterShutDown:=True, если нужно перезагрузиться, а не выключить. А DataHeader - выкинуть на...

Управление питанием. Найти похожие ветки