end;

function TSynAnsiUTF16.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+UTF8ToWideChar(PWideChar(Dest),Source,SourceChars,true);
end;



function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;

end;

function TSynAnsiUTF16.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+UTF8ToWideChar(PWideChar(Dest),Source,SourceChars,true);
end;



function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;

  TSynThreadPoolSubThread = class(TSynThread)
  protected
    fOwner: TSynThreadPool;
    fNotifyThreadStartName: AnsiString;
    fThreadNumber: integer;
    {$ifndef USE_WINIOCP}
    fProcessingContext: pointer;
    fSafeProcessingContext: TRTLCriticalSection;
    fEvent: TEvent;
    {$endif USE_WINIOCP}
    procedure NotifyThreadStart(Sender: TSynThread);
    procedure DoTask(Context: pointer); // exception-safe call of fOwner.Task()
  public
    /// initialize the thread
    constructor Create(Owner: TSynThreadPool); reintroduce;
................................................................................

  {$M+}
  /// a simple Thread Pool, used e.g. for fast handling HTTP requests
  // - implemented over I/O Completion Ports under Windows, or a classical
  // Event-driven approach under Linux/POSIX
  TSynThreadPool = class
  protected
    fSafeSubThread: TRTLCriticalSection;
    fSubThread: TObjectList; // holds TSynThreadPoolSubThread
    fRunningThreads: integer;
    fExceptionsCount: integer;
    fOnTerminate: TNotifyThreadEvent;
    fOnThreadStart: TNotifyThreadEvent;
    fTerminated: boolean;
    fContentionAbortCount: cardinal;
    fContentionTime: Int64;
    fContentionCount: cardinal;
    fContentionAbortDelay: integer;
    {$ifdef USE_WINIOCP}
    fRequestQueue: THandle; // IOCSP has its own internal queue
    {$else}
    fQueuePendingContext: boolean;
    fPendingContextCount: integer;
    fPendingContext: array of pointer;
    {$ifdef CPU32}fPaddingForCpuCacheLineOfCriticalSections: array[0..63] of byte;{$endif}

    fSafePendingContext: TRTLCriticalSection;
    function GetPendingContextCount: integer;
    function PopPendingContext: pointer;
    function QueueLength: integer; virtual;
    {$endif USE_WINIOCP}
    /// end thread on IO error
    function NeedStopOnIOError: boolean; virtual;
    /// process to be executed after notification
................................................................................

  /// http.sys API 2.0 fields used for server-side authentication
  // - as used by THttpApiServer.SetAuthenticationSchemes/AuthenticationSchemes
  // - match low-level HTTP_AUTH_ENABLE_* constants as defined in HTTP 2.0 API
  THttpApiRequestAuthentications = set of (
    haBasic, haDigest, haNtlm, haNegotiate, haKerberos);





  /// HTTP server using fast http.sys kernel-mode server
  // - The HTTP Server API enables applications to communicate over HTTP without
  // using Microsoft Internet Information Server (IIS). Applications can register
  // to receive HTTP requests for particular URLs, receive HTTP requests, and send
  // HTTP responses. The HTTP Server API includes SSL support so that applications
  // can exchange data over secure HTTP connections without IIS. It is also
  // designed to work with I/O completion ports.
................................................................................
  // running on Windows XP with SP2 is not able to share port 80 with other HTTP
  // applications running simultaneously.
  THttpApiServer = class(THttpServerGeneric)
  protected
    /// the internal request queue
    fReqQueue: THandle;
    /// contain list of THttpApiServer cloned instances
    fClones: TObjectList;
    // if fClones=nil, fOwner contains the main THttpApiServer instance
    fOwner: THttpApiServer;
    /// list of all registered URL
    fRegisteredUnicodeUrl: array of SynUnicode;
    fServerSessionID: HTTP_SERVER_SESSION_ID;
    fUrlGroupID: HTTP_URL_GROUP_ID;
    fExecuteFinished: boolean;
................................................................................
      const aDomainName: SockString='*'; OnlyDelete: boolean=false): string;
    /// will register a compression algorithm
    // - overridden method which will handle any cloned instances
    procedure RegisterCompress(aFunction: THttpSocketCompress;
      aCompressMinSize: integer=1024); override;
    /// access to the internal THttpApiServer list cloned by this main instance
    // - as created by Clone() method
    property Clones: TObjectList read fClones;
  public { HTTP API 2.0 methods and properties }
    /// can be used to check if the HTTP API 2.0 is available
    function HasAPI2: boolean;
    /// enable HTTP API 2.0 advanced timeout settings
    // - all those settings are set for the current URL group
    // - will raise an EHttpApiServer exception if the old HTTP API 1.x is used
    // so you should better test the availability of the method first:
................................................................................
    fConnections: PHttpApiWebSocketConnectionVector;
    fConnectionsCapacity: Integer;
    //Count of used connections. Some of them can be nil(if not used more)
    fConnectionsCount: Integer;
    fFirstEmptyConnectionIndex: Integer;
    fServer: THttpApiWebSocketServer;
    fSafe: TRTLCriticalSection;
    fPendingForClose: TList;
    fIndex: integer;
    function AddConnection(aConn: PHttpApiWebSocketConnection): Integer;
    procedure RemoveConnection(index: integer);
    procedure doShutdown;
  public
    /// initialize the WebSockets process
    // - if aManualFragmentManagement is true, onMessage will appear only for whole
