I want to run the Indy Server from a service and I used the following code but nothing happens. When I run the service I don't receive any exceptions on starting the server but I don't receive "Connected" message either when I try to connect. Am I doing it wrong or this thing it's not possible ? The server code was tested in a normal application and it's ok, it receives connections.
I just started to learn services and I read some tutorials and they say that a very common use of a service is to check for updates for your application so I think my server should work...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext;
type
TMarusTestService = class(TService)
IdTCPServer1: TIdTCPServer;
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure IdTCPServer1Execute(AContext: TIdContext);
public
function GetServiceController: TServiceController; override;
end;
var
MarusTestService: TMarusTestService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
MarusTestService.Controller(CtrlCode);
end;
function TMarusTestService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TMarusTestService.IdTCPServer1Execute(AContext: TIdContext);
var f:textfile;
begin
AssignFile(f,'f:\service.txt');
Rewrite(f);
Writeln(f,'Connected');
CloseFile(f);
repeat
AContext.Connection.Socket.ReadLongWord;
AContext.Connection.Socket.Write($93667B01);
until false;
end;
procedure TMarusTestService.ServiceExecute(Sender: TService);
var f:textfile;
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 1280);
try
IdTCPServer1.Active:=True;
except
on E: Exception do
begin
AssignFile(f,'f:\service.txt');
Rewrite(f);
Writeln(f,'Exception: '+E.ClassName+#13+E.Message);
CloseFile(f);
end;
end;
while not Terminated do
ServiceThread.ProcessRequests(true);
end;
procedure TMarusTestService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 280);
IdTCPServer1.Active:=True;
end;
procedure TMarusTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
IdTCPServer1.Active:=false;
end;
end.
Your service's OnExecute
handler is wiping out the TIdTCPServer.Binding
collection after the server is already activated. Just get rid of the OnExecute
handler completely, let TService
handle SCM requests on its own for you. Your OnStart
handler is already activating the TCP server, that is good enough (just be sure to set Started := True
, and Stopped := True
in the OnStop
event).
As for your TIdTCPServer
events, you should move your 'Connected'
log message to the OnConnect
event, and get rid of the loop inside the OnExecute
event (since the event is already looped by TIdTCPServer
for you).
Try something more like this:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
SyncObjs;
type
TMarusTestService = class(TService)
IdTCPServer1: TIdTCPServer;
procedure ServiceCreate(Sender: TObject);
procedure ServiceDestroy(Sender: TObject);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1Disconnect(AContext: TIdContext);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
CS: TCriticalSection;
procedure Log(const Msg: String);
public
function GetServiceController: TServiceController; override;
end;
var
MarusTestService: TMarusTestService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
MarusTestService.Controller(CtrlCode);
end;
function TMarusTestService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TMarusTestService.ServiceCreate(Sender: TObject);
begin
CS := TCriticalSection.Create;
end;
procedure TMarusTestService.ServiceDestroy(Sender: TObject);
begin
CS.Free;
end;
procedure TMarusTestService.Log(const Msg: String);
const
LogFileName = 'f:\service.txt';
var
f: TextFile;
begin
CS.Enter;
try
AssignFile(f, LogFileName);
if FileExists(LogFileName) then
Append(f)
else
Rewrite(f);
try
WriteLn(f, '[', DateTimeToStr(Now), '] ', Msg);
finally
CloseFile(f);
end;
finally
CS.Leave;
end;
end;
procedure TMarusTestService.IdTCPServer1Connect(AContext: TIdContext);
begin
Log('Connected');
end;
procedure TMarusTestService.IdTCPServer1Disconnect(AContext: TIdContext);
begin
Log('Disconnected');
end;
procedure TMarusTestService.IdTCPServer1Execute(AContext: TIdContext);
begin
AContext.Connection.Socket.ReadLongWord;
AContext.Connection.Socket.Write($93667B01);
end;
procedure TMarusTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 280, Id_IPv4);
try
IdTCPServer1.Active := True;
except
on E: Exception do
begin
Log('Exception: (' + E.ClassName + ') ' + E.Message);
Win32ErrCode := 0;
ErrCode := 1;
Started := False;
Exit;
end;
end;
Log('Service Started');
Started := True;
end;
procedure TMarusTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
IdTCPServer1.Active := False;
Log('Service Stopped');
Stopped := True;
end;
end.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.