Remote Shutdown

uses RsConst, Registry, ShlObj, ActiveX

private
    { Private declarations }
    FLocalComputerName: string;
    procedure EnablePrivileges;
    procedure DisablePrivileges;
    
var
  Form1: TForm1;
  hToken: THandle;
  TokenPrivileges: TTokenPrivileges;
  RetuurnLength: DWORD = 0;
  
//

function SelectComputer(const Caption: string; out ComputerName: string): Boolean;
var
  ItemIDList: PItemIDList;
  BrowseInfo: TBrowseInfo;
  NameBuffer: array[0..MAX_PATH] of Char;
  WindowList: Pointer;
  ShellMalloc: IMalloc;
begin
  Result := False;
  if not Failed(SHGetSpecialFolderLocation(Application.Handle, CSIDL_NETWORK, ItemIDList)) then
  try
    FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
    with BrowseInfo do
    begin
      hwndOwner := Application.Handle;
      pidlRoot := ItemIDList;
      pszDisplayName := NameBuffer;
      lpszTitle := PChar(Pointer(Caption));
      ulFlags := BIF_BROWSEFORCOMPUTER;
    end;
    WindowList := DisableTaskWindows(0);
    try
      Result := Assigned(SHBrowseForFolder(BrowseInfo));
    finally
      EnableTaskWindows(WindowList);
    end;
    if Result then
      ComputerName := NameBuffer;
  finally
    if Succeeded(SHGetMalloc(ShellMalloc)) then
      ShellMalloc.Free(ItemIDList);
  end;
end;

procedure TForm1.EnablePrivileges;
var
  PrivilegeName: PChar;
begin
  if not OpenProcessToken(GetCurrentProcess,
                          TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    raise Exception.Create(SOpenProcessTokenErr);
  if AnsiSameText(Edit1.Text, FLocalComputerName) then
    PrivilegeName := SE_SHUTDOWN_NAME
  else
    PrivilegeName := SE_REMOTE_SHUTDOWN_NAME;
  if not LookupPrivilegeValue(PChar(Edit1.Text), PrivilegeName,
                              TokenPrivileges.Privileges[0].Luid) then
    raise Exception.Create(SLookupPrivilegeValueErr);
  TokenPrivileges.PrivilegeCount := 1;
  TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken, False, TokenPrivileges, 0, nil, RetuurnLength);
  if GetLastError <> ERROR_SUCCESS then
    raise Exception.Create(SAdjustTokenPrivilegesEnableErr);
end;

procedure TForm1.DisablePrivileges;
begin
  TokenPrivileges.Privileges[0].Attributes := 0;
  AdjustTokenPrivileges(hToken, False, TokenPrivileges, 0, nil, RetuurnLength);
  if GetLastError <> ERROR_SUCCESS then
    raise Exception.Create(SAdjustTokenPrivilegesDisableErr);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ComputerName: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  MaxComputerName: Cardinal;
begin
  with TRegistry.Create do
  try
    if OpenKey(INIT_KEY, False) then
    try
      if ValueExists(STop) then
        Top := ReadInteger(STop);
      if ValueExists(SLeft) then
        Left := ReadInteger(SLeft);
      if ValueExists(SForce) then
        CheckBox1.Checked := ReadBool(SForce);
      if ValueExists(SReboot) then
        CheckBox2.Checked := ReadBool(SReboot);
      if ValueExists(STimeout) then
        UpDown1.Position := ReadInteger(STimeout);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
  MaxComputerName := SizeOf(ComputerName);
  GetComputerName(ComputerName, MaxComputerName);
  Edit1.Text := '\\' + ComputerName;
  FLocalComputerName := Edit1.Text;
  Memo1.Text := SMessageText;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  with TRegistry.Create do
  try
    if OpenKey(INIT_KEY, True) then
    try
      WriteInteger(STop, Top);
      WriteInteger(SLeft, Left);
      WriteBool(SForce, CheckBox1.Checked);
      WriteBool(SReboot, CheckBox2.Checked);
      WriteInteger(STimeout, UpDown1.Position);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

Computer im Netzwerk wählen :

procedure TForm1.Button1Click(Sender: TObject);
var
  ComputerName: string;
begin
  SelectComputer(SSelectComputer, ComputerName);
  if ComputerName <> '' then
    Edit1.Text := '\\' + ComputerName;
end;

Computer Herunterfahren :

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Application.MessageBox(PChar(SConfirm), PChar(Application.Title),
                            MB_ICONQUESTION or MB_YESNO) = ID_NO then Exit;
  EnablePrivileges;
  try
    if not InitiateSystemShutdown(PChar(Edit1.Text),
                                  PChar(Memo1.Text),
                                  UpDown1.Position,
                                  CheckBox1.Checked,
                                  CheckBox2.Checked) then
      raise Exception.Create(SInitiateSystemShutdownErr);
  finally
    DisablePrivileges;
  end;
  Button3.Enabled := True;
end;

Herunterfahren abrechen :

procedure TForm1.Button3Click(Sender: TObject);
begin
  EnablePrivileges;
  try
    if not AbortSystemShutdown(PChar(Edit1.Text)) then
      raise Exception.Create(SAbortSystemShutdownErr);
  finally
    DisablePrivileges;
  end;
  Button3.Enabled := False;
end;