................................................................................
  // - don't forget to use Free method when you are finished
  THttpServer = class(THttpServerGeneric)
  protected
    /// used to protect Process() call
    fProcessCS: TRTLCriticalSection;
    fHeaderRetrieveAbortDelay: integer;
    fThreadPool: TSynThreadPoolTHttpServer;
    fInternalHttpServerRespList: TList;
    fServerConnectionCount: integer;
    fServerConnectionActive: integer;
    fServerKeepAliveTimeOut: cardinal;
    fTCPPrefix: SockString;
    fSock: TCrtSocket;
    fThreadRespClass: THttpServerRespClass;
    fOnSendFile: TOnHttpServerSendFile;
................................................................................

{ THttpServer }

constructor THttpServer.Create(const aPort: SockString; OnStart,
  OnStop: TNotifyThreadEvent; const ProcessName: SockString;
  ServerThreadPoolCount: integer; KeepAliveTimeOut: integer);
begin
  fInternalHttpServerRespList := TList.Create;
  InitializeCriticalSection(fProcessCS);
  fSock := TCrtSocket.Bind(aPort); // BIND + LISTEN
  fServerKeepAliveTimeOut := KeepAliveTimeOut; // 30 seconds by default
  if fThreadPool<>nil then
    {$ifndef USE_WINIOCP}if not fThreadPool.QueuePendingContext then{$endif}
      fThreadPool.ContentionAbortDelay := 5000; // 5 seconds default
  // event handlers set before inherited Create to be visible in childs
................................................................................
    fThreadPool.fTerminated := true; // notify background process
  if not fExecuteFinished and (Sock<>nil) then begin
    Sock.Close; // shutdown the socket to unlock Accept() in Execute
    DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1));
  end;
  endtix := GetTick64+20000;
  EnterCriticalSection(fProcessCS);

  if fInternalHttpServerRespList<>nil then begin
    for i := 0 to fInternalHttpServerRespList.Count-1 do begin
      resp := fInternalHttpServerRespList.List[i];
      resp.Terminate;
      DirectShutdown(resp.fServerSock.Sock,{rdwr=}true);
    end;
    repeat // wait for all THttpServerResp.Execute to be finished
      if (fInternalHttpServerRespList.Count=0) and fExecuteFinished then
        break;
      LeaveCriticalSection(fProcessCS);
      SleepHiRes(100);
      EnterCriticalSection(fProcessCS);
    until GetTick64>endtix;
    FreeAndNil(fInternalHttpServerRespList);
  end;

  LeaveCriticalSection(fProcessCS);
  FreeAndNil(fThreadPool); // release all associated threads and I/O completion
  FreeAndNil(fSock);
  inherited Destroy;       // direct Thread abort, no wait till ended
  DeleteCriticalSection(fProcessCS);

end;

function THttpServer.GetStat(one: THttpServerSocketGetRequestResult): integer;
begin
  result := fStats[one];
end;

................................................................................
  {$ifdef USE_WINIOCP}
  fRequestQueue := CreateIoCompletionPort(aOverlapHandle, 0, 0, NumberOfThreads);
  if fRequestQueue=INVALID_HANDLE_VALUE then begin
    fRequestQueue := 0;
    exit;
  end;
  {$else}
  InitializeCriticalSection(fSafeSubThread);
  InitializeCriticalSection(fSafePendingContext);
  fQueuePendingContext := aQueuePendingContext;
  {$endif}
  // now create the worker threads
  fSubThread := TObjectList.Create(true);
  for i := 1 to NumberOfThreads do


    fSubThread.Add(TSynThreadPoolSubThread.Create(Self));
end;

destructor TSynThreadPool.Destroy;
var i: integer;
    endtix: Int64;
begin
  fTerminated := true; // fSubThread[].Execute will check this flag
  try
    // notify the threads we are shutting down
    for i := 0 to fSubThread.Count-1 do
      {$ifdef USE_WINIOCP}
      PostQueuedCompletionStatus(fRequestQueue,0,0,nil);
      {$else}
      TSynThreadPoolSubThread(fSubThread.Items[i]).fEvent.SetEvent;
      {$endif}
    {$ifndef USE_WINIOCP}
    // cleanup now any pending task
    for i := 0 to fPendingContextCount-1 do
      TaskAbort(fPendingContext[i]);
    {$endif}
    // wait for threads to finish, with 30 seconds TimeOut
    endtix := GetTick64+30000;
    while (fRunningThreads>0) and (GetTick64<endtix) do
      SleepHiRes(5);

    fSubThread.Free;
  finally
    {$ifdef USE_WINIOCP}
    CloseHandle(fRequestQueue);
    {$else}
    DeleteCriticalSection(fSafeSubThread);
    DeleteCriticalSection(fSafePendingContext);
    {$endif USE_WINIOCP}
  end;
  inherited Destroy;
end;

function TSynThreadPool.Push(aContext: pointer; aWaitOnContention: boolean): boolean;
  {$ifdef USE_WINIOCP}
................................................................................
  end;
  {$else}
  function Enqueue: boolean;
  var i, n: integer;
      found: TSynThreadPoolSubThread;
      thread: ^TSynThreadPoolSubThread;
  begin
    result := false;
    found := nil;
    EnterCriticalsection(fSafeSubThread);
    try
      thread := pointer(fSubThread.List);
      for i := 1 to fSubThread.Count do
        if thread^.fProcessingContext=nil then begin
          found := thread^;
          EnterCriticalSection(found.fSafeProcessingContext);
          found.fProcessingContext := aContext;
          LeaveCriticalSection(found.fSafeProcessingContext);
          break;
        end else
          inc(thread);
    finally
      LeaveCriticalsection(fSafeSubThread);
    end;
    if found<>nil then begin
      found.fEvent.SetEvent;
      result := true; // found one available thread
      exit;
    end;
    EnterCriticalsection(fSafePendingContext);
    try

      if not fQueuePendingContext then
        exit;
      n := fPendingContextCount;
      if n+fSubThread.Count>QueueLength then
        exit; // too many connection limit reached (see QueueIsFull)
      if n=length(fPendingContext) then
        SetLength(fPendingContext,n+n shr 3+64);
      fPendingContext[n] := aContext;
      inc(fPendingContextCount);
      result := true; // added in pending queue
    finally
      LeaveCriticalsection(fSafePendingContext);


    end;
  end;
  {$endif}
