Thank you for all this information Boguslaw. I'll have a look into
that. The moment it works, I don't care about usual warpers. But that
Regards.
Post by BogusÅaw BrandysPost by Michael Van CanneytPost by Alexandre LeclercHi all,
I need to code a telnet server with specific commands and for client
devices to connect to it. Now I can pick Synapse which has a simple
telnet interface or Indy10 ported to FPC which looks to have a deeper
implementation of telnet. Now I don't know how is the port going and
official support one day... Any suggestion or both are good?
Also, I need to build a service application (for the telnet server - obivious).
- Is there support in FPC for the service interface like in Delphi? or
one needs to use another hack-program to fake a normal software as
registered service?
I once started on service support in a TCustomApplication descendent,
but never finished it :(
It should not be so hard, though.
Post by Alexandre Leclerc- For linux, is there anything special to do for the same service to
run out of the box?
No. It should be easier on Linux. On windows you must manage the message
loop. Not so on Linux.
Michael.
No message loop for NT services.It's just a console application
exporting two stdcall functions which are registered into service
manager (usually called ServiceHandler and ServiceProc but it's just a
convention)
First step is to convert winsvc.h into FPC pascal source (using header
converter) .I have one winsvc.h from Mingw but it would be better to use
this header from VC++ directly.
Of course Delphi has this winsvc.pas unit but it's copyrighted.
P.S. I attach sample Nt service.In unit unServer TServer is defined as
type
TServer = class(TThread)
add required code for example to load configuration from registry and to
support telnet server in tServer.Execute.
For more complicated example look at my ClamMail program
(www.clammail.com) which is POP3 proxy with sources (GPL)
Regards
Boguslaw
{*
* Service example
* Provided by Bogus³aw Brandys
*}
program service;
uses
Windows,
{WinSvc,} <--- missing in fpc,needed to define all functions and constants
untServer,
sysutils;
{$APPTYPE CONSOLE}
const
ServiceName='TestService';
DisplayName='TestService example';
var
DispatchTable : array[0..1] of TServiceTableEntry;
hStatusHandle : service_status_handle;
Status : TServiceStatus;
Proxy : TServer;
EndEvent : THandle;
procedure ServiceMain;
begin
try
EndEvent := CreateEvent(nil,false,false,nil);
if EndEvent=0 then Report('Cannot create EndEvent!',eError,ERROR);
Proxy := TServer.Create;
try
Proxy.FreeOnTerminate := true;
Proxy.Resume;
WaitForSingleObject(EndEvent,INFINITE);
CloseHandle(EndEvent);
if Proxy.Suspended then Proxy.Resume;
Proxy.Terminate;
Proxy.WaitFor;
except on E:Exception do
Report('ServiceMain exception : ' + E.Message,eError,ERROR);
end;
finally
Status.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(hStatusHandle, Status);
OutputDebugString('ServiceMain ending...');
end;
end;
procedure ServiceHandler(control:integer); stdcall;
begin
case control of
begin
Outputdebugstring('SERVICE_CONTROL_STOP');
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP;
Status.dwWin32ExitCode := NO_ERROR;
Status.dwWaitHint := 1000;
Status.dwCheckPoint := 0;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(hStatusHandle, Status);
SetEvent(EndEvent);
end;
begin
if not Proxy.Suspended then Proxy.Suspend;
Status.dwcurrentstate := SERVICE_PAUSED;
SetServiceStatus(hStatusHandle, Status);
end;
begin
if Proxy.Suspended then Proxy.Resume;
Status.dwcurrentstate := SERVICE_RUNNING;
SetServiceStatus(hStatusHandle, Status);
end;
SetServiceStatus(hStatusHandle, Status);
begin
Outputdebugstring('SERVICE_CONTROL_SHUTDOWN');
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP;
Status.dwWin32ExitCode := NO_ERROR;
Status.dwWaitHint := 1000;
Status.dwCheckPoint := 0;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(hStatusHandle, Status);
SetEvent(EndEvent);
end;
end;
end;
procedure ServiceProc(dwargc:integer;var lpszargv : pchar); stdcall;
begin
if (hStatusHandle = 0) then Exit;//error
Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
Status.dwCurrentState := SERVICE_START_PENDING;
Status.dwControlsAccepted := 0;
Status.dwWin32ExitCode := NO_ERROR;
Status.dwWaitHint := 1000;
Status.dwCheckPoint := 0;
SetServiceStatus(hStatusHandle, Status);
Status.dwCurrentState := SERVICE_RUNNING;
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
SetServiceStatus(hStatusHandle, Status);
ServiceMain;
end;
procedure StartService;
begin
DispatchTable[0].lpservicename:=Pchar(ServiceName);
DispatchTable[1].lpServiceName:=nil;
DispatchTable[1].lpServiceProc:=nil;
if not StartServiceCtrlDispatcher(DispatchTable[0]) then Writeln('NT/XP service cannot be run directly!');
end;
begin
StartService;
end.