Monday, February 7, 2011

Remote Shutdown in Delphi

Remote Shutdown
Aplikasi ini terbagi menjadi 2, yaitu aplikasi client dan aplikasi server. Aplikasi Client adalah aplikasi pengendali atau pengontrol, sedangkan aplikasi server adalah aplikasi yang di jalankan pada komputer yang ingin di kendalikan (komputer yang ingin di shutdown)
Source Code Program Client :
Berikut ini adalah source code lengkap untuk program client, ScreenShoot program jadinya bisa dilihat pada gambar berikut:

unit RSClient;

interface

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

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Edit1: TEdit;
Button1: TButton;
StaticText1: TStaticText;
StaticText2: TStaticText;
Button2: TButton;
Button3: TButton;
WinXP1: TWinXP;
ClientSocket1: TClientSocket;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;  // keluar program
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
clientsocket1.Host:=edit1.Text;  // alamat ip server
clientsocket1.Active:=true;      // mengaktifkan / membuka socket sisi client
clientsocket1.Port:=1880;        // menggunakan port 1880
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
button2.Enabled:=false;    // saat aplikasi mulai dijalankan button shutdown di disable
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);     //saat soket client error
begin
button2.Enabled:=false;   //disable button shutdown
showmessage(‘Error On Socket’);  //menampilkan pesan error
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);   //saat sudah terhubung ke server
begin
statictext2.Caption:=’Connected to Server’;   //keterangan bahwa sudah terhubung ke server
button2.Enabled:=true;   // button shutdown di aktifkan
end;

procedure TForm1.Button2Click(Sender: TObject);
begin       //button shutdown
if (clientsocket1.Socket.Connected) then  //saat soket terhubung maka
clientsocket1.Socket.SendText(‘shutdown’); // button 2 mengirim string ke server
end;

end.
Source Code Program Server :
Berikut ini adalah source code lengkap untuk program server, ScreenShoot program jadinya bisa dilihat pada gambar berikut:

unit RSServer;

interface

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

type
TForm1 = class(TForm)
WinXP1: TWinXP;
ServerSocket1: TServerSocket;
StaticText1: TStaticText;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
serversocket1.Open;   //membuka soket server
serversocket1.Port:=1880; //menggunakan port 1880
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
edit1.Text:=socket.ReceiveText;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if edit1.Text=’shutdown’ then  //bila edit1.text berisi text shutdown maka,
begin winexec(‘shutdown -r -t 0 -f’,sw_normal); end;  //perintah shutdown dijalankan
end;

end.



U may also try this code below :
______________________________________________________________________________ 



// Client Program:
// Send 'power' to Client to shutdown the machine.
// Send 'reset' to Client to reset the machine.

unit Unit1;

interface

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

type
  
TForm1 = class(TForm)
    Clientsocket1: TClientSocket;
    StatusBar1: TStatusBar;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Checkbox2: TCheckBox;
    procedure Button1Click(Sender : TObject);
    procedure Button2Click(Sender : TObject);
    procedure Clientsocket1Error(Sender : TObject; Socket : TCustomWinSocket;
      ErrorEvent : TErrorEvent; var ErrorCode : integer);
    procedure Clientsocket1Disconnect(Sender : TObject;
      Socket : TCustomWinSocket);
    procedure Clientsocket1Connect(Sender : TObject;
      Socket : TCustomWinSocket);
    procedure Button3Click(Sender : TObject);
    procedure FormClose(Sender : TObject; var Action : TCloseAction);
    procedure FormDestroy(Sender : TObject);
  private
    
{ Private declarations }
  
public
    
{ Public declarations }
  
end;

var
  
Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender : TObject);
begin
  
Clientsocket1.Active := True;
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
  
Clientsocket1.Active := False;
end;

procedure TForm1.Clientsocket1Error(Sender : TObject;
  Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;
  var ErrorCode : integer);
begin
  
errorcode := 0;
  StatusBar1.SimpleText := 'Error';
end;

procedure TForm1.Clientsocket1Disconnect(Sender : TObject;
  Socket : TCustomWinSocket);
begin
  
StatusBar1.SimpleText := 'Disconnect';
end;

procedure TForm1.Clientsocket1Connect(Sender : TObject;
  Socket : TCustomWinSocket);
begin
  
StatusBar1.SimpleText := Clientsocket1.Address;
end;

procedure TForm1.Button3Click(Sender : TObject);
var
  
ukaz : string;
  orders : string;
  Text : string;
  box : string;
begin
  
ukaz := edit1.Text;
  Clientsocket1.Socket.SendText(ukaz);
  if checkbox1.Checked = True then
  begin
    
orders := 'power';
    Clientsocket1.Socket.SendText(orders);
  end;
  if Checkbox2.Checked = True then
  begin
    
Text := 'reset';
    Clientsocket1.Socket.SendText(Text);
  end;
end;

procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);
begin
  
Clientsocket1.Active := False;
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
  
Clientsocket1.Active := False;
end;

end.


// Client Program

unit Unit1;

interface

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

type
  
TForm1 = class(TForm)
    Label1: TLabel;
    Serversocket1: TServerSocket;
    procedure FormClose(Sender : TObject; var Action : TCloseAction);
    procedure FormDestroy(Sender : TObject);
    procedure FormCreate(Sender : TObject);
    procedure Serversocket1ClientError(Sender : TObject;
      Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;
      var ErrorCode : integer);
    procedure Serversocket1ClientRead(Sender : TObject;
      Socket : TCustomWinSocket);
  private
    
{ Private declarations }
  
public
    
{ Public declarations }
  
end;

var
  
Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);
begin
  
Serversocket1.Active := False;
end;

procedure TForm1.FormDestroy(Sender : TObject);
begin
  
Serversocket1.Active := False;
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
  
Serversocket1.Active := True;
end;

procedure TForm1.Serversocket1ClientError(Sender : TObject;
  Socket : TCustomWinSocket; ErrorEvent : TErrorEvent;
  var ErrorCode : integer);
begin
  
errorcode := 0;
end;

procedure TForm1.Serversocket1ClientRead(Sender : TObject;
  Socket : TCustomWinSocket);
var
  
ukaz : string;
  orders : string;
  Text : string;
  box : string;
begin
  
ukaz := socket.ReceiveText;
  label1.Caption := 'reciving...';
  ShellExecute(Handle, 'open', PChar(ukaz), PChar(''), nil, sw_show);
  Text := socket.ReceiveText;
  orders := socket.ReceiveText;
  if orders = 'power' then
  begin
    
ShellExecute(Handle, 'open', PChar('shutdown.exe'), PChar('-s'), nil, sw_show);
    Application.MessageBox('You will be turned off', 'Warning', mb_iconexclamation);
    Serversocket1.Active := False;
    Form1.Close;
  end;
  if Text = 'reset' then
  begin
    
ShellExecute(Handle, 'open', PChar('shutdown.exe'), PChar('-r'), nil, sw_show);
    Application.MessageBox('You will be reset', 'Warning', mb_iconexclamation);
    Serversocket1.Active := False;
    Form1.Close;
  end;
end;


end.




Twitter Delicious Facebook Digg Stumbleupon Favorites More

 
Design by Kang Iwan K-sev | Thank's for your visit To My Site - Ridwan Mulyana | Cibeureum