Windows Dienst und Client in einem Programm

[Jakson]

Mich hat es immer genervt das ich für meinen Windows Dienst ein zweites Programm benötige das diesen Konfiguriert und Installiert.

Glücklicher weise hab ich bei euch jetzt einen Code gefunden wie zwei Programme in einer Datei zusammengefügt werden können.

Der Code hat allerdings nur abgefragt ob der betreffende Dienst installiert ist und ob das Programm mit dem System Benutzer gestartet wurde.

Das war mir zu unsicher.

Ich durchsuche jetzt mit CreateToolhelp32Snapshot die laufenden Prozesse, Suche den Prozess des ServiceContollManager "Anwendung für Dienste und Controller" der immer unter "System32\services.exe" liegt und schau ob die Aktuelle Anwendung als ParentProcessID diesen Prozess eingetragen hat.

Hier meine Überprüfungsfunktion und eine Klasse zum Verwalten des Dienstes:

Delphi-Quellcode:

unit Un_ServiceTools;

interface

uses
  Windows, SysUtils, Classes, SvcMgr, WinSvc, TLHelp32, PsApi, StrUtils;

type
  TServiceToolAction = (saStart, saStop, saPause, saContinue);

  TServiceToolError  = (seNoError, seUnknownError,
                        seManagerAccesDenied, seManagerDbDoesNotExists, seManagerInvalidParameter,
                        seServiceNoAcces, seServiceAccesDenied, seServiceInvalidHandle, seServiceInvalidName, seServiceDoesNotExist, seServiceTimeout,
                        seServiceCannotAcceptCtrl, seServiceNotActive, seServiceRequestTimeout, seServiceAlreadyRunning, seServiceDatabaseLocked, seServiceDependencyDeleted, seServiceDependencyFail,
                        seServiceDisabled, seServiceLogonFailed, seServiceMarkedForDelete, seServiceNoThread, seServiceDependentServicesRunning, seServiceInvalidServiceControl, seServicePathNotFound);

  TServiceToolState  = (ssUnknown, ssStopped, ssStartPending, ssStopPending, ssRunning, ssContinuePending, ssPausePending, ssPaused);

  TServiceTools = class(TObject)
  private
   ManagerHandle,
   ServiceHandle   : THandle;
   LastServicaName : String;

   function    OpenManager: TServiceToolError;
   function    OpenService(const ServiceName: String): TServiceToolError;
   procedure   CloseService;
  protected
  public
   constructor Create;
   destructor  Destroy; override;

   procedure   CloseManager;
   function    GetServiceState(const ServiceName:String;OUT State:TServiceToolState): TServiceToolError;
   function    ControllService(const ServiceName:String;const Action:TServiceToolAction): TServiceToolError;
  end;// TServiceTools

  function  GetServiceErrorName(Error:TServiceToolError):String;
  function  CanConfigService(ServiceName:String):Boolean;

  procedure ServiceTools_Initialize;
  procedure ServiceTools_CreateForm(InstanceClass: TComponentClass; var Reference);
  procedure ServiceTools_Run;
  function  ServiceTools_StartAsService:Boolean;

implementation

function GetProcessImageFileName(hProcess: tHANDLE;lpImageFileName: LPTSTR;nSize: DWORD): DWORD; stdcall; external 'psapi.dll' name 'GetProcessImageFileName'+{$IFDEF UNICODE}'W'{$ELSE}'A'{$ENDIF};

function GetServiceErrorName(Error:TServiceToolError):String;
begin
 case Error of
  seNoError                         : Result := 'No Error';
  seManagerAccesDenied              : Result := 'Manager: Acces Denied';
  seManagerDbDoesNotExists          : Result := 'Manager: Database doesn''t exists';
  seManagerInvalidParameter         : Result := 'Manager: Invalid Parameter';
  seServiceNoAcces                  : Result := 'Service: The specified service control manager database handle does not have access to the service';
  seServiceAccesDenied              : Result := 'Service: The specified handle was not opened with the necessary access';
  seServiceInvalidHandle            : Result := 'Service: The specified handle is invalid';
  seServiceInvalidName              : Result := 'Service: The specified service name is invalid';
  seServiceDoesNotExist             : Result := 'Service: The specified service does not exist';
  seServiceTimeout                  : Result := 'Service: Getting Service State takes to long';
  seServiceCannotAcceptCtrl         : Result := 'Service: The requested control code cannot be sent to the service';
  seServiceNotActive                : Result := 'Service: The service has not been started';
  seServiceRequestTimeout           : Result := 'Service: The service did not respond to the start request in a timely fashion';
  seServiceAlreadyRunning           : Result := 'Service: An instance of the service is already running';
  seServiceDatabaseLocked           : Result := 'Service: The database is locked';
  seServiceDependencyDeleted        : Result := 'Service: The service depends on a service that does not exist or has been marked for deletion';
  seServiceDependencyFail           : Result := 'Service: The service depends on another service that has failed to start';
  seServiceDisabled                 : Result := 'Service: The service has been disabled';
  seServiceLogonFailed              : Result := 'Service: The service could not be logged on';
  seServiceMarkedForDelete          : Result := 'Service: The service has been marked for deletion';
  seServiceNoThread                 : Result := 'Service: A thread could not be created for the Win32 service';
  seServiceDependentServicesRunning : Result := 'Service: The service cannot be stopped because other running services are dependent on it';
  seServiceInvalidServiceControl    : Result := 'Service: The requested control code is not valid, or it is unacceptable to the service';
  seServicePathNotFound             : Result := 'Service: The service binary file could not be found';
  else                                Result := 'Unknown Error';
 end;// case Error