var tix, starttix, endtix: Int64;
begin
  result := false;
  if (self=nil) or fTerminated then
................................................................................

{$ifndef USE_WINIOCP}
function TSynThreadPool.GetPendingContextCount: integer;
begin
  result := 0;
  if (self=nil) or fTerminated or (fPendingContext=nil) then
    exit;
  EnterCriticalsection(fSafePendingContext);
  try
    result := fPendingContextCount;
  finally
    LeaveCriticalsection(fSafePendingContext);
  end;
end;

function TSynThreadPool.QueueIsFull: boolean;
begin
  result := fQueuePendingContext and (GetPendingContextCount+fSubThread.Count>QueueLength);

end;

function TSynThreadPool.PopPendingContext: pointer;
begin
  result := nil;
  if (self=nil) or fTerminated or (fPendingContext=nil) then
    exit;
  EnterCriticalsection(fSafePendingContext);
  try
    if fPendingContextCount>0 then begin
      result := fPendingContext[0];
      dec(fPendingContextCount);
      Move(fPendingContext[1],fPendingContext[0],fPendingContextCount*SizeOf(pointer));


    end;
  finally
    LeaveCriticalsection(fSafePendingContext);
  end;
end;

function TSynThreadPool.QueueLength: integer;
begin
  result := 10000; // lazy high value
end;
................................................................................

constructor TSynThreadPoolSubThread.Create(Owner: TSynThreadPool);
begin
  fOwner := Owner; // ensure it is set ASAP: on Linux, Execute raises immediately
  fOnTerminate := Owner.fOnTerminate;
  {$ifndef USE_WINIOCP}
  fEvent := TEvent.Create(nil,false,false,'');
  InitializeCriticalSection(fSafeProcessingContext);
  {$endif}
  inherited Create(false);
end;

destructor TSynThreadPoolSubThread.Destroy;
begin
  inherited Destroy;
  {$ifndef USE_WINIOCP}
  DeleteCriticalSection(fSafeProcessingContext);
  fEvent.Free;
  {$endif}
end;

{$ifdef USE_WINIOCP}
function GetQueuedCompletionStatus(CompletionPort: THandle;
  var lpNumberOfBytesTransferred: DWORD; var lpCompletionKey: PtrUInt;
................................................................................
  except
    on Exception do  // intercept any exception and let the thread continue
      inc(fOwner.fExceptionsCount);
  end;
end;

procedure TSynThreadPoolSubThread.Execute;
var Context: pointer;
    {$ifdef USE_WINIOCP}
    Dummy1: DWORD;
    Dummy2: PtrUInt;
    {$endif}
begin
  if fOwner<>nil then
  try
    fThreadNumber := InterlockedIncrement(fOwner.fRunningThreads);
    NotifyThreadStart(self);
    repeat
      {$ifdef USE_WINIOCP}
      if (not GetQueuedCompletionStatus(fOwner.fRequestQueue,Dummy1,Dummy2,Context,INFINITE) and
         fOwner.NeedStopOnIOError) or fOwner.fTerminated then
        break;
      if Context<>nil then
        DoTask(Context);
      {$else}
      fEvent.WaitFor(INFINITE);
      if fOwner.fTerminated then
        break;
      EnterCriticalSection(fSafeProcessingContext);
      Context := fProcessingContext;
      LeaveCriticalSection(fSafeProcessingContext);
      while Context<>nil do begin

        DoTask(Context);
        Context := fOwner.PopPendingContext; // unqueue any pending context
      end;

      EnterCriticalSection(fSafeProcessingContext);
      fProcessingContext := nil; // indicates this thread is now available
      LeaveCriticalSection(fSafeProcessingContext);

      {$endif USE_WINIOCP}
    until fOwner.fTerminated;
  finally
    InterlockedDecrement(fOwner.fRunningThreads);
  end;
end;

procedure TSynThreadPoolSubThread.NotifyThreadStart(Sender: TSynThread);
begin
................................................................................
procedure THttpApiServer.Clone(ChildThreadCount: integer);
var i: integer;
begin
  if (fReqQueue=0) or not Assigned(OnRequest) or (ChildThreadCount<=0) then
    exit; // nothing to clone (need a queue and a process event)
  if ChildThreadCount>256 then
    ChildThreadCount := 256; // not worth adding

  for i := 1 to ChildThreadCount do
    fClones.Add(THttpApiServerClass(Self.ClassType).CreateClone(self));
end;

function THttpApiServer.GetAPIVersion: string;
begin
  result := Format('HTTP API %d.%d',[Http.Version.MajorVersion,Http.Version.MinorVersion]);
end;

procedure THttpApiServer.SetOnTerminate(const Event: TNotifyThreadEvent);
var i: integer;
begin
  inherited SetOnTerminate(Event);
  if (Clones<>nil) and (fOwner=nil) then
    for i := 0 to Clones.Count-1 do
      THttpApiServer(Clones[i]).OnHttpThreadTerminate := Event;
end;

constructor THttpApiServer.Create(CreateSuspended: boolean; QueueName: SynUnicode;
  OnStart,OnStop: TNotifyThreadEvent; const ProcessName: SockString);
var bindInfo: HTTP_BINDING_INFO;
begin
  SetLength(fLogDataStorage,sizeof(HTTP_LOG_FIELDS_DATA)); // should be done 1st
................................................................................
      Http.Version,pointer(QueueName),nil,0,fReqQueue));
    bindInfo.Flags := 1;
    bindInfo.RequestQueueHandle := FReqQueue;
    EHttpApiServer.RaiseOnError(hSetUrlGroupProperty,Http.SetUrlGroupProperty(
      fUrlGroupID,HttpServerBindingProperty,@bindInfo,SizeOf(bindInfo)));
  end else
    EHttpApiServer.RaiseOnError(hCreateHttpHandle,Http.CreateHttpHandle(fReqQueue));
  fClones := TObjectList.Create;
  fReceiveBufferSize := 1048576; // i.e. 1 MB
  if not CreateSuspended then
    Suspended := False;
