[loxod]

El codigo fuente para reiniciar, apagar y cerrar sesion de una pc o mostrar un warning a un tiempo determinado

Código Delphi [-]
unit Main; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ShellApi, Menus, ExtCtrls, ActnList, StdCtrls, ComCtrls, Buttons; 

type 
  TwndIconic = class(TForm) 
    GroupBox1: TGroupBox; 
    lHoraActual: TLabel; 
    RadioGroup1: TRadioGroup; 
    gAccion: TGroupBox; 
    lHora: TLabel; 
    Button3: TButton; 
    BMinimizar: TButton; 
    BAjustar: TButton; 
    Button2: TButton; 
    actAction: TActionList; 
    actAcercaDe: TAction; 
    actAyuda: TAction; 
    actAjustarHora: TAction; 
    actMinimizar: TAction; 
    actSalir: TAction; 
    Temporizador: TTimer; 
    PopupMenu1: TPopupMenu; 
    Acercade1: TMenuItem; 
    Ayuda1: TMenuItem; 
    Ajustarhora1: TMenuItem; 
    Minimizar1: TMenuItem; 
    Salir1: TMenuItem; 
    opApagar: TRadioButton; 
    opReiniciar: TRadioButton; 
    opReiniciarEquipo: TRadioButton; 
    opAviso: TRadioButton; 
    BE: TStatusBar; 
    actConfiguracion: TAction; 
    N1: TMenuItem; 
    Configuracin1: TMenuItem; 
    N2: TMenuItem; 
    LWEB: TLabel; 
    Nuev: TLabel; 
    GroupBox2: TGroupBox; 
    opGuardar: TCheckBox; 
    opCapturar: TCheckBox; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure actAcercaDeExecute(Sender: TObject); 
    procedure actAjustarHoraExecute(Sender: TObject); 
    procedure actMinimizarExecute(Sender: TObject); 
    procedure actSalirExecute(Sender: TObject); 
    procedure TemporizadorTimer(Sender: TObject); 
    procedure opApagarClick(Sender: TObject); 
    procedure opApagarDblClick(Sender: TObject); 
    procedure opAvisoClick(Sender: TObject); 
    procedure opReiniciarClick(Sender: TObject); 
    procedure opReiniciarDblClick(Sender: TObject); 
    procedure opReiniciarEquipoClick(Sender: TObject); 
    procedure opReiniciarEquipoDblClick(Sender: TObject); 
    procedure actConfiguracionExecute(Sender: TObject); 
    procedure BitBtn1Click(Sender: TObject); 
    procedure RealizarProceso (); 
    procedure LWEBClick2(Sender: TObject); 
  private 
    iconificada : boolean; 
    FTrayMessage: Cardinal; 
    ejecutadoYa : boolean; 
    procedure RButtonUp; 
    procedure LButtonDblClk; 
  protected 
    procedure WndProc(var Msg: TMessage); override; 
  public 
    Hora : TDatetime;{ Public declarations } 
    cancelar, realizar : boolean; 
    procedure NotifyTray(Command: Word; const Hint: string); 
  end; 

var 
  wndIconic: TwndIconic; 

implementation 

uses About,  unidadajustarhora, unidadRealizar; 

{$R *.DFM} 

resourcestring 
  STrayMessage = 'AjpdSoft PCU 1.0'; 

procedure TwndIconic.NotifyTray(Command: Word; const Hint: string); 
var 
  Data: TNotifyIconData; 
begin 
  Data.cbSize := SizeOf(Data); 
  Data.uID := 0; 
  Data.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; 
  Data.Wnd := Self.Handle; 
  Data.uCallbackMessage := FTrayMessage; 
  Data.hIcon := Application.Icon.Handle; 
  StrLCopy(Data.szTip, PChar(Hint), SizeOf(Data.szTip)); 
  Shell_NotifyIcon(Command, @Data); 
end; 

procedure TwndIconic.WndProc(var Msg: TMessage); 
begin 
  if Msg.Msg = FTrayMessage then 
    case Msg.LParam of 
      WM_RBUTTONUP: RButtonUp; 
      WM_LBUTTONDBLCLK: LButtonDblClk; 
    end 
  else 
    inherited WndProc(Msg); 