end;

function CanConfigService(ServiceName:String): Boolean;
var ServiceControl : TServiceTools;
    ServiceState   : TServiceToolState;
    ServiceError   : TServiceToolError;
begin
 Result := False;
 ServiceControl := TServiceTools.Create;
 try
  ServiceError  := ServiceControl.GetServiceState(ServiceName,ServiceState);
  Result        := NOT (ServiceError in [seUnknownError,seManagerAccesDenied,seManagerDbDoesNotExists,seManagerInvalidParameter]);
 finally
  ServiceControl.Free;
 end;
end;

procedure ServiceTools_Initialize;
begin
 Application.Initialize;
end;

procedure ServiceTools_CreateForm(InstanceClass: TComponentClass; var Reference);
begin
 Application.CreateForm(InstanceClass, Reference);
end;

procedure ServiceTools_Run;
begin
 Application.Run;
end;

function ServiceTools_StartAsService:Boolean;
{+------------------------------------------------------------------------------}
{|} function DevicePathToWin32Path(Path:String):String;
{|} var Drive : Char;
{|}     Text  : String;
{|}     Count : Integer;
{|} begin
{|}  Count := PosEx('\', Path, 2);
{|}  Count := PosEx('\', Path, Count+1);
{|}
{|}  Result := Copy(Path, Count, Length(Path));
{|}  Delete(Path, Count, Length(Path));
{|}  for Drive := 'A' to 'Z' do
{|}   begin
{|}    SetLength(Text, 1000);
{|}    if QueryDosDevice(PChar(String(Drive)+':'), PChar(Text), Length(Text)) <> 0 then
{|}     begin
{|}      Text := PChar(Text);
{|}      if SameText(Path, Text) then
{|}       begin
{|}        Result := Drive+':'+Result;
{|}        Exit;
{|}       end;
{|}     end;
{|}   end;
{|}  Result := '';
{|} end;
{+------------------------------------------------------------------------------}
var LocalPrId,
    ServicePrId    : DWord;
    SnapshotHandle,
    ProcessHandle  : THandle;
    ProcessEntry32 : TProcessEntry32;
    FileName       : String;
begin
 Result := False;

 // 'INSTALL' oder 'UNINSTALL' im aufruf parameter => Sofort als Dienst weitermachen
 if FindCmdLineSwitch('INSTALL') OR FindCmdLineSwitch('UNINSTALL') then
  Exit(True);

 // Alle Prozesse durchgehen
 LocalPrId             := GetCurrentProcessId;
 ServicePrId           := 0;
 SnapshotHandle        := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 ProcessEntry32.dwSize := SizeOf(ProcessEntry32);
 try
  if Process32First(SnapshotHandle, ProcessEntry32) then
   repeat
    FileName := '';
    ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION OR PROCESS_VM_READ, False, ProcessEntry32.th32ProcessID);
    try
     if ProcessHandle <> 0 then
      begin
       SetLength(FileName, MAX_PATH);
       if GetProcessImageFileName(ProcessHandle,PChar(FileName), MAX_PATH) <> 0
       then FileName := DevicePathToWin32Path(StrPas(PChar(FileName)))
       else FileName := '';
      end;
    finally
     CloseHandle(ProcessHandle);
    end;

    // Wenn der Service Controller gefunden wurde PrId Merken
    if ContainsText(FileName,'System32\services.exe') then
     ServicePrId := ProcessEntry32.th32ProcessID;

    // Aktuellen Prozess gefunden => Überprüfen ob der Service Controller gefunden wurde und dieser als Parent eingetragen ist
    if (ProcessEntry32.th32ProcessID = LocalPrId) then
     Exit((ServicePrId <> 0) AND (ServicePrId = ProcessEntry32.th32ParentProcessID));
   until NOT Process32Next(SnapshotHandle, ProcessEntry32);
 finally
  CloseHandle(SnapshotHandle);
 end;
end;

{ TServiceTools }

constructor TServiceTools.Create;
begin
 inherited Create;
 Self.LastServicaName := '';
 Self.ManagerHandle   := 0;
 Self.ServiceHandle   := 0;
end;

destructor TServiceTools.Destroy;
begin
 CloseService;
 CloseManager;
 inherited Destroy;
end;

function TServiceTools.OpenManager: TServiceToolError;
begin
 if ManagerHandle <> 0 then
  Exit(seNoError); // Bereits geöffnet

 ManagerHandle := WinSvc.OpenScManager(nil, nil, GENERIC_READ or GENERIC_EXECUTE);
 if ManagerHandle <> 0
  then begin
   Result := seNoError;
  end
  else begin
   case GetLastError of
    ERROR_ACCESS_DENIED           : Result := seManagerAccesDenied;
    ERROR_DATABASE_DOES_NOT_EXIST : Result := seManagerDbDoesNotExists;
    ERROR_INVALID_PARAMETER       : Result := seManagerInvalidParameter;
    else                            Result := seUnknownError;
   end;// case
  end;
end;

procedure TServiceTools.CloseManager;
begin
 CloseService;

 if ManagerHandle <> 0 then
  begin
   CloseServiceHandle(ManagerHandle);
   ManagerHandle := 0;
  end;
end;

function TServiceTools.OpenService(const ServiceName: String): TServiceToolError;
begin
 Result := OpenManager;
 if Result = seNoError then
  begin
   if ServiceHandle <> 0 then
    begin // ServiceHandle ist geöffnet
     if SameText(ServiceName,LastServicaName) // Service Name unterscheidet sich vom letzten aufruf =>
      then Exit(seNoError) // Bereits geöffnet
      else CloseService;   // Schließen
    end;

   LastServicaName := '';
   ServiceHandle   := WinSvc.OpenService(ManagerHandle, PChar(ServiceName), SERVICE_ALL_ACCESS);
   if ServiceHandle <> 0
    then begin
     Result          := seNoError;
     LastServicaName := ServiceName;
    end
    else begin
     case GetLastError of
      ERROR_ACCESS_DENIED          : Result := seServiceNoAcces;
      ERROR_INVALID_HANDLE         : Result := seServiceInvalidHandle;
      ERROR_INVALID_NAME           : Result := seServiceInvalidName;
      ERROR_SERVICE_DOES_NOT_EXIST : Result := seServiceDoesNotExist;
      else                           Result := seUnknownError;
     end;// case
    end;
  end;
end;

procedure TServiceTools.CloseService;
begin
 if ServiceHandle <> 0 then
  begin
   CloseServiceHandle(ServiceHandle);
   ServiceHandle := 0;
  end;
end;

function TServiceTools.GetServiceState(const ServiceName: String; out State: TServiceToolState): TServiceToolError;
var ServiceStatus : TServiceStatus;
begin
 Result := OpenManager;
 if Result = seNoError then
  begin
   Result := OpenService(ServiceName);
   if Result = seNoError then
    begin
     if WinSvc.QueryServiceStatus(ServiceHandle, ServiceStatus)
      then begin
       Result := seNoError;
       case ServiceStatus.dwCurrentState of
        SERVICE_STOPPED          : State := ssStopped;
        SERVICE_START_PENDING    : State := ssStartPending;
        SERVICE_STOP_PENDING     : State := ssStopPending;
        SERVICE_RUNNING          : State := ssRunning;
        SERVICE_CONTINUE_PENDING : State := ssContinuePending;
        SERVICE_PAUSE_PENDING    : State := ssPausePending;
        SERVICE_PAUSED           : State := ssPaused;
        else                       State := ssUnknown;
       end;// case
      end
      else begin
       case GetLastError of
        ERROR_ACCESS_DENIED          : Result := seServiceAccesDenied;
        ERROR_INVALID_HANDLE         : Result := seServiceInvalidHandle;
        else                           Result := seUnknownError;
       end;// case
      end;
    end; // Service Opend
  end;// Manager Opend
end;

function TServiceTools.ControllService(const ServiceName: String; const Action: TServiceToolAction): TServiceToolError;
const WaitFor : array [TServiceToolAction] of DWORD = (SERVICE_RUNNING, SERVICE_STOPPED, SERVICE_PAUSED, SERVICE_RUNNING);
var Args          : PChar;
    ServiceStatus : TServiceStatus;
    ActionResult  : Boolean;
    Timeout       : Byte;
begin
 Result := OpenManager;
 if Result = seNoError then
  begin
   Result := OpenService(ServiceName);
   if Result = seNoError then
    begin
     case Action of
      saStart    : ActionResult := WinSvc.StartService(ServiceHandle, 0, Args);
      saStop     : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_STOP    , ServiceStatus);
      saPause    : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_PAUSE   , ServiceStatus);
      saContinue : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_CONTINUE, ServiceStatus);
      else         ActionResult := False;
     end;//case

     if ActionResult
      then begin
       Result := seNoError;

       Timeout := 0;
       while (Timeout < 10) AND QueryServiceStatus(ServiceHandle,ServiceStatus) AND (WaitFor[Action] <> ServiceStatus.dwCurrentState) do
        begin
         Sleep(1000); // 1 sec warten
         Inc(Timeout);
        end;

       if Timeout >= 10 then
        Exit(seServiceTimeout);

       QueryServiceStatus(ServiceHandle,ServiceStatus);
       case Action of
        saStart : if ServiceStatus.dwCurrentState <> SERVICE_RUNNING then
                   Exit(seUnknownError);
        saStop  : if ServiceStatus.dwCurrentState <> SERVICE_STOPPED then
                   Exit(seUnknownError);
       end;
      end
      else begin
       case GetLastError of
        ERROR_ACCESS_DENIED              : Result := seServiceAccesDenied;
        ERROR_SERVICE_CANNOT_ACCEPT_CTRL : Result := seServiceCannotAcceptCtrl;
        ERROR_SERVICE_NOT_ACTIVE         : Result := seServiceNotActive;
        ERROR_SERVICE_REQUEST_TIMEOUT    : Result := seServiceRequestTimeout;
        ERROR_SERVICE_ALREADY_RUNNING    : Result := seServiceAlreadyRunning;
        ERROR_SERVICE_DATABASE_LOCKED    : Result := seServiceDatabaseLocked;
        ERROR_SERVICE_DEPENDENCY_DELETED : Result := seServiceDependencyDeleted;
        ERROR_SERVICE_DEPENDENCY_FAIL      : Result := seServiceDependencyFail;
        ERROR_SERVICE_DISABLED           : Result := seServiceDisabled;
        ERROR_SERVICE_LOGON_FAILED       : Result := seServiceLogonFailed;
        ERROR_SERVICE_MARKED_FOR_DELETE  : Result := seServiceMarkedForDelete;
        ERROR_SERVICE_NO_THREAD          : Result := seServiceNoThread;
        ERROR_DEPENDENT_SERVICES_RUNNING : Result := seServiceDependentServicesRunning;
        ERROR_INVALID_SERVICE_CONTROL    : Result := seServiceInvalidServiceControl;
        ERROR_INVALID_HANDLE             : Result := seServiceInvalidHandle;
        ERROR_PATH_NOT_FOUND             : Result := seServiceAccesDenied;
        else                               Result := seServicePathNotFound;
       end;// case GetLastError
      end;
    end; // Service Opend
  end;// Manager Opend
