Delphi and Kylix

Moderators: pritaeas
Number of threads: 7264
Number of posts: 19073

This Forum Only
Post New Thread
Single Post View       Linear View       Threaded View      f

Report
Stopping and starting services in delphi code. Posted by PvtGomerPyle on 2 Jan 2004 at 11:10 PM
How do i stop and start services in XP using delphi code, thankyou.

Pyle
Report
Re: Stopping and starting services in delphi code. Posted by zibadian on 3 Jan 2004 at 12:45 AM
: How do i stop and start services in XP using delphi code, thankyou.
:
: Pyle
:
Look into the CreateService()/OpenService() and the CloseServiceHandle()/DeleteService() API calls in the windows SDK help files.
Report
Re: Stopping and starting services: a component Posted by Masterijn on 4 Jan 2004 at 12:25 PM
: How do i stop and start services in XP using delphi code, thankyou.
:
: Pyle
:
Hi,
Once wrote a component for that, it can also start/stop services on a different machine. It's very basic, but it does the trick.
unit ServiceStarter;

interface

uses
  WinSvc, Windows, Messages, SysUtils, Classes;

type
  TServiceState = (svsStopped, svsStarting, svsStopping, svsRunning, scvContinueing, svsPausing, svsPaused);

  TServiceStarter = class(TComponent)
  private
    FSCHandle: THandle;
    FState: TServiceState;
    FServiceName: string;
    FHandle: THandle;
    FMachineName: string;
    FActive: Boolean;
    procedure SetState(const Value: TServiceState);
    function GetState: TServiceState;
    procedure SetServiceName(const Value: string);
    procedure SetMachineName(const Value: string);
    function GetHandle: THandle;
    procedure SetActive(const Value: Boolean);
    procedure CloseDependendServices(Handle: THandle);
    { Private declarations }
  protected
    { Protected declarations }
    procedure CloseHandle;
    procedure CloseHandleSC;
    procedure HandleNeeded;
  public
    { Public declarations }
    destructor Destroy; override;
    property Handle: THandle read GetHandle;
  published
    { Published declarations }
    property ServiceName: string read FServiceName write SetServiceName;
    property MachineName: string read FMachineName write SetMachineName;
    property State: TServiceState read GetState write SetState;
    property Active: Boolean read FActive write SetActive;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('AppGadgets', [TServiceStarter]);
end;

{ TServiceStarter }


procedure TServiceStarter.CloseHandle;
begin
  if FHandle <> 0 then
    begin
    CloseServiceHandle(FHandle);
    FHandle := 0;
    end;
end;

procedure TServiceStarter.CloseHandleSC;
begin
  if FSCHandle <> 0 then
    begin
    CloseServiceHandle(FSCHandle);
    FSCHandle := 0;
    end;
end;

destructor TServiceStarter.Destroy;
begin
  CloseHandle;
  inherited;
end;

function TServiceStarter.GetHandle: THandle;
begin
  HandleNeeded;
  Result := FHandle;
end;

function TServiceStarter.GetState: TServiceState;
var
  ServiceStatus: TServiceStatus;
begin
  if FActive then
    begin
    if (FServiceName = '') then
      begin
      Result := svsStopped;
      Exit;
      end;
    HandleNeeded;
    if not QueryServiceStatus(FHandle, ServiceStatus) then
      RaiseLastOSError;
    Result := TServiceState(ServiceStatus.dwCurrentState - 1);
    end
  else
    Result := FState;
end;

procedure TServiceStarter.HandleNeeded;
begin
  if FHandle = 0 then
    begin
    if FSCHandle = 0 then
      begin
      FSCHandle := OpenSCManager(Pointer(FMachineName), nil, GENERIC_EXECUTE);
      if FSCHandle = 0 then
        RaiseLastOSError;
      end;
    FHandle := OpenService(FSCHandle, PChar(FServiceName), GENERIC_EXECUTE+SERVICE_QUERY_STATUS+SERVICE_ENUMERATE_DEPENDENTS);
    if FHandle = 0 then
      RaiseLastOSError;
    end;
end;


procedure TServiceStarter.SetActive(const Value: Boolean);
begin
  if FActive = Value then
    Exit;

  FActive := Value;
  if FActive then
    State := FState
  else
    begin
    CloseHandle;
    CloseHandleSC;
    end;
end;

procedure TServiceStarter.SetMachineName(const Value: string);
begin
  if FMachineName = Value then
    Exit;

  CloseHandle;

  FMachineName := Value;
end;

procedure TServiceStarter.SetServiceName(const Value: string);
begin
  if FServiceName = Value then
    Exit;

  CloseHandle;
  CloseHandleSC;

  FServiceName := Value;
end;

