1program serverapp; 2 3{$mode objfpc}{$H+} 4{$IFDEF WINDOWS} 5{$APPTYPE CONSOLE} 6{$ENDIF} 7 8uses 9 Classes, SysUtils, enet, uenetclass, custapp; 10 11type 12 13 { TServerApplication } 14 15 TServerApplication = class(TCustomApplication) 16 Private 17 myServer : TENetClass; 18 FIdleCount : Int64; 19 procedure ProcessLoop; 20 procedure OnConnect(const Event:ENetEvent); 21 procedure OnReceive(const Event:ENetEvent; var BroadcastMsg : Boolean; var BroadcastChannel : Byte); 22 procedure ResetIdle; 23 procedure StartServer(APort, ATimeout: Integer); 24 procedure WriteHelp; 25 protected 26 Procedure DoRun; override; 27 public 28 constructor Create(AOwner : TComponent); override; 29 Destructor Destroy; override; 30 { public declarations } 31 end; 32 33 34 35constructor TServerApplication.Create(AOwner: TComponent); 36begin 37 Inherited; 38 StopOnException:=True; 39end; 40 41procedure TServerApplication.StartServer(APort,ATimeout : Integer); 42 43begin 44 myServer := TENetClass.Create(APort,True); 45 myServer.OnReceive:=@OnReceive; 46 myServer.OnConnect:=@OnConnect; 47 myServer.OnDisconnect:=@OnConnect; 48 myServer.OnNone:=@OnConnect; 49 myServer.MessageTimeout:=ATimeOut; // ideal for application idle? 50 myServer.InitHost; 51end; 52 53procedure TServerApplication.WriteHelp; 54 55begin 56 Writeln('Usage ',ExtractFileName(Self.ExeName),' [options]'); 57 Writeln('Where options is one or more of'); 58 Writeln('-h --help This message'); 59 Writeln('-p --port=portno Port to listen on (default 30000)'); 60 Writeln('-t --timeout=msec Timeout for listening to messages (milliseconds, default 1000)'); 61end; 62 63procedure TServerApplication.DoRun; 64 65Var 66 T,P : Integer; 67 68begin 69 if HasOption('h','help') then 70 begin 71 WriteHelp; 72 Terminate; 73 exit; 74 end; 75 P:=StrToIntDef(GetoptionValue('p','port'),0); 76 T:=StrToIntDef(GetoptionValue('t','timeout'),0); 77 if P=0 then 78 P:=30000; 79 if t=0 then 80 T:=1000; // 1 second timeout, 81 StartServer(P,T); 82 FIdleCount:=0; 83 repeat 84 ProcessLoop; 85 if FIdleCount=0 then 86 Write('[idle'); 87 Write('.'); 88 Inc(FIdleCount); 89 until terminated; 90end; 91 92procedure TServerApplication.ProcessLoop; 93begin 94 myServer.ProcessMsg; 95end; 96 97 98destructor TServerApplication.Destroy; 99begin 100 myServer.Free; 101end; 102 103procedure TServerApplication.ResetIdle; 104 105begin 106 if FIdleCount>0 then 107 Writeln(']'); 108 FIdleCount:=0; 109end; 110 111procedure TServerApplication.OnConnect(const Event: ENetEvent); 112begin 113 ResetIdle; 114 if (Event.Kind=ENet_Event_type_Connect) then 115 Writeln('Connect on channel : ',Event.channelID,' connected ID ,',Event.peer^.connectID,' (peer : ',Event.peer^.address.host,' port ',Event.peer^.address.port,')') 116 else if Event.Kind=ENet_Event_type_DisConnect then 117 Writeln('Disonnect on channel : ',Event.channelID,' connected ID ,',Event.peer^.connectID,' (peer : ',Event.peer^.address.host,' port ',Event.peer^.address.port,')') 118 else 119 Writeln('Unspecified connect event'); 120end; 121 122procedure TServerApplication.OnReceive(const Event: ENetEvent; var BroadcastMsg: Boolean; 123 var BroadcastChannel: Byte); 124var 125 msg : string; 126begin 127 ResetIdle; 128 msg := PChar(Event.packet^.data); 129 Writeln('Received message on channel : ',Event.channelID,' connected ID ,',Event.peer^.connectID,' (peer : ',Event.peer^.address.host,' port ',Event.peer^.address.port,')'); 130 Writeln('Message reads : "',Msg,'"'); 131end; 132 133Var 134 Application : TServerApplication; 135 136begin 137 Application:=TServerApplication.Create(Nil); 138 try 139 Application.Initialize; 140 Application.Run; 141 finally 142 Application.Free; 143 end; 144end. 145 146