end; 

procedure TwndIconic.LButtonDblClk; 
begin 
  with Twndabout.Create(nil) do 
  try 
    ShowModal; 
  finally 
    Free; 
  end; 
end; 

procedure TwndIconic.RButtonUp; 
var 
  Pt: TPoint; 
begin 
  GetCursorPos(Pt); 
  SetForegroundWindow(Application.Handle); 
  Application.ProcessMessages; 
  PopupMenu1.Popup(Pt.X, Pt.Y); 
end; 

procedure TwndIconic.FormCreate(Sender: TObject); 
begin 
  realizar := False; 
  cancelar := False; 
  iconificada := false; 
  lhoraactual.Caption := TimeToStr (time); 
end; 

procedure TwndIconic.FormDestroy(Sender: TObject); 
begin 
  ejecutadoya := false; 
  NotifyTray(NIM_DELETE, ''); 
end; 

procedure TwndIconic.actAcercaDeExecute(Sender: TObject); 
begin 
  with Twndabout.Create(nil) do 
  try 
    ShowModal; 
  finally 
    Free; 
  end; 
end; 

procedure TwndIconic.actAjustarHoraExecute(Sender: TObject); 
begin 
  If frmAjustarHora.ShowModal = MrOk Then 
  begin 
    try 
    begin 
      Hora := StrToTime(frmAjustarHora.txthora.Text); 
      lhora.Caption := frmAjustarHora.txthora.Text; 
      actAjustarHora.caption := 'Change hour'; 
      if opApagar.Checked then 
        caption := 'Shutdown at the: ' + TimeToStr (hora); 
      if opReiniciar.Checked then 
        caption := 'Restart at the: ' + TimeToStr (hora); 
      if opAviso.Checked then 
        caption := 'Warning at the: ' + TimeToStr (hora); 
      ejecutadoya := false; 
      temporizador.Enabled := true; 
    end; 
    except 
      messagedlg ('The introduced hour is not correct.', mterror, [mbok],0); 
    end; 
  end; 
end; 

procedure TwndIconic.actMinimizarExecute(Sender: TObject); 
begin 
  hide; 
  actMinimizar.visible := false; 
  actConfiguracion.visible := true; 
  Application.ShowMainForm := False; 
  ShowWindow(Application.Handle, SW_HIDE); 
  FTrayMessage := RegisterWindowMessage(PChar(STrayMessage)); 
  NotifyTray(NIM_ADD, ''); 
  iconificada := true; 
end; 


procedure TwndIconic.actSalirExecute(Sender: TObject); 
begin 
  close; 
end; 

function GetErrorstring: string; 
var 
  lz : Cardinal; 
  err : array[0..512] of Char; 
begin 
  lz := GetLastError; 
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil); 
  Result := string(err); 
end; 

procedure apagarPC; 
var 
  rl, flgs : Cardinal; 
  hToken : Cardinal; 
  tkp : TOKEN_PRIVILEGES; 
begin 
  flgs := 0; 
  flgs := flgs or EWX_POWEROFF; 
  if Win32Platform = VER_PLATFORM_WIN32_NT then 
  begin 
    if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES 
             or TOKEN_QUERY, hToken) then 
      ShowMessage ('Has not been possible to open the process. [' + GetErrorstring + ']') 
    else 
    begin 
      if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then 
      begin 
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
        tkp.PrivilegeCount           := 1; 
        AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl); 
        if GetLastError <> ERROR_SUCCESS then 
          ShowMessage('An error has taken place when trying to adjust the privileges.'); 
      end 
      else 
        ShowMessage('Has not been the value of the privilege. [' + GetErrorstring + ']'); 
    end; 
    ExitWindowsEx(flgs, 0); 
  end; 
end; 

procedure TwndIconic.RealizarProceso (); 
begin 
  //shutdown 
  If (opapagar.checked = True)  Then 
  begin 
    apagarPC; 
  end; 
  //close session current user 
  If (opreiniciar.checked = True)  Then 
    ExitWindowsEx (0,0); 
  //restart PC 
  If (opReiniciarEquipo.checked = True)  Then 
    ExitWindowsEx (EWX_REBOOT,0); 
  //Warning 
  If (opaviso.checked = True)  Then 
    messagedlg ('I warn of the program PCU, surely have something to make...', 
        mtwarning, [mbok],0); 
  frmRealizando.hacer := false;   
  frmRealizando.Close; 