procedure TServiceStarter.CloseDependendServices(Handle: THandle);
type
  TEnumServiceStatusArray = array[0..$FFFF] of TEnumServiceStatus;
  PEnumServiceStatusArray = ^TEnumServiceStatusArray;
var
  Ok: boolean;
  DependendHandle: THandle;
  I: Integer;
  ServicesCount: Cardinal;
  NeededBytes: Cardinal;
  DependendServices : PEnumServiceStatusArray;
  ServiceStatus: TServiceStatus;
begin
  NeededBytes := 1 * SizeOf(TEnumServiceStatusArray);
  Ok := True;
  GetMem(DependendServices, NeededBytes);
  while not EnumDependentServices(Handle, SERVICE_ACTIVE, DependendServices^[0], NeededBytes, NeededBytes, ServicesCount) do
    begin
    if GetLastError = ERROR_MORE_DATA then
      begin
      FreeMem(DependendServices);
      Ok:= False;
      GetMem(DependendServices, NeededBytes);
      end
    else
      RaiseLastOSError;
    end;
  for I := 0 to ServicesCount - 1 do
    with DependendServices^[I] do
      begin
      DependendHandle := OpenService(FSCHandle, lpServiceName, GENERIC_EXECUTE+SERVICE_QUERY_STATUS+SERVICE_ENUMERATE_DEPENDENTS);
      while not ControlService(DependendHandle, SERVICE_CONTROL_STOP, ServiceStatus) do
        case GetLastError of
          ERROR_DEPENDENT_SERVICES_RUNNING:
            CloseDependendServices(DependendHandle);
          ERROR_SERVICE_NOT_ACTIVE:
            Break;
          ERROR_SERVICE_CANNOT_ACCEPT_CTRL: ;
          else
            RaiseLastOSError;
          end;
      CloseServiceHandle(DependendHandle);
      end;
  FreeMem(DependendServices);
end;

procedure TServiceStarter.SetState(const Value: TServiceState);
const
{
SERVICE_CONTROL_STOP
Requests the service to stop. The hService handle must have SERVICE_STOP access.
SERVICE_CONTROL_PAUSE
Requests the service to pause. The hService handle must have SERVICE_PAUSE_CONTINUE access.
SERVICE_CONTROL_CONTINUE
Requests the paused service to resume. The hService handle must have SERVICE_PAUSE_CONTINUE access.
SERVICE_CONTROL_INTERROGATE
Requests the service to update immediately its current status information to the service control manager. The hService handle must have SERVICE_INTERROGATE access.
SERVICE_CONTROL_SHUTDOWN
}
  StateControlMap: array[TServiceState] of Integer = (SERVICE_CONTROL_STOP, SERVICE_CONTROL_CONTINUE, SERVICE_CONTROL_STOP, SERVICE_CONTROL_CONTINUE, SERVICE_CONTROL_CONTINUE, SERVICE_CONTROL_PAUSE, SERVICE_CONTROL_PAUSE);
var
  Error: Cardinal;
  StateSet: boolean;
  Arg: PChar;
  ServiceStatus: TServiceStatus;
begin
  FState := Value;
  if Active then
    begin
    HandleNeeded;
    Arg := nil;
    StateSet := False;
    // svsStopped, svsStarting, svsStopping, svsRunning, scvContinueing, svsPausing, svsPaused
    repeat
      if not ControlService(FHandle, StateControlMap[Value], ServiceStatus) then
        begin
        Error := GetLastError;
        case Error of
          ERROR_SERVICE_CANNOT_ACCEPT_CTRL:
            begin
            Sleep(10);
            end;
          ERROR_SERVICE_NOT_ACTIVE:
            if not (Value in [svsStopped, svsStopping]) then
              begin
              if not StartService(FHandle, 0, Arg) then
                begin
                Error := GetLastError;
                if Error <> ERROR_SERVICE_CANNOT_ACCEPT_CTRL then
                  RaiseLastOSError
                else
                  Sleep(10);
                end;
              StateSet := Value in [svsRunning, scvContinueing];
              end
            else
              StateSet := True;
          ERROR_DEPENDENT_SERVICES_RUNNING:
            CloseDependendServices(FHandle);
          else
            RaiseLastOSError;
          end;
        end
      else
        StateSet := True;
    until StateSet;
  end;
end;

end.

Report
Re: Stopping and starting services: a component Posted by Kuri_YJ on 28 Sept 2012 at 12:05 AM
Thankyou for code sharing :)



 

Recent Jobs

Official Programmer's Heaven Blogs
Web Hosting | Browser and Social Games | Gadgets

Popular resources on Programmersheaven.com
Assembly | Basic | C | C# | C++ | Delphi | Flash | Java | JavaScript | Pascal | Perl | PHP | Python | Ruby | Visual Basic
© Copyright 2011 Programmersheaven.com - All rights reserved.
Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
Operated by CommunityHeaven, a BootstrapLabs company.