end;

constructor THttpApiServer.CreateClone(From: THttpApiServer);
begin
................................................................................
     end;
    end else begin
      for i := 0 to high(fRegisteredUnicodeUrl) do
        Http.RemoveUrl(fReqQueue,pointer(fRegisteredUnicodeUrl[i]));
      CloseHandle(fReqQueue); // will break all THttpApiServer.Execute
    end;
    fReqQueue := 0;

    FreeAndNil(fClones);
    Http.Terminate(HTTP_INITIALIZE_SERVER);
  end;
end;

destructor THttpApiServer.Destroy;
{$ifdef LVCL}
var i: integer;
................................................................................
end;

procedure THttpApiServer.RegisterCompress(aFunction: THttpSocketCompress;
  aCompressMinSize: integer=1024);
var i: integer;
begin
  inherited;
  if fClones<>nil then
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).
        RegisterCompress(aFunction,aCompressMinSize);
end;

function THttpApiServer.GetHTTPQueueLength: Cardinal;
var returnLength: ULONG;
begin
  if (Http.Version.MajorVersion<2) or (self=nil) then
    result := 0 else begin
................................................................................

procedure THttpApiServer.LogStop;
var i: integer;
begin
  if (self=nil) or (fClones=nil) or (fLogData=nil) then
    exit;
  fLogData := nil;
  for i := 0 to fClones.Count-1 do
    THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).fLogData := nil;
end;

procedure THttpApiServer.SetReceiveBufferSize(Value: cardinal);
var i: integer;
begin
  fReceiveBufferSize := Value;
  if fClones<>nil then // parameter shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).fReceiveBufferSize := Value;
end;

procedure THttpApiServer.SetServerName(const aName: SockString);
var i: integer;
begin
  inherited SetServerName(aName);
  with PHTTP_LOG_FIELDS_DATA(fLogDataStorage)^ do begin
    ServerName := pointer(aName);
    ServerNameLength := Length(aName);
  end;
  if fClones<>nil then // server name is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetServerName(aName);
end;

