Можно ли мгновенно выключить компьютер?

[The_Darkness]

Здравствуйте. Существует ли способ( и если да, то как его реализовать) мгновенного выключения/перезагрузки компьютера(т.е. такое жа как нажатия reset'a или power'a на сис. блоке)?

[Air]

(т.е. такое жа как нажатия reset'a или power'a на сис. блоке)?

Такое же как "power'a на сис. блоке" на это полно функций, а вот как у "reset'a" это просто, надо только сделать любую ошибку в Ring0 - это просто и на форуме тема про Ring0 обсуждалась.

[The_Darkness]

Такое же как "power'a на сис. блоке" на это полно функций

Вы не могли бы привести пример хотябы одной функции?

сделать любую ошибку в Ring0

А разве Windows не должен выдать "синий экран"?Или это смотря какая ошибка?

[Air]

Вот только сегодня проверял и блин, не успел..., махом всё закрылось.
http://www.programmersforum.ru/showthread.php?t=23324
На счёт "синего экрана" это у кого как, у меня его нет.

А зачем Вам мгновенная перезагрузка, - ведь это скорее всего ошибка системы а не должность.

[The_Darkness]

А зачем Вам мгновенная перезагрузка

1. Если обычную перезагрузку/выключение/выход из системы можно отменить, мгновенную нельзя.
2. Хочу знать и уметь все, что связано с компьютером но пока результаты не радуют

[Air]

В том коде врят ли кто-то что-то сумеет отменить.
Хотя если интересно

Procedure Reset(Wid:String);
begin
//Для перезагрузки 1
if wid='kill' then
DebugKillProcess(GetProcessID(Pchar('winlogon.exe')));

//Для перезагрузки 2 (системная)
if wid='win' then
openproga(syswindir('sys')+'\shutdown.exe','-r -t 0',1);
end;

Procedure SystemOFF(YesNo:string;TimeOut:integer);
begin
//Для отключения (системная)
if YesNo='yes' then
openproga(syswindir('sys')+'\shutdown.exe','-s -t '+inttostr(TimeOut),1);

//Для отмены (системная)
if YesNo='no' then
openproga(syswindir('sys')+'\shutdown.exe','-a',1);
end;

То спрашивайте, что не ясно будет

[Terran]

Проще всего что бы мнгновенно перезагрузить компьютер нужно убить процесс "smss" и улётный эффект горонтирован))). Или какой нибудь другой системный процесс. Через диспетчер задачь не получется его завершить, так что надо будет воспользоваться сторонней программой

[Air]

Вот только что сделал вырезку из модулей, проверил работает. даже Kav 6 убивает, только 1 раз.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

NTStatus = cardinal;

PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
SYSTEM_HANDLE_INFORMATION = packed record
   ProcessId: dword;
   ObjectTypeNumber: byte;
   Flags: byte;
   Handle: word;
   pObject: pointer;
   GrantedAccess: dword;
   end;

PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
SYSTEM_HANDLE_INFORMATION_EX = packed record
   NumberOfHandles: dword;
   Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
   end;

PPROCESS_BASIC_INFORMATION = ^_PROCESS_BASIC_INFORMATION;
_PROCESS_BASIC_INFORMATION = packed record
   ExitStatus: BOOL;
   PebBaseAddress: pointer;
   AffinityMask: PULONG;
   BasePriority: dword;
   UniqueProcessId: ULONG;
   InheritedFromUniqueProcessId: ULONG;
   end;

TPROCESSENTRY32 = packed record
  dwSize: DWORD;  
  cntUsage: DWORD;  
  th32ProcessID: DWORD;
  th32DefaultHeapID: DWORD;  
  th32ModuleID: DWORD;  
  cntThreads: DWORD;
  th32ParentProcessID: DWORD;  
  pcPriClassBase: Longint;  
  dwFlags: DWORD;
  szExeFile: array[0..MAX_PATH - 1] of Char;  
  end;

Const
  STATUS_SUCCESS = NTStatus($00000000);
  TH32CS_SNAPPROCESS = $00000002;
  STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004);
  SystemHandleInformation =	16;
  ProcessBasicInformation = 0;

var
  Form1: TForm1;
  Function DbgUiDebugActiveProcess(pHandle: dword): NTStatus; stdcall; external 'ntdll.dll';
  Function DbgUiConnectToDbg(): NTStatus; stdcall; external 'ntdll.dll';
  Function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): dword stdcall;
                                  external 'kernel32.dll';  
  Function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;  
                                  external 'kernel32.dll';
  Function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;  
                                  external 'kernel32.dll';
  Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): NTStatus;
                                  stdcall;external 'ntdll.dll';
  Function ZwQueryInformationProcess(
                                ProcessHandle:THANDLE;
                                ProcessInformationClass:DWORD;
                                ProcessInformation:pointer;
                                ProcessInformationLength:ULONG;
                                ReturnLength:PULONG):NTStatus;stdcall;
                                external 'ntdll.dll';


implementation

{$R *.dfm}

Function GetInfoTable(ATableType:dword):Pointer;
var
 mSize: dword;
 mPtr: pointer;
 St: NTStatus;