end; 

procedure TwndIconic.TemporizadorTimer(Sender: TObject); 
Var 
 hAlarma,mAlarma : word; 
 hActual,mActual : word; 
 Milisegundos, Segundos : word; 
begin 
  lhoraactual.Caption := TimeToStr (time); 
  if not ejecutadoYa then 
  begin 
    DecodeTime(Hora, hAlarma, mAlarma, segundos, Milisegundos); 
    DecodeTime(Time, hActual, mActual, segundos, Milisegundos); 

    if iconificada then 
    begin 
      if lhora.Caption <> 'Without adjusting hour...' then 
      begin 
        if opapagar.Checked then 
          if iconificada then 
            NotifyTray(NIM_MODIFY, 'The PC will fade to those: ' + lHora.Caption); 
        if opReiniciar.Checked then 
          if iconificada then 
            NotifyTray(NIM_MODIFY, 'The session will close to those: ' + lHora.Caption); 
        if opReiniciarEquipo.Checked then 
          if iconificada then 
            NotifyTray(NIM_MODIFY, 'The PC will be restarted to those: ' + lHora.Caption); 
        if opAviso.Checked then 
          if iconificada then 
            NotifyTray(NIM_MODIFY, 'The PC will warn to those: ' + lHora.Caption); 
      end 
      else 
        NotifyTray(NIM_MODIFY, 'It has not adjusted hour of action'); 
    end; 

    //shutdown 
    If (HActual = hAlarma) and (mActual= mAlarma) and 
        (opapagar.checked = True)  Then 
    Begin 
      ejecutadoya := true; 
      frmrealizando.lAccion.Caption := 'Will shutdown the PC...'; 
      frmrealizando.temporizador.Enabled := true; 
      frmrealizando.show; 
    end; 
    //Close the current session 
    If (HActual = hAlarma) and (mActual= mAlarma) and 
        (opreiniciar.checked = True)  Then 
    begin 
      ejecutadoya := true; 
      frmrealizando.lAccion.Caption := 'Closing the current session...'; 
      frmrealizando.temporizador.Enabled := true; 
      frmrealizando.show; 
    end; 
    //Restart the PC 
    If (HActual = hAlarma) and (mActual= mAlarma) and 
        (opReiniciarEquipo.checked = True)  Then 
    begin 
      ejecutadoya := true; 
      frmrealizando.lAccion.Caption := 'Restarting the PC...'; 
      frmrealizando.temporizador.Enabled := true; 
      frmrealizando.show; 
    end; 
    //warning 
    If (HActual = hAlarma) and (mActual= mAlarma) and 
        (opaviso.checked = True)  Then 
    begin 
      ejecutadoya := true; 
      temporizador.Enabled := false; 
      frmrealizando.lAccion.Caption := 'Warning to the user...'; 
      frmrealizando.temporizador.Enabled := true; 
      frmrealizando.show; 
    end; 
  end; 
end; 


procedure TwndIconic.opApagarClick(Sender: TObject); 
begin 
  ejecutadoya := false; 
  be.Panels[0].Text := 'Action: TURN OFF'; 
end; 

procedure TwndIconic.opApagarDblClick(Sender: TObject); 
begin 
  ExitWindowsEx (1,0); 
end; 

procedure TwndIconic.opAvisoClick(Sender: TObject); 
begin 
  ejecutadoya := false; 
  be.Panels[0].Text := 'Action: I WARN'; 
end; 

procedure TwndIconic.opReiniciarClick(Sender: TObject); 
begin 
  ejecutadoya := false; 
  be.Panels[0].Text := 'Action: RESTART CURRENT SESSION'; 
end; 

procedure TwndIconic.opReiniciarDblClick(Sender: TObject); 
begin 
  ExitWindowsEx (0,0); 
end; 

procedure TwndIconic.opReiniciarEquipoClick(Sender: TObject); 
begin 
  ejecutadoya := false; 
  be.Panels[0].Text := 'Action: RESTART PC'; 
