this slowpoke moves

Start Stop Services

uses WinSvc

const
  bit29 = 1 SHL 28;
  NERR_Success = 0;
  NERR_BASE = 2100;
  NERR_NameNotFound = NERR_BASE + 173;
  NERR_NetworkError = NERR_BASE + 36;
  ERROR_FAILED_STARTING_SERVICE = 1 or bit29;
  ERROR_FAILED_STOPPING_SERVICE = 2 or bit29;
  
//

function GetComputerName: String;
var Len: DWORD;
begin
  Len:=MAX_COMPUTERNAME_LENGTH+1;  SetLength(Result,Len);
  if Windows.GetComputerName(PChar(Result), Len) then
    SetLength(Result,Len)  else    RaiseLastOSError;
end;

function ServiceGetStatus(sMachine, sService: PChar): DWORD;
var
  SCManHandle, SvcHandle: SC_Handle;
  SS: TServiceStatus;
  dwStat: DWORD;
begin
  dwStat := 0;
  // Open service manager handle.
  SCManHandle := OpenSCManager(sMachine, nil, SC_MANAGER_CONNECT);
  if (SCManHandle > 0) then
  begin 
    SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS); 
    // if Service installed
    if (SvcHandle > 0) then 
    begin 
      // SS structure holds the service status (TServiceStatus); 
      if (QueryServiceStatus(SvcHandle, SS)) then
        dwStat := ss.dwCurrentState; 
      CloseServiceHandle(SvcHandle); 
    end; 
    CloseServiceHandle(SCManHandle);
  end; 
  Result := dwStat; 
end; 

function ServiceRunning(sMachine, sService: PChar): Boolean; 
begin 
  Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService); 
end;

function ServiceStart(Machine, ServiceName: string): Boolean; 
// Machine is UNC path or local machine if empty 
var 
  h_manager, h_svc: SC_Handle;
  ServiceStatus: TServiceStatus; 
  dwCheckPoint: DWORD; 
  ServiceArgVectors: PChar;
begin
  h_manager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then
  begin 
    h_svc := OpenService(h_manager, PChar(ServiceName), 
      SERVICE_START or SERVICE_QUERY_STATUS or SC_MANAGER_ALL_ACCESS); 
    if h_svc > 0 then 
    begin 
      if (StartService(h_svc, 0, ServiceArgVectors)) then { succeeded }
      begin 
        if (QueryServiceStatus(h_svc, ServiceStatus)) then 
        begin 
          while (SERVICE_RUNNING <> ServiceStatus.dwCurrentState) do 
          begin 
            dwCheckPoint := ServiceStatus.dwCheckPoint;
            Sleep(ServiceStatus.dwWaitHint); 
            if (not QueryServiceStatus(h_svc, ServiceStatus)) then 
              // couldnt check status 
              break; 
            if (ServiceStatus.dwCheckPoint < dwCheckPoint) then 
              break;
          end; 
        end; 
      end; 
      CloseServiceHandle(h_svc); 
    end; 
    CloseServiceHandle(h_manager);
  end;

  Result := (SERVICE_RUNNING = ServiceStatus.dwCurrentState);
end;

function ServiceStop(Machine, ServiceName: string): Boolean; 
var  h_manager, h_svc: SC_Handle;
     ServiceStatus: TServiceStatus;
     dwCheckPoint: DWORD;
begin
  h_manager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then  begin
    h_svc := OpenService(h_manager, PChar(ServiceName),
      SERVICE_STOP or SERVICE_QUERY_STATUS);
    if h_svc > 0 then
    begin
      if (ControlService(h_svc, SERVICE_CONTROL_STOP, ServiceStatus)) then
      begin
        if (QueryServiceStatus(h_svc, ServiceStatus)) then
        begin
          while (SERVICE_STOPPED <> ServiceStatus.dwCurrentState) do
          begin
            dwCheckPoint := ServiceStatus.dwCheckPoint;
            Sleep(ServiceStatus.dwWaitHint);
            if (not QueryServiceStatus(h_svc, ServiceStatus)) then
              // couldnt check status
              break;
            if (ServiceStatus.dwCheckPoint < dwCheckPoint) then
              break;
          end;
        end;
      end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;
  Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState);
end;
Beispiele :
procedure TForm1.Button1Click(Sender: TObject);
begin
   ServiceStop(GetComputerName, edit1.text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ServiceStart(GetComputerName, edit1.text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  label1.Caption := GetComputerName;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate