Wie baut man sich einen Service ?

[turboPASCAL]

Hi,

ich versuche nun schon seit 2 (zwei) Tagen mir einen einfachen Dienst für Vista zu bauen.
Ich habe aber keinerlei Ahnung wie das im eigentklichem funktioniert. Zugegebener weise
ist es ja nun auch mein erster.

ich habe mir nun aus der MSDN volgendes zusammen gebastelt. Eigentlich schein es zu laufen
aber ich bekomme kein "Beep" und keinen Text im "Client"-Notepad.


Es währe furchtbar nett wenn jmd 'n paar tipps gibt oder einen Sampleservice der funktioniert.

Delphi-Quellcode:

program MyService;

{$R '_res\resource.res' '_res\resource.rc'}

uses
  Windows,
  Messages,
  WinSvc;

const
  ServiceName      = 'MyService';

  ID_TIMER         = 1001;
  TIMER_INERVAL    = 1000;

var
  DispatchTable    : array[0..1] of SERVICE_TABLE_ENTRYA;
  gSvcStatus       : SERVICE_STATUS;
  gSvcStatusHandle : SERVICE_STATUS_HANDLE;
  ghSvcStopEvent   : THANDLE;

procedure TimerProc(_hwnd: HWND; uMsg, idEvent: Integer; dwTime: DWORD); stdcall;
var
  fHandle: HWND;
  fText: String;
begin
  fText := 'Hello World! ' + chr(65 + random(26)) ;
  fHandle := FindWindow('notepad', nil);
  if fHandle > 0 then
  begin
    fHandle := FindWindowEx(fHandle, 0, 'edit', nil);
    if fHandle > 0 then
       sendmessage(fHandle, WM_SETTEXT, 0, integer(PCHAR(fText)));
  end;
end;

procedure SvcInstall();  stdcall;
var
  schSCManager: SC_HANDLE;
  schService: SC_HANDLE;
  szPath: array [0..MAX_PATH] of char;
  n: DWORD;
begin
    n := GetModuleFileName(0, szPath, MAX_PATH);
    if n <= 0 then
    begin
      //writeln('Cannot install service ',szPath, GetLastError());
      exit;
    end;

    // Get a handle to the SCM database.

    schSCManager := OpenSCManager(
        nil,                    // local computer
        nil,                    // ServicesActive database
        SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager = 0 then
    begin
      //writeln('OpenSCManager failed. ', GetLastError());
      exit;
    end;

    // Create the service

    schService := CreateService(
        schSCManager,              // SCM database 
        ServiceName,               // name of service
        ServiceName,               // service name to display
        SERVICE_ALL_ACCESS,        // desired access
        SERVICE_WIN32_OWN_PROCESS, // service type
        SERVICE_DEMAND_START,      // start type
        SERVICE_ERROR_NORMAL,      // error control type
        szPath,                    // path to service's binary
        nil,                       // no load ordering group
        nil,                       // no tag identifier
        nil,                       // no dependencies
        nil,                       // LocalSystem account
        nil);                      // no password
 
    if schService = 0 then
    begin
        //writeln('CreateService failed.', GetLastError());
        CloseServiceHandle(schSCManager);
        exit;
    end else
    begin
     // writeln('Service installed successfully.');
    end;

    CloseServiceHandle(schService);
    CloseServiceHandle(schSCManager);
end;

procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD); stdcall;
begin
   gSvcStatus.dwCheckPoint := 1;

    // Fill in the SERVICE_STATUS structure.

    gSvcStatus.dwCurrentState := dwCurrentState;
    gSvcStatus.dwWin32ExitCode := dwWin32ExitCode;
    gSvcStatus.dwWaitHint := dwWaitHint;

    if dwCurrentState = SERVICE_START_PENDING
      then gSvcStatus.dwControlsAccepted := 0
      else gSvcStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;

    if (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED)
      then gSvcStatus.dwCheckPoint := 0
      else gSvcStatus.dwCheckPoint := gSvcStatus.dwCheckPoint + 1;

    // Report the status of the service to the SCM.
    SetServiceStatus( gSvcStatusHandle, gSvcStatus );
end;

procedure SvcCtrlHandler(dwCtrl: DWORD); stdcall;
begin
   // Handle the requested control code.

   case dwCtrl of
      SERVICE_CONTROL_STOP:
        begin
           ReportSvcStatus(SERVICE_STOP_PENDING, NO_ERROR, 0);
           // Signal the service to stop.
           gSvcStatus.dwCurrentState := SERVICE_STOPPED;
         end;

      SERVICE_CONTROL_INTERROGATE:
        begin
         // Fall through to send current status.
        end;
   end;

   ReportSvcStatus(gSvcStatus.dwCurrentState, NO_ERROR, 0);
end;

