fpc/packages/fcl-process/examples/simpleipcserver.lpr

program simpleipcserver;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  BaseUnix,
  {$ENDIF}
  {$IFDEF windows}
  Windows,
  {$ENDIF}
  Classes, SysUtils, CustApp, simpleipc, Crt;

type

  { TSimpleIPCServerApp }

  TSimpleIPCServerApp = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
  end;

{ TSimpleIPCServerApp }

procedure TSimpleIPCServerApp.DoRun;
var
  IPCServer: TSimpleIPCServer;
  Key: Char;
  NullObj: TObject;
begin
  IPCServer := TSimpleIPCServer.Create(nil);
  IPCServer.ServerID:='ipc_test_crash';
  IPCServer.Global:=True;
  IPCServer.StartServer;
  NullObj := nil;

  WriteLn('Server started');
  WriteLn('  Press e to finish with an exception');
  WriteLn('  Press t to terminate through OS api - ', {$IFDEF UNIX}'Kill'{$ELSE}'TerminateProcess'{$ENDIF});
  WriteLn('  Press any other key to finish normally');
  Key := ReadKey;

  case Key of
    'e':
      begin
        NullObj.AfterConstruction;
      end;
    't':
      begin
        {$ifdef unix}
        FpKill(FpGetpid, 9);
        {$endif}
        {$ifdef windows}
        TerminateProcess(GetCurrentProcess, 0);
        {$endif}
      end;
  end;

  IPCServer.Active:=False;
  WriteLn('Server stopped');
  IPCServer.Destroy;
  Terminate;
end;

constructor TSimpleIPCServerApp.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

var
  Application: TSimpleIPCServerApp;
begin
  Application:=TSimpleIPCServerApp.Create(nil);
  Application.Title:='IPC Server';
  Application.Run;
  Application.Free;
end.