procedure THttpApiServer.SetOnRequest(const aRequest: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnRequest(aRequest);
  if fClones<>nil then // event is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetOnRequest(aRequest);
end;

procedure THttpApiServer.SetOnBeforeBody(const aEvent: TOnHttpServerBeforeBody);
var i: integer;
begin
  inherited SetOnBeforeBody(aEvent);
  if fClones<>nil then // event is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetOnBeforeBody(aEvent);
end;

procedure THttpApiServer.SetOnBeforeRequest(const aEvent: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnBeforeRequest(aEvent);
  if fClones<>nil then // event is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetOnBeforeRequest(aEvent);
end;

procedure THttpApiServer.SetOnAfterRequest(const aEvent: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnAfterRequest(aEvent);
  if fClones<>nil then // event is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetOnAfterRequest(aEvent);
end;

procedure THttpApiServer.SetOnAfterResponse(const aEvent: TOnHttpServerAfterResponse);
var i: integer;
begin
  inherited SetOnAfterResponse(aEvent);
  if fClones<>nil then // event is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetOnAfterResponse(aEvent);
end;

procedure THttpApiServer.SetMaximumAllowedContentLength(aMax: cardinal);
var i: integer;
begin
  inherited SetMaximumAllowedContentLength(aMax);
  if fClones<>nil then // parameter is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetMaximumAllowedContentLength(aMax);
end;

procedure THttpApiServer.SetRemoteIPHeader(const aHeader: SockString);
var i: integer;
begin
  inherited SetRemoteIPHeader(aHeader);
  if fClones<>nil then // parameter is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetRemoteIPHeader(aHeader);
end;

procedure THttpApiServer.SetRemoteConnIDHeader(const aHeader: SockString);
var i: integer;
begin
  inherited SetRemoteConnIDHeader(aHeader);
  if fClones<>nil then // parameter is shared by all clones
    for i := 0 to fClones.Count-1 do
      THttpApiServer(fClones.List{$ifdef FPC}^{$endif}[i]).SetRemoteConnIDHeader(aHeader);
end;

procedure THttpApiServer.SetLoggingServiceName(const aName: SockString);
begin
  if self=nil then
    exit;
  fLoggingServiceName := aName;
................................................................................
  if aManualFragmentManagement and not Assigned(aOnFragment) then
    raise EWebSocketApi.CreateFmt('Error register WebSocket protocol. Protocol %s does not use buffer, ' + 'but OnFragment handler is not assigned', [aName]);
  {$ifdef FPC}
    InitCriticalSection(fSafe);
  {$else}
   InitializeCriticalSection(fSafe);
  {$endif}
  fPendingForClose := TList.Create;
  fName := aName;
  fManualFragmentManagement := aManualFragmentManagement;
  fServer := aServer;
  fOnAccept := aOnAccept;
  fOnMessage := aOnMessage;
  fOnConnect := aOnConnect;
  fOnDisconnect := aOnDisconnect;

  TSynThreadPoolSubThread = class(TSynThread)
  protected
    fOwner: TSynThreadPool;
    fNotifyThreadStartName: AnsiString;
    fThreadNumber: integer;
    {$ifndef USE_WINIOCP}
    fProcessingContext: pointer;

    fEvent: TEvent;
    {$endif USE_WINIOCP}
    procedure NotifyThreadStart(Sender: TSynThread);
    procedure DoTask(Context: pointer); // exception-safe call of fOwner.Task()
  public
    /// initialize the thread
    constructor Create(Owner: TSynThreadPool); reintroduce;
................................................................................

  {$M+}
  /// a simple Thread Pool, used e.g. for fast handling HTTP requests
  // - implemented over I/O Completion Ports under Windows, or a classical
  // Event-driven approach under Linux/POSIX
  TSynThreadPool = class
  protected
    fSubThread: array of TSynThreadPoolSubThread;
    fSubThreadCount: integer;
    fRunningThreads: integer;
    fExceptionsCount: integer;
    fOnTerminate: TNotifyThreadEvent;
    fOnThreadStart: TNotifyThreadEvent;
    fTerminated: boolean;
    fContentionAbortCount: cardinal;
    fContentionTime: Int64;
    fContentionCount: cardinal;
    fContentionAbortDelay: integer;
    {$ifdef USE_WINIOCP}
    fRequestQueue: THandle; // IOCSP has its own internal queue
    {$else}
    fQueuePendingContext: boolean;

    fPendingContext: array of pointer;

    fPendingContextCount: integer;
    fSafe: TRTLCriticalSection;
    function GetPendingContextCount: integer;
    function PopPendingContext: pointer;
    function QueueLength: integer; virtual;
    {$endif USE_WINIOCP}
    /// end thread on IO error
    function NeedStopOnIOError: boolean; virtual;
    /// process to be executed after notification
................................................................................

  /// http.sys API 2.0 fields used for server-side authentication
  // - as used by THttpApiServer.SetAuthenticationSchemes/AuthenticationSchemes
  // - match low-level HTTP_AUTH_ENABLE_* constants as defined in HTTP 2.0 API
  THttpApiRequestAuthentications = set of (
    haBasic, haDigest, haNtlm, haNegotiate, haKerberos);

  THttpApiServer = class;

  THttpApiServers = array of THttpApiServer;

  /// HTTP server using fast http.sys kernel-mode server
  // - The HTTP Server API enables applications to communicate over HTTP without
  // using Microsoft Internet Information Server (IIS). Applications can register
  // to receive HTTP requests for particular URLs, receive HTTP requests, and send
  // HTTP responses. The HTTP Server API includes SSL support so that applications
  // can exchange data over secure HTTP connections without IIS. It is also
  // designed to work with I/O completion ports.
................................................................................
  // running on Windows XP with SP2 is not able to share port 80 with other HTTP
  // applications running simultaneously.
  THttpApiServer = class(THttpServerGeneric)
  protected
    /// the internal request queue
    fReqQueue: THandle;
    /// contain list of THttpApiServer cloned instances
    fClones: THttpApiServers;
    // if fClones=nil, fOwner contains the main THttpApiServer instance
    fOwner: THttpApiServer;
    /// list of all registered URL
    fRegisteredUnicodeUrl: array of SynUnicode;
    fServerSessionID: HTTP_SERVER_SESSION_ID;
    fUrlGroupID: HTTP_URL_GROUP_ID;
    fExecuteFinished: boolean;
................................................................................
      const aDomainName: SockString='*'; OnlyDelete: boolean=false): string;
    /// will register a compression algorithm
    // - overridden method which will handle any cloned instances
    procedure RegisterCompress(aFunction: THttpSocketCompress;
      aCompressMinSize: integer=1024); override;
    /// access to the internal THttpApiServer list cloned by this main instance
    // - as created by Clone() method
    property Clones: THttpApiServers read fClones;
  public { HTTP API 2.0 methods and properties }
    /// can be used to check if the HTTP API 2.0 is available
    function HasAPI2: boolean;
    /// enable HTTP API 2.0 advanced timeout settings
    // - all those settings are set for the current URL group
    // - will raise an EHttpApiServer exception if the old HTTP API 1.x is used
    // so you should better test the availability of the method first:
................................................................................
    fConnections: PHttpApiWebSocketConnectionVector;
    fConnectionsCapacity: Integer;
    //Count of used connections. Some of them can be nil(if not used more)
    fConnectionsCount: Integer;
    fFirstEmptyConnectionIndex: Integer;
    fServer: THttpApiWebSocketServer;
    fSafe: TRTLCriticalSection;
    fPendingForClose: {$ifdef FPC}TFPList{$else}TList{$endif};
    fIndex: integer;
    function AddConnection(aConn: PHttpApiWebSocketConnection): Integer;
    procedure RemoveConnection(index: integer);
    procedure doShutdown;
  public
    /// initialize the WebSockets process
    // - if aManualFragmentManagement is true, onMessage will appear only for whole
................................................................................
  // - don't forget to use Free method when you are finished
  THttpServer = class(THttpServerGeneric)
  protected
    /// used to protect Process() call
    fProcessCS: TRTLCriticalSection;
    fHeaderRetrieveAbortDelay: integer;
    fThreadPool: TSynThreadPoolTHttpServer;
    fInternalHttpServerRespList: {$ifdef FPC}TFPList{$else}TList{$endif};
    fServerConnectionCount: integer;
    fServerConnectionActive: integer;
    fServerKeepAliveTimeOut: cardinal;
    fTCPPrefix: SockString;
    fSock: TCrtSocket;
    fThreadRespClass: THttpServerRespClass;
    fOnSendFile: TOnHttpServerSendFile;
................................................................................

{ THttpServer }

constructor THttpServer.Create(const aPort: SockString; OnStart,
  OnStop: TNotifyThreadEvent; const ProcessName: SockString;
  ServerThreadPoolCount: integer; KeepAliveTimeOut: integer);
begin
  fInternalHttpServerRespList := {$ifdef FPC}TFPList{$else}TList{$endif}.Create;
  InitializeCriticalSection(fProcessCS);
  fSock := TCrtSocket.Bind(aPort); // BIND + LISTEN
  fServerKeepAliveTimeOut := KeepAliveTimeOut; // 30 seconds by default
  if fThreadPool<>nil then
    {$ifndef USE_WINIOCP}if not fThreadPool.QueuePendingContext then{$endif}
      fThreadPool.ContentionAbortDelay := 5000; // 5 seconds default
  // event handlers set before inherited Create to be visible in childs
................................................................................
    fThreadPool.fTerminated := true; // notify background process
  if not fExecuteFinished and (Sock<>nil) then begin
    Sock.Close; // shutdown the socket to unlock Accept() in Execute
    DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1));
  end;
  endtix := GetTick64+20000;
  EnterCriticalSection(fProcessCS);
  try
    if fInternalHttpServerRespList<>nil then begin
      for i := 0 to fInternalHttpServerRespList.Count-1 do begin
        resp := fInternalHttpServerRespList.List[i];
        resp.Terminate;
        DirectShutdown(resp.fServerSock.Sock,{rdwr=}true);
      end;
      repeat // wait for all THttpServerResp.Execute to be finished
        if (fInternalHttpServerRespList.Count=0) and fExecuteFinished then
          break;
        LeaveCriticalSection(fProcessCS);
        SleepHiRes(100);
        EnterCriticalSection(fProcessCS);
      until GetTick64>endtix;
      FreeAndNil(fInternalHttpServerRespList);
    end;
  finally
    LeaveCriticalSection(fProcessCS);
    FreeAndNil(fThreadPool); // release all associated threads and I/O completion
    FreeAndNil(fSock);
    inherited Destroy;       // direct Thread abort, no wait till ended
    DeleteCriticalSection(fProcessCS);
  end;
end;

function THttpServer.GetStat(one: THttpServerSocketGetRequestResult): integer;
begin
  result := fStats[one];
end;

................................................................................
  {$ifdef USE_WINIOCP}
  fRequestQueue := CreateIoCompletionPort(aOverlapHandle, 0, 0, NumberOfThreads);
  if fRequestQueue=INVALID_HANDLE_VALUE then begin
    fRequestQueue := 0;
    exit;
  end;
  {$else}
  InitializeCriticalSection(fSafe);

  fQueuePendingContext := aQueuePendingContext;
  {$endif}
  // now create the worker threads

  fSubThreadCount := NumberOfThreads;
  SetLength(fSubThread,fSubThreadCount);
  for i := 0 to fSubThreadCount-1 do
    fSubThread[i] := TSynThreadPoolSubThread.Create(Self);
end;

destructor TSynThreadPool.Destroy;
var i: integer;
    endtix: Int64;
begin
  fTerminated := true; // fSubThread[].Execute will check this flag
  try
    // notify the threads we are shutting down
    for i := 0 to fSubThreadCount-1 do
      {$ifdef USE_WINIOCP}
      PostQueuedCompletionStatus(fRequestQueue,0,0,nil);
      {$else}
      fSubThread[i].fEvent.SetEvent;
      {$endif}
    {$ifndef USE_WINIOCP}
    // cleanup now any pending task
    for i := 0 to fPendingContextCount-1 do
      TaskAbort(fPendingContext[i]);
    {$endif}
    // wait for threads to finish, with 30 seconds TimeOut
    endtix := GetTick64+30000;
    while (fRunningThreads>0) and (GetTick64<endtix) do
      SleepHiRes(5);
    for i := 0 to fSubThreadCount-1 do
      fSubThread[i].Free;
  finally
    {$ifdef USE_WINIOCP}
    CloseHandle(fRequestQueue);
    {$else}
    DeleteCriticalSection(fSafe);

    {$endif USE_WINIOCP}
  end;
  inherited Destroy;
end;

function TSynThreadPool.Push(aContext: pointer; aWaitOnContention: boolean): boolean;
  {$ifdef USE_WINIOCP}
................................................................................
  end;
  {$else}
  function Enqueue: boolean;
  var i, n: integer;
      found: TSynThreadPoolSubThread;
      thread: ^TSynThreadPoolSubThread;
  begin
    result := false; // queue is full
    found := nil;
    EnterCriticalsection(fSafe);
    try
      thread := pointer(fSubThread);
      for i := 1 to fSubThreadCount do
        if thread^.fProcessingContext=nil then begin
          found := thread^;

          found.fProcessingContext := aContext;









          result := true; // found one available thread
          exit;
        end else


          inc(thread);
      if not fQueuePendingContext then
        exit;
      n := fPendingContextCount;
      if n+fSubThreadCount>QueueLength then
        exit; // too many connection limit reached (see QueueIsFull)
      if n=length(fPendingContext) then
        SetLength(fPendingContext,n+n shr 3+64);
      fPendingContext[n] := aContext;
      inc(fPendingContextCount);
      result := true; // added in pending queue
    finally
      LeaveCriticalsection(fSafe);
      if found<>nil then
        found.fEvent.SetEvent; // rather notify outside of the fSafe lock
    end;
  end;
  {$endif}
