Autor Beitrag
Tana´Ri
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 230



BeitragVerfasst: Fr 13.02.04 14:22 
Hi Leute,

vorab: Ich habe mal ein kl. Programm geschrieben das Files in Zeitintervalen sichert, bestehend aus 2 Forms und einem Thread. Wobei das 2te Form und der Thread im MainFrom erzeugt werden. Nun da ich über Services gestolpert bin, dachte ich mir dies Programm als Service zu registrieren, es funktioniert solange das WaitHint nicht eintrifft, der Prozess wird gestoppt (doch warum?)!

Project-Code
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
  Application.Initialize;
  Application.Title := 'TCI Service';
  Application.CreateForm(TBAKService, BAKService);
  Application.CreateForm(TForm1,Form1);
  Application.Run;

Ich hatte auch andere Varianten getestet, doch immer das gleiche Resultat
andere:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
  Application.Initialize;
  Application.Title := 'TCI Service';
  Application.CreateForm(TBAKService, BAKService);
  BAKService.ServiceStart(BAKServce);
  BAKService.ServiceExecute(BAKService);
  // Application.Run wurde in den BAKService.Execute verschoben
  BAKService.ServiceDestroy(BAKService);


ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr,   Dialogs, WinSvc;

type
  TBAKService = class(TService)
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
  private
  public
    hWndProc  : THandle;
    hSCM      : THandle;
    hService  : THandle;
    function  GetServiceController: TServiceController; override;
    procedure WndProc(var Message: TMessage);
  end;

type
  TThreadTool = class (TThread)
   private
   public
    procedure InitialForm;
    procedure TerminateForm;
    procedure Execute; override;
  end;

var

   BAKService: TBAKService;
   ThreadTool: TThreadTool = NIL;

implementation

uses Frm_Main;

{$R *.DFM}


procedure TThreadTool.Execute;
 begin
  Synchronize(InitialForm);
  try
   repeat
    sleep(10);                              
   until Terminated;
  finally
   if assigned(Form1) then Synchronize(TerminateForm);
  end;
end;

procedure TThreadTool.InitialForm;
 begin
  Form1 := TForm1.Create(NIL);
  Form1.Show;
end;

procedure TThreadTool.TerminateForm;
 begin
  Form1.Free;
  Form1 := NIL;
end;

procedure TBAKService.WndProc(var Message: TMessage);
 begin
  if assigned(Form1) then postmessage(Form1.Handle, Message.Msg, Message.WParam, Message.LParam);
end;

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

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

procedure TBAKService.ServicePause(Sender: TService; var Paused: Boolean);
 begin
  ThreadTool.Suspend;
  Paused := True;
end;

procedure TBAKService.ServiceStart(Sender: TService; var Started: Boolean);
 begin
  ThreadTool.Resume;
  Started := True;
end;

procedure TBAKService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
 begin
  if ThreadTool.Suspended then ThreadTool.Resume;
  Continued := True;
end;

procedure TBAKService.ServiceStop(Sender: TService; var Stopped: Boolean);
 begin
  ThreadTool.Suspend;
  Stopped := True;
end;

procedure TBAKService.ServiceCreate(Sender: TObject);
 begin
  hWndProc := AllocateHWnd(WndProc);
  ThreadTool := TThreadTool.Create(TRUE);
end;

procedure TBAKService.ServiceDestroy(Sender: TObject);
 begin
  if assigned(ThreadTool) then
   begin
    ThreadTool.Terminate;
    ThreadTool.WaitFor;
    ThreadTool.Free;
  end;
  DeAllocateHWnd(hWndProc);
end;

procedure TBAKService.ServiceExecute(Sender: TService);
 begin
  Application.Run; // wenn nicht schon im Project-Code 
  repeat
   sleep(10);
  until Terminated;
end;

end.


schon mal dank im voraus

_________________
mfg
Tana´Ri