Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 958

Раздел: Delphi » Взаимодействие с Windows
/ вопрос решён /

Здравствуйте! Скажите пожалуйста, что нетак в коде программы( код приведен в приложении)? Должна выполниться перезагрузка компьютера! Но она не выполняется!

Приложение:
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ExtCtrls, StdCtrls;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Label1: TLabel;
  12. Timer1: TTimer;
  13. Label2: TLabel;
  14. Label3: TLabel;
  15. procedure FormActivate(Sender: TObject);
  16. procedure Timer1Timer(Sender: TObject);
  17. private
  18. { Private declarations }
  19. public
  20. { Public declarations }
  21. end;
  22.  
  23. var
  24. Form1: TForm1;
  25. a:integer;
  26. implementation
  27.  
  28. {$R *.dfm}
  29.  
  30. procedure TForm1.FormActivate(Sender: TObject);
  31. begin
  32. a:=0;
  33. ShowWindow(Application.Handle, sw_Hide);
  34. end;
  35.  
  36. procedure TForm1.Timer1Timer(Sender: TObject);
  37. begin
  38. a:=a+1;
  39. case a of
  40. 1: Label1.Caption:='20';
  41. 2: Label1.Caption:='19';
  42. 3: Label1.Caption:='18';
  43. 4: Label1.Caption:='17';
  44. 5: Label1.Caption:='16';
  45. 6: Label1.Caption:='15';
  46. 7: Label1.Caption:='14';
  47. 8: Label1.Caption:='13';
  48. 9: Label1.Caption:='12';
  49. 10: Label1.Caption:='11';
  50. 11: Label1.Caption:='10';
  51. 12: Label1.Caption:='9';
  52. 13: Label1.Caption:='8';
  53. 14: Label1.Caption:='7';
  54. 15: Label1.Caption:='6';
  55. 16: Label1.Caption:='5';
  56. 17: Label1.Caption:='4';
  57. 18: Label1.Caption:='3';
  58. 19: Label1.Caption:='2';
  59. 20: Label1.Caption:='1';
  60. 21: Label1.Caption:='';
  61.  
  62. 23: ExitWindowsEx(EWX_REBOOT,0);
  63.  
  64. end;
  65. end;
  66.  
  67. end.


Ученый Вопрос решён, но можно продолжить его обсуждение в мини-форуме

Вопрос задал: Ученый (статус: 8-ой класс)
Вопрос отправлен: 3 октября 2008, 09:38
Состояние вопроса: решён, ответов: 3.

Ответ #1. Отвечает эксперт: Шичко Игорь

Здравствуйте, Ученый!
Предлагаю Вам следующий код для перезагрузки.
Источник:
http://delphiworld.narod.ru/

Приложение:
  1. var
  2. ph: THandle;
  3. tp, prevst: TTokenPrivileges;
  4. rl: DWORD;
  5. begin
  6. OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, ph);
  7. LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tp.Privileges[0].Luid);
  8. tp.PrivilegeCount := 1;
  9. tp.Privileges[0].Attributes := 2;
  10. AdjustTokenPrivileges(ph, FALSE, tp, SizeOf(prevst), prevst, rl);
  11. ExitWindowsEx(EWX_REBOOT,0);
  12. end;


Ответ отправил: Шичко Игорь (статус: 9-ый класс)
Время отправки: 3 октября 2008, 10:10
Оценка за ответ: 5

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Ученый!
Ну когда же вы научитесь работать с поиском ? Ведь это очень просто, вводите имя функции и получаете несколько ссылок на вопросы по обсуждению данной темы. Например, вопрос #1848 прекрастно демонстрирует работу функций 