var tix, starttix, endtix: Int64;
begin
  result := false;
  if (self=nil) or fTerminated then
................................................................................

{$ifndef USE_WINIOCP}
function TSynThreadPool.GetPendingContextCount: integer;
begin
  result := 0;
  if (self=nil) or fTerminated or (fPendingContext=nil) then
    exit;
  EnterCriticalsection(fSafe);
  try
    result := fPendingContextCount;
  finally
    LeaveCriticalsection(fSafe);
  end;
end;

function TSynThreadPool.QueueIsFull: boolean;
begin
  result := fQueuePendingContext and
    (GetPendingContextCount+fSubThreadCount>QueueLength);
end;

function TSynThreadPool.PopPendingContext: pointer;
begin
  result := nil;
  if (self=nil) or fTerminated or (fPendingContext=nil) then
    exit;
  EnterCriticalsection(fSafe);
  try
    if fPendingContextCount>0 then begin
      result := fPendingContext[0];
      dec(fPendingContextCount);
      Move(fPendingContext[1],fPendingContext[0],fPendingContextCount*SizeOf(pointer));
      if fPendingContextCount=128 then
        SetLength(fPendingContext,128); // small queue when congestion is resolved
    end;
  finally
    LeaveCriticalsection(fSafe);
  end;
end;

function TSynThreadPool.QueueLength: integer;
begin
  result := 10000; // lazy high value
end;
................................................................................

constructor TSynThreadPoolSubThread.Create(Owner: TSynThreadPool);
begin
  fOwner := Owner; // ensure it is set ASAP: on Linux, Execute raises immediately
  fOnTerminate := Owner.fOnTerminate;
  {$ifndef USE_WINIOCP}
  fEvent := TEvent.Create(nil,false,false,'');

  {$endif}
  inherited Create(false);
end;

destructor TSynThreadPoolSubThread.Destroy;
begin
  inherited Destroy;
  {$ifndef USE_WINIOCP}

  fEvent.Free;
  {$endif}
end;

{$ifdef USE_WINIOCP}
function GetQueuedCompletionStatus(CompletionPort: THandle;
  var lpNumberOfBytesTransferred: DWORD; var lpCompletionKey: PtrUInt;
................................................................................
  except
    on Exception do  // intercept any exception and let the thread continue
      inc(fOwner.fExceptionsCount);
  end;
end;

procedure TSynThreadPoolSubThread.Execute;
var ctxt: pointer;
    {$ifdef USE_WINIOCP}
    dum1: DWORD;
    dum2: PtrUInt;
    {$endif}
begin
  if fOwner<>nil then
  try
    fThreadNumber := InterlockedIncrement(fOwner.fRunningThreads);
    NotifyThreadStart(self);
    repeat
      {$ifdef USE_WINIOCP}
      if (not GetQueuedCompletionStatus(fOwner.fRequestQueue,dum1,dum2,ctxt,INFINITE) and
         fOwner.NeedStopOnIOError) or fOwner.fTerminated then
        break;
      if ctxt<>nil then
        DoTask(ctxt);
      {$else}
      fEvent.WaitFor(INFINITE);
      if fOwner.fTerminated then
        break;
      EnterCriticalSection(fOwner.fSafe);
      ctxt := fProcessingContext;
      LeaveCriticalSection(fOwner.fSafe);
      if ctxt<>nil then begin
        repeat
          DoTask(ctxt);
          ctxt := fOwner.PopPendingContext; // unqueue any pending context

        until ctxt=nil;
        EnterCriticalSection(fOwner.fSafe);
        fProcessingContext := nil; // indicates this thread is now available
        LeaveCriticalSection(fOwner.fSafe);
      end;
      {$endif USE_WINIOCP}
    until fOwner.fTerminated or Terminated;
  finally
    InterlockedDecrement(fOwner.fRunningThreads);
  end;
end;

procedure TSynThreadPoolSubThread.NotifyThreadStart(Sender: TSynThread);
begin
................................................................................
procedure THttpApiServer.Clone(ChildThreadCount: integer);
var i: integer;
begin
  if (fReqQueue=0) or not Assigned(OnRequest) or (ChildThreadCount<=0) then
    exit; // nothing to clone (need a queue and a process event)
  if ChildThreadCount>256 then
    ChildThreadCount := 256; // not worth adding
  SetLength(fClones,ChildThreadCount);
  for i := 0 to ChildThreadCount-1 do
    fClones[i] := THttpApiServerClass(Self.ClassType).CreateClone(self);
end;

function THttpApiServer.GetAPIVersion: string;
begin
  result := Format('HTTP API %d.%d',[Http.Version.MajorVersion,Http.Version.MinorVersion]);
end;

procedure THttpApiServer.SetOnTerminate(const Event: TNotifyThreadEvent);
var i: integer;
begin
  inherited SetOnTerminate(Event);
  if fOwner=nil then
    for i := 0 to length(fClones)-1 do
      fClones[i].OnHttpThreadTerminate := Event;
end;

constructor THttpApiServer.Create(CreateSuspended: boolean; QueueName: SynUnicode;
  OnStart,OnStop: TNotifyThreadEvent; const ProcessName: SockString);
var bindInfo: HTTP_BINDING_INFO;
begin
  SetLength(fLogDataStorage,sizeof(HTTP_LOG_FIELDS_DATA)); // should be done 1st
................................................................................
      Http.Version,pointer(QueueName),nil,0,fReqQueue));
    bindInfo.Flags := 1;
    bindInfo.RequestQueueHandle := FReqQueue;
    EHttpApiServer.RaiseOnError(hSetUrlGroupProperty,Http.SetUrlGroupProperty(
      fUrlGroupID,HttpServerBindingProperty,@bindInfo,SizeOf(bindInfo)));
  end else
    EHttpApiServer.RaiseOnError(hCreateHttpHandle,Http.CreateHttpHandle(fReqQueue));

  fReceiveBufferSize := 1048576; // i.e. 1 MB
  if not CreateSuspended then
    Suspended := False;
