TService - Hilfe! Tut sich nix....

[Killi138]

Hi!

Habe jetzt in Delphi6 ne ServiceApplication gemacht - will damit eigentlich erreichen, dass ein Programm als Service gestartet wird (vor der Win-Anmeldung) - deshalb hab ich in die Prozedur Execute folgendes gschrieben:

Code:

procedure TService1.ServiceExecute(Sender: TService); 
begin 
        ShellExecute(hwnd(self), 'open', 'C:\test.exe', nil, nil, SW_SHOW); 
end;

und mit Start/Ausführen/Pfad der ServiceAppl. -install habe ich es anscheinend korrekt installiert - nur passiert nach dem Neustart NICHTS!
Was fehlt, was muss ich reinpacken, mit der Suche komm ich auch nicht weiter...!

[sakura]

Schreibe mal in das OnStart Ereignis folgende Zeile. Dann wirst Du sehen, ob der Service korrekt funktioniert.

Delphi-Quellcode:

MessageBox(0, 'Der Service staretet', 'Info', 
    MB_OK + MB_TOPMOST + MB_SERVICE_NOTIFICATION);

Die MessageBox sollte auch bei einem normalen Start auftauchen und sogar im Ereignis-Protokoll vermekrt sein

......

P.S.: Ändere bitte den Titel, die Großbuchstaben müssen nicht sein. Sehr aussagekräftig ist dieser zumal auch nicht

[Killi138]

TUt nicht, beendet sich sofort wieder.....was soll ich machen?

[sakura]

Gib mal ein paar mehr Aussagen. Was genau versuchst Du zu tun, was beendet sich sofort wieder. Wir helfen hier alle gerne, aber ein Rätselraten wollen wir nicht draus machen

Ein paar mehr Zeilen Source-Code schaden auch nicht.

......

[Killi138]

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, uNTServiceControl, ShellAPI;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
MessageBox(0, 'Der Service staretet', 'Info', 
    MB_OK + MB_TOPMOST + MB_SERVICE_NOTIFICATION);
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
        ShellExecute(hwnd(self), 'open', 'C:\test.exe', nil, nil, SW_SHOW);
end;

end.

versuche dann mit Start/Ausführen das Programm mit -install zu installieren - klappt auch wunderbar, bloß passiert nix!
Will einen Service machen, der ein externes Progrtamm startet....hab schon alles mögliche probiert, kein Plan was ich machen muss

[sakura]

Die Anwendung, denke ich mal, wird gestartet, allerdings geht der Service sofort weiter. Dadurch kommt der zum Ende der Execute-Methode und wird wieder beendet. Da Test.exe mit dem Service assosziert ist, wird die auch beendet. Schau mal in die Code-Library, da ist von Luckie ein Beitrag zum Starten von Anwendungen ohne ShellExecute. Die hat den Parameter Wait (als Boolean). Dann wartet der Service, bis die Test.exe fertig ist und beendet sich erst dann.

......

[Killi138]

Die Antwort klang schon sehr vielversprechend, aber klappt auch nicht - hier mal der Code:

Code:

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
var 
  ProcID: PCardinal;
begin
MessageBox(0, 'Der Service started', 'Info',
    MB_OK + MB_TOPMOST + MB_SERVICE_NOTIFICATION);
    
    RunProcess('C:\Test.exe', SW_MINIMIZE, TRUE, ProcID);
end;

function TService1.RunProcess(FileName: string; ShowCmd: DWORD; wait: Boolean; ProcID: PCardinal): Longword;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation; 
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), #0); 
  StartupInfo.cb          := SizeOf(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK; 
  StartupInfo.wShowWindow := ShowCmd;
  if not CreateProcess(nil, 
    @Filename[1],
    nil, 
    nil,
    False, 
    CREATE_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS, 
    nil,
    nil,
    StartupInfo, 
    ProcessInfo)
    then
      Result := WAIT_FAILED
  else 
  begin
    if wait = FALSE then
    begin
      if ProcID <> nil then ProcID^ := ProcessInfo.dwProcessId; 
      exit;
    end;
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE); 
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  end;
  if ProcessInfo.hProcess <> 0 then
    CloseHandle(ProcessInfo.hProcess);
  if ProcessInfo.hThread <> 0 then 
    CloseHandle(ProcessInfo.hThread);
end;

Muss ich sonst noch was beachten? Vielleicht hab ich ja beim Einrichten was vergessen....hab sowas noch nie gemacht (Services)

[Killi138]

Habe jetzt die MsgBox HINTER dem auszuführenden Programm gesetzt - die MsgBox kommt, aber vom Prog ist nix zu sehen! Meine WAIT-Variable ist doch auf TRUE gesetzt - warum tuts nicht???

[Killi138]

SEHR KOMISCH....in den Prozessen meines TaskManagers sehe ich meine Service.exe und meine test.exe!!! Sie wird also aufgerufen!!!!!!!!!
Das Problem ist: ICH SEH SIE LEIDER NICHT....warum, wieso, weshalb? Bin kurz davor den sch...zu schaffen und jetzt seh ich sie nicht!?
Bitte helft mir....

[Motzi]

Wenn ein bisschen im Forum hier gesucht hättest hättest du die Antwort wahrscheinlich schon gefunden...!

Services laufen auf einer anderen WindowStation, WindowHandles sind immer nur innerhalb ihrer WindowStation gültig - dh die Fenster deines Services werden so niemals auf der Standard-WindowStation WinSta0 auftauchen!

2 Möglichkeiten:
1) den Service als interaktiven Service einstellen (damit wird er WinSta0 zugeordnet)
2) zur Laufzeit die WindowStation deines Services ändern

Beide Möglichkeiten machen deinen Service jedoch anfällig auf Shatter-Attacken!!