end;

end.

Meine DPR Datei schaut dann ca. so aus:

Delphi-Quellcode:

program ServiceStart;

uses
  Forms,
  Un_ServiceTools,
  U_ClientMain in 'U_ClientMain.pas' {F_ClientMain: TForm},
  U_ServiceMain in 'U_ServiceMain.pas' {F_ServiceStart: TService};

{$R *.res}

{$DEFINE OwnStartup}

begin
{$IF DEFINED(OwnStartup)}
 if ServiceTools_StartAsService 
  then begin // Als Service Starten
   ServiceTools_Initialize;
   ServiceTools_CreateForm(TF_ServiceStart, F_ServiceStart);
   ServiceTools_Run;
  end
  else begin // Als Client Starten
   Application.Initialize;
   Application.MainFormOnTaskbar := True;
   Application.Title := 'Service Config';
   Application.CreateForm(TF_ClientMain, F_ClientMain);
   Application.Run;
  end;
{$ELSE}
 Application.Initialize;
 Application.MainFormOnTaskbar := True;
 Application.Title := 'Service Default';
 Application.Run;
{$IFEND}
end.

Der Grund warum ein eigenes ServiceTools_Initialize usw. gibt ist das einmal die Application Variable aus Forms:TApplication und einmal aus SvcMgr:TServiceApplication verwendet wird.

Aja das {$IF DEFINED} verwende ich damit die IDE mir nicht immer die DPR Datei umschreibt.

Ich hoffe der Code ist verständlich und für andere nützlich.