Function ExitWindows(Reserved: DWord; ReturnCode: Word): Boolean;
и
Function ExitWindowsEx(uFlags: Word; dwReason: DWord): Boolean;
Если вы сами не помежете понять, тогда смотрите пример в Приложении.
Выкидываете глобал. переменную "a" и используете вместо нее Timer1.Tag. Данное свойство как раз и предназначено для разного рода хранения временных значений.
В инспекторе объектов ставите этому свойству значение 20 и в таймере при каждом тике отнимаете до нуля.
Как дошли до нуля, значит ребут. Вышеописанные функции ExitWindowsEx и ExitWindows действительны только для w9x/Me. Дело в том, что, чтобы выполнить функциию в NT ОС, нужно получить права на выполнение этой функции. Сделать это можно через AdjustTokenPriviligies. С помощью нижеприведённой функции можно получить любую привелегию, в т.ч. и привеленгию SeShutdownPrivilege, которая нужна для разрешения функции ExitWindows(Ex).

P.S. Желаю удачи.

Приложение:
  1. Function SetPrivilege(aPrivilegeName: String; aEnabled: Boolean ): Boolean;
  2. Var TPPrev,
  3. TP: TTokenPrivileges;
  4. Token: THandle;
  5. dwRetLen: DWord;
  6. Begin
  7. Result:=False;
  8. OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, @Token );
  9. TP.PrivilegeCount:=1;
  10. IF LookupPrivilegeValue(nil,PChar(aPrivilegeName),TP.Privileges[0].LUID )) then
  11. Begin
  12. IF aEnabled then TP.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED
  13. else TP.Privileges[0].Attributes:=0;
  14. dwRetLen:= 0;
  15. Result:=AdjustTokenPrivileges(Token,False,TP,SizeOf(TPPrev),TPPrev,dwRetLen);
  16. End;
  17. CloseHandle(Token);
  18. End;
  19.  
  20. procedure TForm1.Timer1Timer(Sender: TObject);
  21. begin
  22.  
  23. If Timer1.Tag > 0 Then
  24. Timer1.Tag := Timer1.Tag - 1
  25. else begin
  26.  
  27. SetPrivilege('SeShutdownPrivilege',True);
  28. ExitWindowsEx(EWX_REBOOT,0);
  29. end;
  30. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 3 октября 2008, 10:21
Оценка за ответ: 5

Ответ #3. Отвечает эксперт: seryoga

Здравствуйте, Ученый! попробуй так
(код перенесён в приложение)

Приложение:
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ExtCtrls, StdCtrls;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Label1: TLabel;
  12. Timer1: TTimer;
  13. Label2: TLabel;
  14. Label3: TLabel;
  15. procedure FormActivate(Sender: TObject);
  16. procedure Timer1Timer(Sender: TObject);
  17. private
  18. { Private declarations }
  19. public
  20. { Public declarations }
  21. end;
  22.  
  23. var
  24. Form1: TForm1;
  25. a:integer;
  26. implementation
  27.  
  28. {$R *.dfm}
  29. function SetPrivilege(aPrivilegeName: string;
  30. aEnabled: boolean): boolean;
  31. var
  32. TPPrev,
  33. TP: TTokenPrivileges;
  34. Token: THandle;
  35. dwRetLen: DWord;
  36. begin
  37. Result := False;
  38. OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES
  39. or TOKEN_QUERY, @Token);
  40.  
  41. TP.PrivilegeCount := 1;
  42. if (LookupPrivilegeValue(nil, PChar(aPrivilegeName),
  43. TP.Privileges[0].LUID)) then
  44. begin
  45. if (aEnabled) then
  46. TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  47. else
  48. TP.Privileges[0].Attributes := 0;
  49.  
  50. dwRetLen := 0;
  51. Result := AdjustTokenPrivileges(Token, False, TP,
  52. SizeOf(TPPrev),
  53. TPPrev, dwRetLen);
  54. end;
  55. CloseHandle(Token);
  56. end;
  57.  
  58. function WinExit(iFlags: integer): boolean;
  59.  
  60. // EWX_LOGOFF
  61. // EWX_REBOOT
  62. // EWX_SHUTDOWN
  63. begin
  64. Result := True;
  65. if (SetPrivilege('SeShutdownPrivilege', true)) then
  66. begin
  67. if (not ExitWindowsEx(iFlags, 0)) then
  68. begin
  69. Result := False;
  70. end;
  71. SetPrivilege('SeShutdownPrivilege', False)
  72. end
  73. else
  74. begin
  75. Result := False;
  76. end;
  77. end;
  78.  
  79.  
  80. procedure TForm1.FormActivate(Sender: TObject);
  81. begin
  82. a:=0;
  83. ShowWindow(Application.Handle, sw_Hide);
  84. end;
  85.  
  86. procedure TForm1.Timer1Timer(Sender: TObject);
  87. begin
  88. a:=a+1;
  89. Label1.Caption:=inttostr(20-a);
  90. if a=20 then
  91.  
  92. Winexit(EWX_REBOOT);
  93.  
  94. end;
  95. end;
  96.  
  97. end.


