{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
Description:  Shows how to use TWSocket from within a Windows NT/2000 service.
              This code has been tested with Delphi 5, Windows NT4 and 2000.
              All TWSocket code has been encapsulated in TTcpDaemon object.
              This is done so that you can see how the same code can be used
              inside a service or inside a normal exe program (see SrvTcp).
              To install SvcTcp, you need Windows NT or Windows 2000. At
       x       command prompt, enter: <SvcTcp /install> to uninstall it, just
     x         enter the command <SvcTcp /uninstall>. Once installed, you can
              find SvcTcp service in the "services" applet. You can start and
              stop it from that applet. You can also start and stop it from
              the command line with the command <net start "ICS Tcp Service">.
              To test for service operation, use command line telnet utility
              and connect to port 2120, then enter the command help and hit
              return key. If you wants to see what you type, turn telnet
              local echo to on.
Creation:     July 15, 2000
Version:      V9.6
EMail:        francois.piette@overbyte.be  http://www.overbyte.be
Support:      https://en.delphipraxis.net/forum/37-ics-internet-component-suite/
Legal issues: Copyright (C) 1997-2026 by François PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium.

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

History:
Jul 18, 2004 V1.01 Arno Garrels <garrels@duodata.de> made this sample
                   compatible with Delphi 4.
Apr 21, 2026 V9.6  Added simple logging so we know what the service is doing.


Note: this is a Windows service that should be insalled from a command window
with administrator rights, with the command line:

(dir)\demos-delphi-vcl\bin\Win64\Release>overbyteicsservicetcp /install

The service can be started as ICS Tcp Service from Computer Management.

It will write log in the same bin directory with a daily date.

Once running, use a telnet client to connect to 127.0.0.1:2010 and type help


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteIcsServiceTcp1;

{$I Include\OverbyteIcsDefs.inc}
{$IFNDEF DELPHI4_UP}
  Bomb('This code require Delphi 4 or later');
{$ENDIF}

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$IFNDEF VER80} { Not for Delphi 1                    }
    {$H+}       { Use long strings                    }
    {$J+}       { Allow typed constant to be modified }
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, SvcMgr,
  OverbyteIcsUtils,      // IcsSimpleLogging
  OverbyteIcsServiceCmd;

const
  ServiceTcpVersion             = 960;
  CopyRight    : String     = ' ServiceTcp (c) 2000-2026 F. Piette V9.6 ';
  SimpLogName = '"ServiceTcp-"yyyymmdd".log"' ;    { V9.6 }

type
  TIcsTcpServce = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    FTcpDaemon : TTcpDaemon;
    procedure Display(Msg: String);
  public
    function GetServiceController: TServiceController; override;
  end;

var
  IcsTcpServce: TIcsTcpServce;

implementation

{$R *.DFM}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
    IcsTcpServce.Controller(CtrlCode);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTcpServce.GetServiceController: TServiceController;
begin
    Result := ServiceController;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.ServiceStart(Sender: TService; var Started: Boolean);
begin
    Display('Creating and Starting Daemon');
    try
        FTcpDaemon           := TTcpDaemon.Create;
        FTcpDaemon.Banner    := DisplayName + ' Ready';
        FTcpDaemon.OnDisplay := Display;
        FTcpDaemon.Start;
        Started := TRUE;
    except
        on E:Exception do begin
            Display('Exception Starting Service: ' + E.Message);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
   Display('Stopping Service');
   FTcpDaemon.Stop;
   Stopped := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.ServiceExecute(Sender: TService);
begin
    Display('Starting Message Loop');
    while not Terminated do
        ServiceThread.ProcessRequests(TRUE);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.Display(Msg : String);
begin
    // A service has no access to the GUI.
    IcsSimpleLogging (SimpLogName, Msg) ;  { V9.6 write line to text file, daily name  }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.ServiceCreate(Sender: TObject);
begin
   Display('Created Service');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTcpServce.ServiceDestroy(Sender: TObject);
begin
    if Assigned(FTcpDaemon) then begin
        FTcpDaemon.Destroy;
        FTcpDaemon := nil;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.