procedure SvcInit();  stdcall;
begin
    // TO_DO: Declare and set any required variables.
    //   Be sure to periodically call ReportSvcStatus() with 
    //   SERVICE_START_PENDING. If initialization fails, call
    //   ReportSvcStatus with SERVICE_STOPPED.

    // Create an event. The control handler function, SvcCtrlHandler,
    // signals this event when it receives the stop control code.

    ghSvcStopEvent := CreateEvent(
                         nil,    // default security attributes
                         TRUE,    // manual reset event
                         FALSE,   // not signaled
                         nil);   // no name

    if ghSvcStopEvent = 0 then
    begin
      ReportSvcStatus( SERVICE_STOPPED, ERROR_INVALID_HANDLE , 0 );
      exit;
    end;

    // Report running status when initialization is complete.

    ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );

    // TO_DO: Perform work until service stops.

    SetTimer(0, ID_TIMER, TIMER_INERVAL, @TimerProc);

    while True do
    begin
      if gSvcStatus.dwCurrentState = SERVICE_RUNNING then
      begin
        beep(440,25);
        sleep(1000);
      end else
      begin
        // Check whether to stop the service.
        WaitForSingleObject(ghSvcStopEvent, INFINITE);

        ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 );
        break;
      end;
    end;

    KillTimer(0, ID_TIMER);
end;

procedure ServiceProc(dwArgc: DWORD; var lpszArgv: array of PChar); stdcall;
begin
  gSvcStatusHandle := RegisterServiceCtrlHandler(ServiceName, @SvcCtrlHandler);
  
  if gSvcStatusHandle  <= 0 then
  begin
    ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 );
    Exit;
  end;

  with gSvcStatus do
  begin
    dwServiceType             := SERVICE_WIN32_OWN_PROCESS;
    dwCurrentState            := SERVICE_START_PENDING;
    dwControlsAccepted        := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN;
    dwWin32ExitCode           := ERROR_SERVICE_SPECIFIC_ERROR;
    dwServiceSpecificExitCode := 0;
    dwCheckPoint              := 0;
    dwWaitHint                := 0;
  end;

  if not SetServiceStatus(gSvcStatusHandle, gSvcStatus) then
    Exit;

  gSvcStatus.dwCurrentState := SERVICE_RUNNING;
  gSvcStatus.dwWin32ExitCode := NO_ERROR;

  if not SetServiceStatus(gSvcStatusHandle, gSvcStatus) then
    Exit;

  SvcInit();
end;

BEGIN
  if ParamStr(1) = 'install' then
  begin
    svcInstall;
    exit;
  end;

  DispatchTable[0].lpServiceName := ServiceName;
  DispatchTable[0].lpServiceProc := @ServiceProc;

  DispatchTable[1].lpServiceName := nil;
  DispatchTable[1].lpServiceProc := nil;

  StartServiceCtrlDispatcher(DispatchTable[0]);
END.

[Bernhard Geyer]

Vista? Da bekommst du defaultmäßig keinen Zugriff auf den Client-Desktop. Erst nach umstellen irgendwelcher Registry-Einträge soll es wieder möglich sein das der Schalter "Interaktiver Dienst" wieder funktioniert.

[mkinzler]

Man sollte aber die saubere lösung über eine getrennte GUI-Anwendung gehen.

[turboPASCAL]

Vista, jupp.

Zitat von Bernhard Geyer:

Da bekommst du defaultmäßig keinen Zugriff auf den Client-Desktop. Erst nach umstellen irgendwelcher Registry-Einträge soll es wieder möglich sein das der Schalter "Interaktiver Dienst" wieder funktioniert.

Irgendwelcher Registry-Einträge ? Äh, ich habe nix um.- oder verstellt. (UAC ist aus)

Zitat von mkinzler:

Man sollte aber die saubere lösung über eine getrennte GUI-Anwendung gehen.

Was, wie wer?

Der Dienst soll eigetlich, wenn er dann mal funktioniert per SendMessage Informationen
an ein anderes (GUI-) Programm senden. Diese Daten holt er aus erner DLL.

[mkinzler]

Ja und das geht unter visat nicht mehr, da die services in einem anderen Kontext laufen. Du musst diese per Netzwerkprotokoll, pipe oder IPC austauschen.

[Bernhard Geyer]

Zitat von turboPASCAL:

Irgendwelcher Registry-Einträge ? Äh, ich habe nix um.- oder verstellt. (UAC ist aus)

Selber googlen. Ich weiss das es da Einschänkungen gibt aber kenn die Registry-Einträge nicht, da unsere Anwendung bei der Installation definitiv hier keine Änderungen vornimmt. Denn sobald du was am Rechner veränderst wird der Kunde für alle Probleme erst mal dir die Schuld geben.

[Luckie]

Zitat von mkinzler:

Ja und das geht unter visat nicht mehr, da die services in einem anderen Kontext laufen. Du musst diese per Netzwerkprotokoll, pipe oder IPC austauschen.

Das ist nicht das Problem, sondern dass sie in einer anderen WindowsSation laufen und somit auch einen eigenen Desktop haben.

[mkinzler]

Zitat von Luckie:

Zitat von mkinzler:

Ja und das geht unter visat nicht mehr, da die services in einem anderen Kontext laufen. Du musst diese per Netzwerkprotokoll, pipe oder IPC austauschen.

Das ist nicht das Problem, sondern dass sie in einer anderen WindowsSation laufen und somit auch einen eigenen Desktop haben.

Das meinte ich auch. Einen eigenen Benutzerkontext hatten sie auch schon immer.

[generic]

warum nimmst du eigendlich nicht die implementierung von delphi für einen dienst?
"projekt"->"service"

[turboPASCAL]

Weil Delphi 6 PE <--<< so etwas nicht hat. Ausser dem wird mir die Exec
dann (nach meiner Meinung als Minimalist) zu gross.