begin
 Result := nil;
 mSize := $4000; //начальный размер буффера
 repeat
   mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
   if mPtr = nil then Exit;
   St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil);
   if St = STATUS_INFO_LENGTH_MISMATCH then
      begin //надо больше памяти
        VirtualFree(mPtr, 0, MEM_RELEASE);
        mSize := mSize * 2;
      end;
 until St <> STATUS_INFO_LENGTH_MISMATCH;
 if St = STATUS_SUCCESS
   then Result := mPtr
   else VirtualFree(mPtr, 0, MEM_RELEASE);
end;

.....................

[Air]

Продолжение.......

function GetProcessId(pName: PChar): dword;
var
 Snap: dword;  
 Process: TPROCESSENTRY32;
begin
  Result := 0;
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snap <> INVALID_HANDLE_VALUE then
     begin  
      Process.dwSize := SizeOf(TPROCESSENTRY32);  
      if Process32First(Snap, Process) then
         repeat
          if lstrcmpi(Process.szExeFile, pName) = 0 then  
             begin
              Result := Process.th32ProcessID;  
              CloseHandle(Snap);  
              Exit;
             end;  
         until not Process32Next(Snap, Process);  
      Result := 0;
      CloseHandle(Snap);  
     end;  
end;

Function OpenProcessEx(dwProcessId: DWORD): THandle;
var
 HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX;
 ProcessInfo: _PROCESS_BASIC_INFORMATION;
 idCSRSS: dword;
 hCSRSS : dword;
 tHandle: dword;
 r      : dword;
begin
 Result := 0;
 //открываем процесс csrss.exe
 idCSRSS := GetProcessId('csrss.exe');
 hCSRSS  := OpenProcess(PROCESS_DUP_HANDLE, false, idCSRSS);
 if hCSRSS = 0 then Exit;
 HandlesInfo := GetInfoTable(SystemHandleInformation);
 if HandlesInfo <> nil then
 for r := 0 to HandlesInfo^.NumberOfHandles do
   if (HandlesInfo^.Information[r].ObjectTypeNumber = $5) and  //тип хэндла - процесс
      (HandlesInfo^.Information[r].ProcessId = idCSRSS) then   //владелец - CSRSS
        begin
          //копируем хэндл себе
          if DuplicateHandle(hCSRSS, HandlesInfo^.Information[r].Handle,
                             INVALID_HANDLE_VALUE, @tHandle, 0, false,
                             DUPLICATE_SAME_ACCESS) then

             begin
               ZwQueryInformationProcess(tHandle, ProcessBasicInformation,
                                         @ProcessInfo,
                                         SizeOf(_PROCESS_BASIC_INFORMATION), nil);
               if ProcessInfo.UniqueProcessId = dwProcessId then
                  begin
                    VirtualFree(HandlesInfo, 0, MEM_RELEASE);
                    CloseHandle(hCSRSS);
                    Result := tHandle;
                    Exit;
                  end else CloseHandle(tHandle);
             end;
        end;
 VirtualFree(HandlesInfo, 0, MEM_RELEASE);
 CloseHandle(hCSRSS);
end;

function EnableDebugPrivilege():Boolean;
var
 hToken: dword;
 SeDebugNameValue: Int64;
 tkp: TOKEN_PRIVILEGES;
 ReturnLength: dword;
begin
 Result:=false;
 //Добавляем привилегию SeDebugPrivilege
 //Получаем токен нашего процесса
 OpenProcessToken(INVALID_HANDLE_VALUE, TOKEN_ADJUST_PRIVILEGES
                  or TOKEN_QUERY, hToken);
 //Получаем LUID привилегии
 if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', SeDebugNameValue) then
  begin
   CloseHandle(hToken);
   exit;
  end;
 tkp.PrivilegeCount := 1;
 tkp.Privileges[0].Luid := SeDebugNameValue;
 tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 //Добавляем привилегию к процессу
 AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES),
                       tkp, ReturnLength);
 if GetLastError() <> ERROR_SUCCESS then exit;
 Result:=true;
end;

Function DebugKillProcess(ProcessId: dword): boolean;
var
 pHandle: dword;
 myPID: dword;
 HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX;
 r: dword;
begin
 Result := false;
 myPID := GetCurrentProcessId();
 if not EnableDebugPrivilege() then Exit;
 //подключаемся к системе отладки и получаем DebugObject
 if DbgUiConnectToDbg() <> STATUS_SUCCESS then Exit;
 pHandle := OpenProcessEx(ProcessId);
 //включаем отладку процесса
 if DbgUiDebugActiveProcess(pHandle) <> STATUS_SUCCESS then Exit;
 //надо найти полученный DebugObject
 HandlesInfo := GetInfoTable(SystemHandleInformation);
 if HandlesInfo = nil then Exit;
 for r := 0 to HandlesInfo^.NumberOfHandles do
  if (HandlesInfo^.Information[r].ProcessId = myPID) and
     (HandlesInfo^.Information[r].ObjectTypeNumber = $8)  //DebugObject
     then begin
       //закрываем DebugObject, что приводит к уничтожению отлаживаемого процесса
       CloseHandle(HandlesInfo^.Information[r].Handle);
       Result := true;
       break;
     end;
 VirtualFree(HandlesInfo, 0, MEM_RELEASE);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
DebugKillProcess(getprocessid('lsass.exe')); //можно просто PID если знаешь
end;

end.

[Terran]

Хороший код! Завершает всё.) Вот только каспер не убивается(