bbs2.dpr

   1 program bbs2;
   2 {$APPTYPE CONSOLE}
   3
   4
   5
   6 {$R *.dres}
   7
   8 uses
   9   System.SysUtils,
  10   System.Types,
  11   IPPeerServer,
  12   IPPeerAPI,
  13   IdHTTPWebBrokerBridge,
  14   Web.WebReq,
  15   Web.WebBroker,
  16   WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
  17   ServerConst1 in 'ServerConst1.pas';
  18
  19 {$R *.res}
  20
  21 function BindPort(APort: Integer): Boolean;
  22 var
  23   LTestServer: IIPTestServer;
  24 begin
  25   Result := True;
  26   try
  27     LTestServer := PeerFactory.CreatePeer('', IIPTestServer) as IIPTestServer;
  28     LTestServer.TestOpenPort(APort, nil);
  29   except
  30     Result := False;
  31   end;
  32 end;
  33
  34 function CheckPort(APort: Integer): Integer;
  35 begin
  36   if BindPort(APort) then
  37     Result := APort
  38   else
  39     Result := 0;
  40 end;
  41
  42 procedure SetPort(const AServer: TIdHTTPWebBrokerBridge; APort: String);
  43 begin
  44   if not AServer.Active then
  45   begin
  46     APort := APort.Replace(cCommandSetPort, '').Trim;
  47     if CheckPort(APort.ToInteger) > 0 then
  48     begin
  49       AServer.DefaultPort := APort.ToInteger;
  50       Writeln(Format(sPortSet, [APort]));
  51     end
  52     else
  53       Writeln(Format(sPortInUse, [APort]));
  54   end
  55   else
  56     Writeln(sServerRunning);
  57   Write(cArrow);
  58 end;
  59
  60 procedure StartServer(const AServer: TIdHTTPWebBrokerBridge);
  61 begin
  62   if not AServer.Active then
  63   begin
  64     if CheckPort(AServer.DefaultPort) > 0 then
  65     begin
  66       Writeln(Format(sStartingServer, [AServer.DefaultPort]));
  67       AServer.Bindings.Clear;
  68       AServer.Active := True;
  69     end
  70     else
  71       Writeln(Format(sPortInUse, [AServer.DefaultPort.ToString]));
  72   end
  73   else
  74     Writeln(sServerRunning);
  75   Write(cArrow);
  76 end;
  77
  78 procedure StopServer(const AServer: TIdHTTPWebBrokerBridge);
  79 begin
  80   if AServer.Active then
  81   begin
  82     Writeln(sStoppingServer);
  83     AServer.Active := False;
  84     AServer.Bindings.Clear;
  85     Writeln(sServerStopped);
  86   end
  87   else
  88     Writeln(sServerNotRunning);
  89   Write(cArrow);
  90 end;
  91
  92 procedure WriteCommands;
  93 begin
  94   Writeln(sCommands);
  95   Write(cArrow);
  96 end;
  97
  98 procedure WriteStatus(const AServer: TIdHTTPWebBrokerBridge);
  99 begin
 100   Writeln(sIndyVersion + AServer.SessionList.Version);
 101   Writeln(sActive + AServer.Active.ToString(TUseBoolStrs.True));
 102   Writeln(sPort + AServer.DefaultPort.ToString);
 103   Writeln(sSessionID + AServer.SessionIDCookieName);
 104   Write(cArrow);
 105 end;
 106
 107 procedure RunServer(APort: Integer);
 108 var
 109   LServer: TIdHTTPWebBrokerBridge;
 110   LResponse: string;
 111 begin
 112   WriteCommands;
 113   LServer := TIdHTTPWebBrokerBridge.Create(nil);
 114   try
 115     LServer.DefaultPort := APort;
 116     while True do
 117     begin
 118       Readln(LResponse);
 119       LResponse := LowerCase(LResponse);
 120       if LResponse.StartsWith(cCommandSetPort) then
 121         SetPort(LServer, LResponse)
 122       else if sametext(LResponse, cCommandStart) then
 123         StartServer(LServer)
 124       else if sametext(LResponse, cCommandStatus) then
 125         WriteStatus(LServer)
 126       else if sametext(LResponse, cCommandStop) then
 127         StopServer(LServer)
 128       else if sametext(LResponse, cCommandHelp) then
 129         WriteCommands
 130       else if sametext(LResponse, cCommandExit) then
 131         if LServer.Active then
 132         begin
 133           StopServer(LServer);
 134           break
 135         end
 136         else
 137           break
 138       else
 139       begin
 140         Writeln(sInvalidCommand);
 141         Write(cArrow);
 142       end;
 143     end;
 144   finally
 145     LServer.Free;
 146   end;
 147 end;
 148
 149 begin
 150   try
 151   if WebRequestHandler <> nil then
 152     WebRequestHandler.WebModuleClass := WebModuleClass;
 153     RunServer(8080);
 154   except
 155     on E: Exception do
 156       Writeln(E.ClassName, ': ', E.Message);
 157   end
 158 end.
 159