end; 

procedure TwndIconic.opReiniciarEquipoDblClick(Sender: TObject); 
begin 
  ExitWindowsEx (EWX_REBOOT,0); 
end; 

procedure TwndIconic.actConfiguracionExecute(Sender: TObject); 
begin 
  show; 
  actMinimizar.Visible := true; 
  iconificada := false; 
end; 

procedure TwndIconic.LWEBClick2(Sender: TObject); 
begin 
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION), 
      Nil, Nil, SW_SHOWNORMAL); 
end; 

end. 













******************************************* 



unit unidadajustarhora; 

interface 

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

type 
  TfrmAjustarHora = class(TForm) 
    txtHora: TMaskEdit; 
    Label1: TLabel; 
    BitBtn1: TBitBtn; 
    Panel1: TPanel; 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  frmAjustarHora: TfrmAjustarHora; 

implementation 

{$R *.DFM} 

end. 






********************************************************++ 


unit unidadRealizar; 

interface 

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

type 
  TfrmRealizando = class(TForm) 
    bp: TProgressBar; 
    lAccion: TLabel; 
    Button1: TButton; 
    Button2: TButton; 
    temporizador: TTimer; 
    procedure FormShow(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure temporizadorTimer(Sender: TObject); 
  private 
    bpulsado : boolean; 
    { Private declarations } 
  public 
    hacer : boolean; 
    { Public declarations } 
  end; 

var 
  frmRealizando: TfrmRealizando; 

implementation 

uses Main; 

{$R *.dfm} 

procedure TfrmRealizando.FormShow(Sender: TObject); 
begin 
  hacer := true; 
  bpulsado := false; 
end; 

procedure TfrmRealizando.Button2Click(Sender: TObject); 
begin 
  bpulsado := true; 
  wndiconic.cancelar := true; 
  wndiconic.realizar := false; 
  close; 
end; 

procedure TfrmRealizando.Button1Click(Sender: TObject); 
begin 
  bpulsado := true; 
  wndiconic.realizar := true; 
  wndiconic.cancelar := false; 
  close; 
end; 

procedure TfrmRealizando.FormClose(Sender: TObject; 
  var Action: TCloseAction); 
begin 
  if hacer then 
  begin 
    if not bpulsado then 
      wndIconic.realizar := true; 
    wndiconic.realizarProceso(); 
  end; 
end; 

procedure TfrmRealizando.temporizadorTimer(Sender: TObject); 
var 
  i, j, k : integer; 
begin 
  temporizador.Enabled := false; 
  wndiconic.cancelar := false; 
  wndiconic.realizar := false; 
  bpulsado := false; 
  bp.Min := 0; 
  bp.max := 1000; 
  bp.Position := 0; 
  refresh; 
  for i := 0 to 1000 do 
  begin 
    bp.Position := i; 
    Application.ProcessMessages; 
    if (wndiconic.cancelar) or (wndiconic.realizar) then 
    begin 
      bpulsado := true; 
      close; 
    end; 
    for j := 1 to 1000 do 
      for k := 1 to 1000 do 
  end; 
  close; 
end; 

end. 






************************************************************ 
unit About; 

interface 

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

type 
  Twndabout = class(TForm) 
    Label1: TLabel; 
    Label2: TLabel; 
    Bevel1: TBevel; 
    Label3: TLabel; 
    Label4: TLabel; 
    txMemory: TLabel; 
    txFree: TLabel; 
    Button1: TButton; 
    LWEB: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure LWEBClick(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  wndabout: Twndabout; 

implementation 

{$R *.DFM} 

procedure Twndabout.FormCreate(Sender: TObject); 
var 
  MS: TMemoryStatus; 
begin 
  MS.dwLength := SizeOf(MS); 
  GlobalMemoryStatus(MS); 
  txMemory.Caption := FormatFloat('#, KB', MS.dwTotalPhys div 1024); 
  txFree.Caption := FormatFloat('#, KB', MS.dwAvailPhys div 1024); 
end; 

procedure Twndabout.LWEBClick(Sender: TObject); 
begin 
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION), 
      Nil, Nil, SW_SHOWNORMAL); 
end; 

end.