end;

constructor THttpApiServer.CreateClone(From: THttpApiServer);
begin
................................................................................
     end;
    end else begin
      for i := 0 to high(fRegisteredUnicodeUrl) do
        Http.RemoveUrl(fReqQueue,pointer(fRegisteredUnicodeUrl[i]));
      CloseHandle(fReqQueue); // will break all THttpApiServer.Execute
    end;
    fReqQueue := 0;
    for i := 0 to high(fClones) do
      fClones[i].Free;
    Http.Terminate(HTTP_INITIALIZE_SERVER);
  end;
end;

destructor THttpApiServer.Destroy;
{$ifdef LVCL}
var i: integer;
................................................................................
end;

procedure THttpApiServer.RegisterCompress(aFunction: THttpSocketCompress;
  aCompressMinSize: integer=1024);
var i: integer;
begin
  inherited;

  for i := 0 to length(fClones)-1 do

    fClones[i].RegisterCompress(aFunction,aCompressMinSize);
end;

function THttpApiServer.GetHTTPQueueLength: Cardinal;
var returnLength: ULONG;
begin
  if (Http.Version.MajorVersion<2) or (self=nil) then
    result := 0 else begin
................................................................................

procedure THttpApiServer.LogStop;
var i: integer;
begin
  if (self=nil) or (fClones=nil) or (fLogData=nil) then
    exit;
  fLogData := nil;
  for i := 0 to length(fClones)-1 do
    fClones[i].fLogData := nil;
end;

procedure THttpApiServer.SetReceiveBufferSize(Value: cardinal);
var i: integer;
begin
  fReceiveBufferSize := Value;

  for i := 0 to length(fClones)-1 do
    fClones[i].fReceiveBufferSize := Value;
end;

procedure THttpApiServer.SetServerName(const aName: SockString);
var i: integer;
begin
  inherited SetServerName(aName);
  with PHTTP_LOG_FIELDS_DATA(fLogDataStorage)^ do begin
    ServerName := pointer(aName);
    ServerNameLength := Length(aName);
  end;

  for i := 0 to length(fClones)-1 do
    fClones[i].SetServerName(aName);
end;

procedure THttpApiServer.SetOnRequest(const aRequest: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnRequest(aRequest);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetOnRequest(aRequest);
end;

procedure THttpApiServer.SetOnBeforeBody(const aEvent: TOnHttpServerBeforeBody);
var i: integer;
begin
  inherited SetOnBeforeBody(aEvent);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetOnBeforeBody(aEvent);
end;

procedure THttpApiServer.SetOnBeforeRequest(const aEvent: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnBeforeRequest(aEvent);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetOnBeforeRequest(aEvent);
end;

procedure THttpApiServer.SetOnAfterRequest(const aEvent: TOnHttpServerRequest);
var i: integer;
begin
  inherited SetOnAfterRequest(aEvent);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetOnAfterRequest(aEvent);
end;

procedure THttpApiServer.SetOnAfterResponse(const aEvent: TOnHttpServerAfterResponse);
var i: integer;
begin
  inherited SetOnAfterResponse(aEvent);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetOnAfterResponse(aEvent);
end;

procedure THttpApiServer.SetMaximumAllowedContentLength(aMax: cardinal);
var i: integer;
begin
  inherited SetMaximumAllowedContentLength(aMax);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetMaximumAllowedContentLength(aMax);
end;

procedure THttpApiServer.SetRemoteIPHeader(const aHeader: SockString);
var i: integer;
begin
  inherited SetRemoteIPHeader(aHeader);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetRemoteIPHeader(aHeader);
end;

procedure THttpApiServer.SetRemoteConnIDHeader(const aHeader: SockString);
var i: integer;
begin
  inherited SetRemoteConnIDHeader(aHeader);

  for i := 0 to length(fClones)-1 do
    fClones[i].SetRemoteConnIDHeader(aHeader);
end;

procedure THttpApiServer.SetLoggingServiceName(const aName: SockString);
begin
  if self=nil then
    exit;
  fLoggingServiceName := aName;
................................................................................
  if aManualFragmentManagement and not Assigned(aOnFragment) then
    raise EWebSocketApi.CreateFmt('Error register WebSocket protocol. Protocol %s does not use buffer, ' + 'but OnFragment handler is not assigned', [aName]);
  {$ifdef FPC}
    InitCriticalSection(fSafe);
  {$else}
   InitializeCriticalSection(fSafe);
  {$endif}
  fPendingForClose := {$ifdef FPC}TFPList{$else}TList{$endif}.Create;
  fName := aName;
  fManualFragmentManagement := aManualFragmentManagement;
  fServer := aServer;
  fOnAccept := aOnAccept;
  fOnMessage := aOnMessage;
  fOnConnect := aOnConnect;
  fOnDisconnect := aOnDisconnect;

'1.18.5782'

'1.18.5783'