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
would be nice to have a cross platform warper :)
Regards.
2006/8/15, Bogusław Brandys <[EMAIL PROTECTED]>:
Michael Van Canneyt wrote:
>
> On Tue, 15 Aug 2006, Alexandre Leclerc wrote:
>
>> Hi 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.
>
>> - 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
SERVICE_CONTROL_STOP:
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;
SERVICE_CONTROL_PAUSE:
begin
if not Proxy.Suspended then Proxy.Suspend;
Status.dwcurrentstate := SERVICE_PAUSED;
SetServiceStatus(hStatusHandle, Status);
end;
SERVICE_CONTROL_CONTINUE:
begin
if Proxy.Suspended then Proxy.Resume;
Status.dwcurrentstate := SERVICE_RUNNING;
SetServiceStatus(hStatusHandle, Status);
end;
SERVICE_CONTROL_INTERROGATE:
SetServiceStatus(hStatusHandle, Status);
SERVICE_CONTROL_SHUTDOWN:
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
hStatusHandle:=RegisterServiceCtrlHandler(Pchar(ServiceName),
@ServiceHandler);
if (hStatusHandle = 0) then Exit;//error
ZeroMemory(@Status, sizeof(Status));
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[0].lpServiceProc:[EMAIL PROTECTED];
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.
--
Alexandre Leclerc
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
