mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-18 05:18:38 +02:00
82 lines
1.6 KiB
ObjectPascal
82 lines
1.6 KiB
ObjectPascal
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.
|
|
|