unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinSvc;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
Machine = '\\MachineName'; Service = 'Active@ Disk Monitor';
function ServiceStart(Machine, Service: String) : Boolean;
var
schm,
schs: SC_Handle;
ss: TServiceStatus;
psTemp: PChar;
dwChkP: DWord;
begin
ss.dwCurrentState := 1;
schm := OpenSCManager(PChar(Machine), SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if (schm>0) then
begin
schs := OpenService(schm, PChar(Service), SERVICE_START or
SERVICE_QUERY_STATUS);
if (schs>0) then
begin
psTemp := nil;
if (StartService(schs, 0, psTemp)) then
if (QueryServiceStatus(schs, ss)) then
while (SERVICE_RUNNING<>ss.dwCurrentState) do
begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs, ss)) then
Break;
if (ss.dwCheckPoint < dwChkP) then
Break;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := SERVICE_RUNNING=ss.dwCurrentState;
end;
function ServiceStop(Machine, Service: String) : Boolean;
var
schm,
schs: SC_Handle;
ss: TServiceStatus;
dwChkP: DWord;
begin
schm := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT);
if (schm>0) then
begin
schs := OpenService(schm, PChar(Service), SERVICE_STOP or
SERVICE_QUERY_STATUS);
if (schs>0) then
begin
if (ControlService(schs, SERVICE_CONTROL_STOP, ss)) then
if (QueryServiceStatus(schs, ss)) then
while (SERVICE_STOPPED<>ss.dwCurrentState) do
begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs, ss)) then
Break;
if (ss.dwCheckPoint < dwChkP) then
Break;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := SERVICE_STOPPED=ss.dwCurrentState;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Msg : String;
begin
if (ServiceStart(Machine, Service)) then
begin
Msg := 'Servicio Iniciado Satisfactoriamente';
MessageDlg(Msg,mtInformation,[mbOK],0);
end
else
begin
Msg := 'Servicio No Iniciado Satisfactoriamente';
MessageDlg(Msg,mtError,[mbOK],0);
end
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Msg : String;
begin
if (ServiceStop(Machine, Service)) then
begin
Msg := 'Servicio Finalizado Satisfactoriamente';
MessageDlg(Msg,mtInformation,[mbOK],0);
end
else
begin
Msg := 'Servicio No Finalizado Satisfactoriamente';
MessageDlg(Msg,mtError,[mbOK],0);
end
end;
end.