Ответ отправил: seryoga (статус: 1-ый класс)
Время отправки: 3 октября 2008, 10:58
Оценка за ответ: 5


Мини-форум вопроса

Всего сообщений: 5; последнее сообщение — 3 октября 2008, 11:15; участников в обсуждении: 3.
Шичко Игорь

Шичко Игорь (статус: 9-ый класс), 3 октября 2008, 10:53 [#1]:

to Feniks (пожелание)
Мне кажется нужно более спокойно относится к вопросам посетителей, смотреть более философски. Все-таки мы (у которых спрашивают) немного больше лазили по информационным сайтам, немного больше сталкивались с разными ситуациями. И то что нам кажется элементарным и давно пройденным, для других это в диковинку. Достаточно вспомнить как мы сами начинали.
Удачи во всем!
Ученый

Ученый (статус: 8-ой класс), 3 октября 2008, 10:58 [#2]:

to Feniks. Набрал как вы и сказали:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
Label2: TLabel;
Label3: TLabel;
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Function SetPrivilege(aPrivilegeName: String; aEnabled: Boolean ): Boolean;
Var TPPrev,
TP: TTokenPrivileges;
Token: THandle;
dwRetLen: DWord;
Begin
Result:=False;
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, @Token);
TP.PrivilegeCount:=1;
IF LookupPrivilegeValue(nil,PChar(aPrivilegeName),TP.Privileges[0].LUID )) then
Begin
IF aEnabled then TP.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED
else TP.Privileges[0].Attributes:=0;
dwRetLen:= 0;
Result:=AdjustTokenPrivileges(Token,False,TP,SizeOf(TPPrev),TPPrev,dwRetLen);
End;
CloseHandle(Token);
End;


procedure TForm1.FormActivate(Sender: TObject);
begin

ShowWindow(Application.Handle, sw_Hide);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption := 'Îñòàëîñü äî ïåðåçàãðóçêè : ' + IntToStr(Timer1.Tag) + ' ñåê.';
If Timer1.Tag > 0 Then
Timer1.Tag := Timer1.Tag - 1
else begin
Label1.Caption:='Ïåðåçàãðóçêà, ïîäîæäèòå ...';
SetPrivilege('SeShutdownPrivilege',True);
ExitWindowsEx(EWX_REBOOT,0);

end;

end.
Вылазит ошибка "types of actual and formal var parameters must be identical"!
Feniks

Feniks (статус: Бакалавр), 3 октября 2008, 11:10 [#3]:

Да, действительно. Виноват. В строке:
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, @Token);
замените @Token на Token.
И в следующей строке IF в конце лишнюю скобку тоже уберите. ;-)
Feniks

Feniks (статус: Бакалавр), 3 октября 2008, 11:12 [#4]:

Эксперты тоже люди и могут ошибаться. От этого никто не застрахован.
Ученый

Ученый (статус: 8-ой класс), 3 октября 2008, 11:15 [#5]:

Понятно! Я с вами полностью согласен!

31 января 2011, 19:23: Статус вопроса изменён на решённый (изменил модератор Ерёмин А.А.): Автоматическая обработка (2 и более ответов с оценкой 5)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:33
Выполнено за 0.03 сек.