TWinInet and TWinHTTP constructors
  - added THttpServerGeneric.OnHttpThreadStart property, and associated
    TNotifyThreadEvent event prototype
  - handle 'Range: bytes=***-***' request in THttpApiServer

  Version 1.18
  - introducing THttpServerRequest class for HTTP server context



  - deep code refactoring of thread process, especially for TSynThreadPool as
    used by THttpServer: introducing TNotifiedThread and TSynThreadPoolSubThread;
    as a result, it fixes OnHttpThreadStart and OnHttpThreadTerminate to be
    triggered from every thread, as expected
  - converted any AnsiString type into a more neutral RawByteString (this is
    correct for URIs or port numbers, and avoid any dependency to SynCommons)
  - added TCrtSocket.TCPNoDelay/SendTimeout/ReceiveTimeout/KeepAlive properties
................................................................................
  - fixed ticket [814f6bd65a] about missing OnHttpThreadStart in CreateClone
  - fixed potential Access Violation error at THttpServerResp shutdown
  - removed several compilation hints when assertions are set to off
  - added aRegisterURI optional parameter to THttpApiServer.AddUrl() method

}



interface

{ $define DEBUG2}
{ $define DEBUG23}

{$ifndef CONDITIONALEXPRESSIONS} // for Delphi 5 or older: define this
  {$define MSWINDOWS}
{$endif}

{$ifdef MSWINDOWS}
  {$define USEWININET}
  /// define this to publish TWinINet / TWinHttp / TWinHttpAPI classes
  {$define USETHREADPOOL}
  // define this to use TSynThreadPool for faster multi-connection on THttpServer
  // with Thread Pool: 3394 requests / second (each request received 4 KB of data)
  // without the Pool: 140/s in the IDE (i.e. one core), 2637/s on a dual core



{$else}
  {$undef USEWININET} // WinINet / WinHTTP / HttpAPI expect a Windows system
  {$undef USETHREADPOOL}







{$endif}

{$ifdef DEBUG2}
{.$define DEBUG}
{$endif}

{$ifdef CPUX64}
  {$define CPU64}
{$endif}

{$ifdef CPU64}
  {$define PUREPASCAL}
{$endif}

{$R-} // disable Range checking in our unit's code
{$S-} // disable Stack checking in our unit's code
{$X+} // expect extended syntax
{$W-} // disable stack frame generation
{$Q-} // disable overflow checking in our unit's code
{$B-} // expect short circuit boolean
{$V-} // disable Var-String Checking
{$T-} // Typed @ operator
{$Z1} // enumerators stored as byte by default
{$IFNDEF FPC}
  {$P+} // Open string params
{$ENDIF}

uses
{$ifdef MSWINDOWS}
  Windows,
  SynWinSock,
  {$ifdef USEWININET}
    WinInet,
  {$endif}
................................................................................
    // - return false on any error, true on success
    function TrySockRecv(Buffer: pointer; Length: integer): boolean;
    /// call readln(SockIn^,Line) or simulate it with direct use of Recv(Sock, ..)
    // - char are read one by one
    // - use TimeOut milliseconds wait for incoming data
    // - raise ECrtSocket exception on socket error
    // - by default, will handle #10 or #13#10 as line delimiter (as normal text
    // files), but you can delimit lines using #13 if CROnly is TRUE 
    procedure SockRecvLn(out Line: RawByteString; CROnly: boolean=false); overload;
    /// call readln(SockIn^) or simulate it with direct use of Recv(Sock, ..)
    // - char are read one by one
    // - use TimeOut milliseconds wait for incoming data
    // - raise ECrtSocket exception on socket error
    // - line content is ignored
    procedure SockRecvLn; overload;
................................................................................
    // was made, for instance via a method defined as such:
    // ! procedure TMyServer.OnHttpThreadTerminate(Sender: TObject);
    // ! begin // TSQLDBConnectionPropertiesThreadSafe
    // !   fMyConnectionProps.EndCurrentThread;
    // ! end;
    property OnHttpThreadTerminate: TNotifyThreadEvent read fOnTerminate write fOnTerminate;
  end;








  {/ 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
................................................................................
  protected
    /// the internal request queue
		fReqQueue: THandle;
    /// contain list of THttpApiServer cloned instances
    fClones: TObjectList;
    /// list of all registered URL (Unicode-encoded)
    fRegisteredUnicodeUrl: array of RawByteString;






    /// server main loop - don't change directly
    // - will call the Request public virtual method with the appropriate
    // parameters to retrive the content
    procedure Execute; override;
    /// create a clone
    constructor CreateClone(From: THttpApiServer);
  public
................................................................................
    /// will register a compression algorithm
    // - overriden 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;










  end;

  /// main HTTP server Thread using the standard Sockets library (e.g. WinSock)
  // - bind to a port and listen to incoming requests
  // - assign this requests to THttpServerResp threads
  // - it implements a HTTP/1.1 compatible server, according to RFC 2068 specifications
  // - if the client is also HTTP/1.1 compatible, KeepAlive connection is handled:
................................................................................
  rp := pointer(result); 
  for i := 1 to len do begin 
    c := 0; 
    j := 0; 
    while true do begin
      ch := ord(sp[j]);
      case chr(ch) of
        'A'..'Z' : c := c or (ch - ord('A'));
        'a'..'z' : c := c or (ch - (ord('a')-26));
        '0'..'9' : c := c or (ch - (ord('0')-52));
        '+' : c := c or 62;
        '/' : c := c or 63;
        else
        if j=3 then begin
          rp[0] := AnsiChar(c shr 16);
          rp[1] := AnsiChar(c shr 8);
          SetLength(result, len*3-1);
          exit;
        end else begin
................................................................................
{$ifdef Win32}
function GetRemoteMacAddress(const IP: RawByteString): RawByteString;
// implements http://msdn.microsoft.com/en-us/library/aa366358
type
  TSendARP = function(DestIp: DWORD; srcIP: DWORD; pMacAddr: pointer; PhyAddrLen: Pointer): DWORD; stdcall;
var dwRemoteIP: DWORD;
    PhyAddrLen: Longword;
    pMacAddr : array [0..7] of byte;
    I: integer;
    P: PAnsiChar;
    SendARPLibHandle: THandle;
    SendARP: TSendARP;
begin
  result := '';
  SendARPLibHandle := LoadLibrary('iphlpapi.dll');
................................................................................
    hscUrlAclInfo,      
    hscMax);
  THttpServiceConfigQueryType = (
    hscQueryExact,
    hscQueryNext,
    hscQueryMax);

  ULONGLONG = Int64;
  HTTP_OPAQUE_ID = ULONGLONG;
  HTTP_URL_CONTEXT = HTTP_OPAQUE_ID;
  HTTP_REQUEST_ID = HTTP_OPAQUE_ID;
  HTTP_CONNECTION_ID = HTTP_OPAQUE_ID;
  HTTP_RAW_CONNECTION_ID = HTTP_OPAQUE_ID;

  // Pointers overlap and point into pFullUrl. nil if not present.
  HTTP_COOKED_URL = record
................................................................................
    ParamDesc: HTTP_SERVICE_CONFIG_URLACL_PARAM;
  end;
  HTTP_SERVICE_CONFIG_URLACL_QUERY = record
    QueryDesc: THttpServiceConfigQueryType;
    KeyDesc: HTTP_SERVICE_CONFIG_URLACL_KEY;
    dwToken: DWORD;
  end;














































  /// structure used to handle data associated with a specific request
  HTTP_REQUEST = record
    // either 0 (Only Header), either HTTP_RECEIVE_REQUEST_FLAG_COPY_BODY
    Flags: cardinal;
    // An identifier for the connection on which the request was received
    ConnectionId: HTTP_CONNECTION_ID;
................................................................................
    Headers: HTTP_REQUEST_HEADERS;
    // The total number of bytes received from network for this request
    BytesReceived: ULONGLONG;
    EntityChunkCount: word;
    pEntityChunks: pointer;
    RawConnectionId: HTTP_RAW_CONNECTION_ID;
    // SSL connection information
    pSslInfo: PHTTP_SSL_INFO; 





  end;
  PHTTP_REQUEST = ^HTTP_REQUEST;

















  HTTP_RESPONSE = object
  public
    Flags: cardinal;
    // The raw HTTP protocol version number
    Version: HTTP_VERSION;
    // The HTTP status code (e.g., 200)
................................................................................
    // The HTTP reason (e.g., "OK"). This MUST not contain non-ASCII characters
    // (i.e., all chars must be in range 0x20-0x7E).
    pReason: PAnsiChar;
    // The response headers
    Headers: HTTP_RESPONSE_HEADERS;
    // number of elements in pEntityChunks[] array
    EntityChunkCount: word;
    // pEntityChunks points to an array of EntityChunkCount HTTP_DATA_CHUNK_* 
    pEntityChunks: pointer;




    // will set both StatusCode and Reason
    // - OutStatus is a temporary variable which will be field with the
    // corresponding text
    procedure SetStatus(code: integer; var OutStatus: RawByteString);
    // will set the content of the reponse, and ContentType header
    procedure SetContent(var DataChunk: HTTP_DATA_CHUNK_INMEMORY;
      const Content: RawByteString; const ContentType: RawByteString='text/html');
................................................................................
    /// add one header value to the internal headers
    // - SetHeaders() method should have been called before to initialize the
    // internal UnknownHeaders[] array
    function AddCustomHeader(P: PAnsiChar; var UnknownHeaders: HTTP_UNKNOWN_HEADERs): PAnsiChar;
  end;
  PHTTP_RESPONSE = ^HTTP_RESPONSE;














































































































































































































































































































































const
  HTTP_VERSION_UNKNOWN: HTTP_VERSION = (MajorVersion: 0; MinorVersion: 0);
  HTTP_VERSION_0_9: HTTP_VERSION = (MajorVersion: 0; MinorVersion: 9);
  HTTP_VERSION_1_0: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 0);
  HTTP_VERSION_1_1: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 1);
  HTTPAPI_VERSION_1: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 0);
  HTTPAPI_VERSION_2: HTTP_VERSION = (MajorVersion: 2; MinorVersion: 0);
................................................................................
  HTTP_RECEIVE_REQUEST_FLAG_COPY_BODY = 1;
  // there is more entity body to be read for this request
  HTTP_REQUEST_FLAG_MORE_ENTITY_BODY_EXISTS = 1;
  // initialization for applications that use the HTTP Server API
  HTTP_INITIALIZE_SERVER = 1;
  // initialization for applications that use the HTTP configuration functions
  HTTP_INITIALIZE_CONFIG = 2;



  // see http://msdn.microsoft.com/en-us/library/windows/desktop/aa364496
  HTTP_RECEIVE_REQUEST_ENTITY_BODY_FLAG_FILL_BUFFER = 1;
  // see http://msdn.microsoft.com/en-us/library/windows/desktop/aa364499
  HTTP_SEND_RESPONSE_FLAG_PROCESS_RANGES = 1;

  KNOWNHEADERS_NAME: array[reqCacheControl..reqUserAgent] of string[19] = (
    'Cache-Control','Connection','Date','Keep-Alive','Pragma','Trailer',
................................................................................
  {$ifopt C+}         
  inc(D,2);
  assert(D-pointer(result)=L);
  {$endif}
end;

type

















  THttpAPI = packed record
    Module: THandle;
    {/ The HttpInitialize function initializes the HTTP Server API driver, starts it,
    if it has not already been started, and allocates data structures for the
    calling application to support response-queue creation and other operations.
    Call this function before calling any other functions in the HTTP Server API. }
    Initialize: function(Version: HTTP_VERSION; Flags: cardinal;
................................................................................
      ConfigId: THttpServiceConfigID; pConfigInformation: pointer;
      ConfigInformationLength: ULONG; pOverlapped: pointer=nil): HRESULT; stdcall;
    {/ deletes specified data, such as IP addresses or SSL Certificates, from the
      HTTP Server API configuration store}
    DeleteServiceConfiguration: function(ServiceHandle: THandle;
      ConfigId: THttpServiceConfigID; pConfigInformation: pointer;
      ConfigInformationLength: ULONG; pOverlapped: pointer=nil): HRESULT; stdcall;

































































  end;

var
  Http: THttpAPI;

type
  THttpAPIs = (hInitialize,hTerminate,hCreateHttpHandle,
    hAddUrl, hRemoveUrl, hReceiveHttpRequest,
    hSendHttpResponse, hReceiveRequestEntityBody,
    hSetServiceConfiguration, hDeleteServiceConfiguration);











const
  HttpNames: array[THttpAPIs] of PChar = (
    'HttpInitialize','HttpTerminate','HttpCreateHttpHandle',
    'HttpAddUrl', 'HttpRemoveUrl', 'HttpReceiveHttpRequest',
    'HttpSendHttpResponse', 'HttpReceiveRequestEntityBody',
    'HttpSetServiceConfiguration', 'HttpDeleteServiceConfiguration');













function RegURL(aRoot, aPort: RawByteString; Https: boolean;
  aDomainName: RawByteString): RawByteString;
const Prefix: array[boolean] of RawByteString = ('http://','https://');
begin
  if aPort='' then
    aPort := '80';
................................................................................

type
  EHttpApiServer = class(Exception)
  protected
    fLastError: integer;
    fLastApi: THttpAPIs;
  public

    constructor Create(api: THttpAPIs; Error: integer);
    property LastApi: THttpAPIs read fLastApi;
    property LastError: integer read fLastError;
  end;







constructor EHttpApiServer.Create(api: THttpAPIs; Error: integer);
begin
  fLastError := Error;
  fLastApi := api;
  inherited CreateFmt('%s failed: %s (%d)',
    [HttpNames[api],SysErrorMessage(Error),Error])
................................................................................
  if (Self=nil) or (fReqQueue=0) or (Http.Module=0) then
    exit;
  s := RegURL(aRoot, aPort, Https, aDomainName);
  if s='' then
    exit; // invalid parameters
  if aRegisterURI then
    AddUrlAuthorize(aRoot,aPort,Https,aDomainName);



  result := Http.AddUrl(fReqQueue,pointer(s));

  if result=NO_ERROR then begin
    n := length(fRegisteredUnicodeUrl);
    SetLength(fRegisteredUnicodeUrl,n+1);
    fRegisteredUnicodeUrl[n] := s;
  end;
end;

................................................................................
    Config: HTTP_SERVICE_CONFIG_URLACL_SET;
begin
  try
    HttpApiInitialize;
    prefix := RegURL(aRoot, aPort, Https, aDomainName);
    if prefix='' then
      result := 'Invalid parameters' else begin
      Error := Http.Initialize(HTTPAPI_VERSION_1,HTTP_INITIALIZE_CONFIG);
      if Error<>NO_ERROR then
        raise EHttpApiServer.Create(hInitialize,Error);
      try
        fillchar(Config,sizeof(Config),0);
        Config.KeyDesc.pUrlPrefix := pointer(prefix);
        // first delete any existing information
        Error := Http.DeleteServiceConfiguration(0,hscUrlAclInfo,@Config,Sizeof(Config));
        // then add authorization rule
        if not OnlyDelete then begin
................................................................................
  if ChildThreadCount>256 then
    ChildThreadCount := 256; // not worth adding
  for i := 1 to ChildThreadCount do
    fClones.Add(THttpApiServer.CreateClone(self));
end;

constructor THttpApiServer.Create(CreateSuspended: Boolean);
var Error: HRESULT;


begin
  inherited Create(true);
  HttpApiInitialize; // will raise an exception in case of failure


  Error := Http.Initialize(HTTPAPI_VERSION_1,HTTP_INITIALIZE_SERVER);
  if Error<>NO_ERROR then
    raise EHttpApiServer.Create(hInitialize,Error);












  Error := Http.CreateHttpHandle(fReqQueue);
  if Error<>NO_ERROR then
    raise EHttpApiServer.Create(hCreateHttpHandle,Error);

  fClones := TObjectList.Create;
  if not CreateSuspended then
    Suspended := False;
end;

constructor THttpApiServer.CreateClone(From: THttpApiServer);
begin
................................................................................
end;

destructor THttpApiServer.Destroy;
var i: Integer;
begin
  if (fClones<>nil) and (Http.Module<>0) then begin  // fClones=nil for clone threads
    if fReqQueue<>0 then begin

      for i := 0 to high(fRegisteredUnicodeUrl) do








        Http.RemoveUrl(fReqQueue,pointer(fRegisteredUnicodeUrl[i]));
      CloseHandle(fReqQueue); // will break all THttpApiServer.Execute

      fReqQueue := 0;
      Http.Terminate(HTTP_INITIALIZE_SERVER);
    end;
    FreeAndNil(fClones);
  end;
  inherited Destroy;
end;
................................................................................
    repeat
      // retrieve next pending request, and read its headers
      fillchar(Req^,sizeof(HTTP_REQUEST),0);
      Err := Http.ReceiveHttpRequest(fReqQueue,ReqID,0,Req^,length(ReqBuf),bytesRead);
      if Terminated then
        break;
      case Err of
        NO_ERROR: 
        try
          // parse method and headers
          Context.fURL := Req^.pRawUrl;
          if Req^.Verb in [low(VERB_TEXT)..high(VERB_TEXT)] then
            Context.fMethod := VERB_TEXT[Req^.Verb] else
            SetString(Context.fMethod,Req^.pUnknownVerb,Req^.UnknownVerbLength);
          with Req^.Headers.KnownHeaders[reqContentType] do
            SetString(Context.fInContentType,pRawValue,RawValueLength);
          with Req^.Headers.KnownHeaders[reqAcceptEncoding] do
            SetString(InAcceptEncoding,pRawValue,RawValueLength);
          InCompressAccept := ComputeContentEncoding(fCompress,pointer(InAcceptEncoding));
          Context.fInHeaders := RetrieveHeaders(Req^);
          // retrieve body
          Context.fInContent := '';
          if HTTP_REQUEST_FLAG_MORE_ENTITY_BODY_EXISTS and Req^.Flags<>0 then begin
            with Req^.Headers.KnownHeaders[reqContentLength] do
              InContentLength := GetCardinal(pRawValue,pRawValue+RawValueLength);
            if InContentLength<>0 then begin
              SetLength(Context.fInContent,InContentLength);
              BufRead := pointer(Context.InContent);
              InContentLengthRead := 0;
              repeat
                BytesRead := 0;
                if Win32MajorVersion>5 then // speed optimization for Vista+
                  flags := HTTP_RECEIVE_REQUEST_ENTITY_BODY_FLAG_FILL_BUFFER else
                  flags := 0;
                Err := Http.ReceiveRequestEntityBody(fReqQueue,Req^.RequestId,flags,
                  BufRead,InContentLength-InContentLengthRead,BytesRead);
                inc(InContentLengthRead,BytesRead);
                if Err=ERROR_HANDLE_EOF then begin
                  if InContentLengthRead<InContentLength then
                    SetLength(Context.fInContent,InContentLengthRead);
                  Err := NO_ERROR;
                  break; // should loop until returns ERROR_HANDLE_EOF
                end;
                if Err<>NO_ERROR then
                  break;
                inc(BufRead,BytesRead);
              until InContentLengthRead=InContentLength;
              if Err<>NO_ERROR then begin
                SendError(406,SysErrorMessage(Err));
                continue;
              end;
              with Req^.Headers.KnownHeaders[reqContentEncoding] do
              if RawValueLength<>0 then begin
                SetString(InContentEncoding,pRawValue,RawValueLength);
                for i := 0 to high(fCompress) do
                  if fCompress[i].Name=InContentEncoding then begin
                    fCompress[i].Func(Context.fInContent,false); // uncompress
                    break;
                  end;
              end;
            end;
          end;
          try
            // compute response
            Context.OutContent := '';
            Context.OutContentType := '';
            Context.OutCustomHeaders := '';
            fillchar(Resp^,sizeof(Resp^),0);
            Resp^.SetStatus(Request(Context),OutStatus);
            if Terminated then
              exit;
            // send response
            Resp^.Version := Req^.Version;
            Resp^.SetHeaders(pointer(Context.OutCustomHeaders),Heads);
            if fCompressAcceptEncoding<>'' then
              Resp^.AddCustomHeader(pointer(fCompressAcceptEncoding),Heads);
            if Context.OutContentType=HTTP_RESP_STATICFILE then begin
              // response is file -> let http.sys serve it (OutContent is UTF-8)
              FileHandle := FileOpen(
                {$ifdef UNICODE}UTF8ToUnicodeString{$else}Utf8ToAnsi{$endif}(Context.OutContent),
                fmOpenRead or fmShareDenyNone);
              if PtrInt(FileHandle)<0 then begin
                SendError(404,SysErrorMessage(GetLastError));
                continue;
              end;
              try
                DataChunkFile.DataChunkType := hctFromFileHandle;
                DataChunkFile.FileHandle := FileHandle;
                flags := 0;
                DataChunkFile.ByteRange.StartingOffset.QuadPart := 0;
                Int64(DataChunkFile.ByteRange.Length.QuadPart) := -1; // to eof
                with Req^.Headers.KnownHeaders[reqRange] do
                  if (RawValueLength>6) and IdemPChar(pRawValue,'BYTES=') and
                     (pRawValue[6] in ['0'..'9']) then begin
                    SetString(Range,pRawValue+6,RawValueLength-6); // need #0 end
                    R := pointer(Range);
                    RangeStart := GetNextItemUInt64(R);
                    if R^='-' then begin
                      inc(R);
                      flags := HTTP_SEND_RESPONSE_FLAG_PROCESS_RANGES;
                      DataChunkFile.ByteRange.StartingOffset := ULARGE_INTEGER(RangeStart);
                      if R^ in ['0'..'9'] then begin
                        RangeLength := GetNextItemUInt64(R)-RangeStart+1;
                        if RangeLength>=0 then // "bytes=0-499" -> start=0, len=500
                          DataChunkFile.ByteRange.Length := ULARGE_INTEGER(RangeLength);
                      end; // "bytes=1000-" -> start=1000, len=-1 (to eof)
                    end;
                  end;
                Resp^.EntityChunkCount := 1;
                Resp^.pEntityChunks := @DataChunkFile;
                Http.SendHttpResponse(fReqQueue,Req^.RequestId,flags,Resp^,nil,bytesSent);
              finally
                FileClose(FileHandle);
              end;
            end else begin
              // response is in OutContent -> sent it from memory
              if fCompress<>nil then begin
                with Resp^.Headers.KnownHeaders[reqContentEncoding] do
                if RawValueLength=0 then begin
                  // no previous encoding -> try if any compression
                  OutContentEncoding := CompressDataAndGetHeaders(InCompressAccept,
                    fCompress,Context.OutContentType,Context.fOutContent);
                  pRawValue := pointer(OutContentEncoding);
                  RawValueLength := length(OutContentEncoding);
                end;
              end;
              Resp^.SetContent(DataChunkInMemory,Context.OutContent,Context.OutContentType);

              Err := Http.SendHttpResponse(fReqQueue,Req^.RequestId,0,Resp^,nil,bytesSent);
              if Err<>NO_ERROR then
                raise EHttpApiServer.Create(hSendHttpResponse,Err);
            end;
          except
            on E: Exception do
              // handle any exception raised during process: show must go on!
              if not E.InheritsFrom(EHttpApiServer) or // ensure still connected
                 (EHttpApiServer(E).LastError<>HTTPAPI_ERROR_NONEXISTENTCONNECTION) then
                SendError(500,E.Message,E);
          end;
        finally    
          ReqId := 0; // reset Request ID to handle the next pending request
        end;
        ERROR_MORE_DATA: begin
          // input buffer was too small to hold the request headers
          // -> increase buffer size and call the API again
          ReqID := Req^.RequestId;
          SetLength(ReqBuf,bytesRead);
          Req := pointer(ReqBuf);
        end;
        ERROR_CONNECTION_INVALID:
          if ReqID=0 then
            break else
            // TCP connection was corrupted by the peer -> ignore + next request
            ReqID := 0;
        else break;
      end;
    until Terminated;
  finally
    Context.Free;
  end;
end;

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






























{ HTTP_RESPONSE }

procedure HTTP_RESPONSE.SetContent(var DataChunk: HTTP_DATA_CHUNK_INMEMORY;
  const Content, ContentType: RawByteString);
begin
  fillchar(DataChunk,sizeof(DataChunk),0);
................................................................................

{$endif}


initialization
  {$ifdef DEBUGAPI}AllocConsole;{$endif}
  {$ifdef CPU64}

  Assert((sizeof(HTTP_REQUEST)=848) and (sizeof(HTTP_SSL_INFO)=48) and
    (sizeof(HTTP_DATA_CHUNK_INMEMORY)=32) and
    (sizeof(HTTP_DATA_CHUNK_FILEHANDLE)=32) and
    (sizeof(HTTP_REQUEST_HEADERS)=688) and
    (sizeof(HTTP_RESPONSE_HEADERS)=512) and (sizeof(HTTP_COOKED_URL)=40) and


    (sizeof(HTTP_RESPONSE)=552) and (ord(reqUserAgent)=40) and
    (ord(respLocation)=23) and (sizeof(THttpHeader)=4));
  {$else}

  Assert((sizeof(HTTP_REQUEST)=464) and (sizeof(HTTP_SSL_INFO)=28) and
    (sizeof(HTTP_DATA_CHUNK_INMEMORY)=24) and
    (sizeof(HTTP_DATA_CHUNK_FILEHANDLE)=32) and
    (sizeof(HTTP_REQUEST_HEADERS)=344) and
    (sizeof(HTTP_RESPONSE_HEADERS)=256) and (sizeof(HTTP_COOKED_URL)=24) and


    (sizeof(HTTP_RESPONSE)=280) and (ord(reqUserAgent)=40) and
    (ord(respLocation)=23) and (sizeof(THttpHeader)=4));
  {$endif}
  if InitSocketInterface then
    WSAStartup(WinsockLevel, WsaDataOnce) else
    fillchar(WsaDataOnce,sizeof(WsaDataOnce),0);

finalization

    TWinInet and TWinHTTP constructors
  - added THttpServerGeneric.OnHttpThreadStart property, and associated
    TNotifyThreadEvent event prototype
  - handle 'Range: bytes=***-***' request in THttpApiServer

  Version 1.18
  - introducing THttpServerRequest class for HTTP server context
  - http.sys kernel-mode server now handles HTTP API 2.0 by default (available
    since Vista/Server2008, so you can define NOHTTPAPI20 in Synopse.inc to
    support XP/Server2003) - thanks pavel for this great contribution!
  - deep code refactoring of thread process, especially for TSynThreadPool as
    used by THttpServer: introducing TNotifiedThread and TSynThreadPoolSubThread;
    as a result, it fixes OnHttpThreadStart and OnHttpThreadTerminate to be
    triggered from every thread, as expected
  - converted any AnsiString type into a more neutral RawByteString (this is
    correct for URIs or port numbers, and avoid any dependency to SynCommons)
  - added TCrtSocket.TCPNoDelay/SendTimeout/ReceiveTimeout/KeepAlive properties
................................................................................
  - fixed ticket [814f6bd65a] about missing OnHttpThreadStart in CreateClone
  - fixed potential Access Violation error at THttpServerResp shutdown
  - removed several compilation hints when assertions are set to off
  - added aRegisterURI optional parameter to THttpApiServer.AddUrl() method

}

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

interface

{ $define DEBUG2}
{ $define DEBUG23}





{$ifdef MSWINDOWS}

  /// define this to publish TWinINet / TWinHttp / TWinHttpAPI classes
  {$define USEWININET}
  // define this to use TSynThreadPool for faster multi-connection on THttpServer
  // with Thread Pool: 3394 requests / second (each request received 4 KB of data)
  // without the Pool: 140/s in the IDE (i.e. one core), 2637/s on a dual core
  {$define USETHREADPOOL}
  /// define this to use HTTP API 2.0 features (must-have since Vista/2008)
  {$define HTTPAPI20}
{$else}
  {$undef USEWININET}    // WinINet / WinHTTP / HttpAPI expect a Windows system
  {$undef USETHREADPOOL} // our IOCP patternis Windows-specific
  {$undef HTTPAPI20}     // http.sys is for Windows only
{$endif}

{$ifdef NOHTTPAPI20}
  // define it for Windows XP or Windows Server 2003, which does not support
  // HTTP API 2.0 (may be defined globally in your own Synopse.inc) 
  {$undef HTTPAPI20}
{$endif}

{$ifdef DEBUG2}
{.$define DEBUG}
{$endif}






















uses
{$ifdef MSWINDOWS}
  Windows,
  SynWinSock,
  {$ifdef USEWININET}
    WinInet,
  {$endif}
................................................................................
    // - return false on any error, true on success
    function TrySockRecv(Buffer: pointer; Length: integer): boolean;
    /// call readln(SockIn^,Line) or simulate it with direct use of Recv(Sock, ..)
    // - char are read one by one
    // - use TimeOut milliseconds wait for incoming data
    // - raise ECrtSocket exception on socket error
    // - by default, will handle #10 or #13#10 as line delimiter (as normal text
    // files), but you can delimit lines using #13 if CROnly is TRUE
    procedure SockRecvLn(out Line: RawByteString; CROnly: boolean=false); overload;
    /// call readln(SockIn^) or simulate it with direct use of Recv(Sock, ..)
    // - char are read one by one
    // - use TimeOut milliseconds wait for incoming data
    // - raise ECrtSocket exception on socket error
    // - line content is ignored
    procedure SockRecvLn; overload;
................................................................................
    // was made, for instance via a method defined as such:
    // ! procedure TMyServer.OnHttpThreadTerminate(Sender: TObject);
    // ! begin // TSQLDBConnectionPropertiesThreadSafe
    // !   fMyConnectionProps.EndCurrentThread;
    // ! end;
    property OnHttpThreadTerminate: TNotifyThreadEvent read fOnTerminate write fOnTerminate;
  end;

  ULONGLONG = Int64;
  HTTP_OPAQUE_ID = ULONGLONG;
  {$ifdef HTTPAPI20}
  HTTP_URL_GROUP_ID = HTTP_OPAQUE_ID;
  HTTP_SERVER_SESSION_ID = HTTP_OPAQUE_ID;
  {$endif HTTPAPI20}

  {/ 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
................................................................................
  protected
    /// the internal request queue
		fReqQueue: THandle;
    /// contain list of THttpApiServer cloned instances
    fClones: TObjectList;
    /// list of all registered URL (Unicode-encoded)
    fRegisteredUnicodeUrl: array of RawByteString;
    {$ifdef HTTPAPI20}
    FServerSessionID: HTTP_SERVER_SESSION_ID;
    FUrlGroupID: HTTP_URL_GROUP_ID;
    function GetServerQueueLength: Cardinal;
    procedure SetServerQueueLength(aValue: Cardinal);
    {$endif}
    /// server main loop - don't change directly
    // - will call the Request public virtual method with the appropriate
    // parameters to retrive the content
    procedure Execute; override;
    /// create a clone
    constructor CreateClone(From: THttpApiServer);
  public
................................................................................
    /// will register a compression algorithm
    // - overriden 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;
    {$ifdef HTTPAPI20}
    /// HTTP.sys requers/responce queue length
    // - default value if 1000, which sounds fine for most use cases
    // - increase this value in case of many 503 HTTP answers or if many
    // "QueueFull" messages appear in HTTP.sys log files (normaly in
    // C:\Windows\System32\LogFiles\HTTPERR\httperr*.log) - may appear with
    // thousands of concurrent clients accessing at once the same server
  	// - see @http://msdn.microsoft.com/en-us/library/windows/desktop/aa364501
    property HTTPQueueLength: Cardinal read GetServerQueueLength write SetServerQueueLength;
    {$endif}
  end;

  /// main HTTP server Thread using the standard Sockets library (e.g. WinSock)
  // - bind to a port and listen to incoming requests
  // - assign this requests to THttpServerResp threads
  // - it implements a HTTP/1.1 compatible server, according to RFC 2068 specifications
  // - if the client is also HTTP/1.1 compatible, KeepAlive connection is handled:
................................................................................
  rp := pointer(result); 
  for i := 1 to len do begin 
    c := 0; 
    j := 0; 
    while true do begin
      ch := ord(sp[j]);
      case chr(ch) of
        'A'..'Z': c := c or (ch - ord('A'));
        'a'..'z': c := c or (ch - (ord('a')-26));
        '0'..'9': c := c or (ch - (ord('0')-52));
        '+': c := c or 62;
        '/': c := c or 63;
        else
        if j=3 then begin
          rp[0] := AnsiChar(c shr 16);
          rp[1] := AnsiChar(c shr 8);
          SetLength(result, len*3-1);
          exit;
        end else begin
................................................................................
{$ifdef Win32}
function GetRemoteMacAddress(const IP: RawByteString): RawByteString;
// implements http://msdn.microsoft.com/en-us/library/aa366358
type
  TSendARP = function(DestIp: DWORD; srcIP: DWORD; pMacAddr: pointer; PhyAddrLen: Pointer): DWORD; stdcall;
var dwRemoteIP: DWORD;
    PhyAddrLen: Longword;
    pMacAddr: array [0..7] of byte;
    I: integer;
    P: PAnsiChar;
    SendARPLibHandle: THandle;
    SendARP: TSendARP;
begin
  result := '';
  SendARPLibHandle := LoadLibrary('iphlpapi.dll');
................................................................................
    hscUrlAclInfo,      
    hscMax);
  THttpServiceConfigQueryType = (
    hscQueryExact,
    hscQueryNext,
    hscQueryMax);



  HTTP_URL_CONTEXT = HTTP_OPAQUE_ID;
  HTTP_REQUEST_ID = HTTP_OPAQUE_ID;
  HTTP_CONNECTION_ID = HTTP_OPAQUE_ID;
  HTTP_RAW_CONNECTION_ID = HTTP_OPAQUE_ID;

  // Pointers overlap and point into pFullUrl. nil if not present.
  HTTP_COOKED_URL = record
................................................................................
    ParamDesc: HTTP_SERVICE_CONFIG_URLACL_PARAM;
  end;
  HTTP_SERVICE_CONFIG_URLACL_QUERY = record
    QueryDesc: THttpServiceConfigQueryType;
    KeyDesc: HTTP_SERVICE_CONFIG_URLACL_KEY;
    dwToken: DWORD;
  end;

  {$ifdef HTTPAPI20}
  HTTP_REQUEST_INFO_TYPE = (
    HttpRequestInfoTypeAuth
    );

  HTTP_AUTH_STATUS = (
    HttpAuthStatusSuccess,
    HttpAuthStatusNotAuthenticated,
    HttpAuthStatusFailure
    );

  HTTP_REQUEST_AUTH_TYPE = (
    HttpRequestAuthTypeNone,
    HttpRequestAuthTypeBasic,
    HttpRequestAuthTypeDigest,
    HttpRequestAuthTypeNTLM,
    HttpRequestAuthTypeNegotiate,
    HttpRequestAuthTypeKerberos
    );

  SECURITY_STATUS = ULONG;

  HTTP_REQUEST_AUTH_INFO = record
    AuthStatus: HTTP_AUTH_STATUS;
    SecStatus: SECURITY_STATUS;
    Flags: ULONG;
    AuthType: HTTP_REQUEST_AUTH_TYPE;
    AccessToken: THandle;
    ContextAttributes: ULONG;
    PackedContextLength: ULONG;
    PackedContextType: ULONG;
    PackedContext: pointer;
    MutualAuthDataLength: ULONG;
    pMutualAuthData: PCHAR;
  end;
  PHTTP_REQUEST_AUTH_INFO = ^HTTP_REQUEST_AUTH_INFO;

  HTTP_REQUEST_INFO = record
    InfoType: HTTP_REQUEST_INFO_TYPE;
    InfoLength: ULONG;
    pInfo: pointer;
  end;
  PHTTP_REQUEST_INFO = ^HTTP_REQUEST_INFO;
  {$endif HTTPAPI20}

  /// structure used to handle data associated with a specific request
  HTTP_REQUEST = record
    // either 0 (Only Header), either HTTP_RECEIVE_REQUEST_FLAG_COPY_BODY
    Flags: cardinal;
    // An identifier for the connection on which the request was received
    ConnectionId: HTTP_CONNECTION_ID;
................................................................................
    Headers: HTTP_REQUEST_HEADERS;
    // The total number of bytes received from network for this request
    BytesReceived: ULONGLONG;
    EntityChunkCount: word;
    pEntityChunks: pointer;
    RawConnectionId: HTTP_RAW_CONNECTION_ID;
    // SSL connection information
    pSslInfo: PHTTP_SSL_INFO;
    {$ifdef HTTPAPI20}
    xxxPadding: DWORD;
    RequestInfoCount: word;
    pRequestInfo: PHTTP_REQUEST_INFO;
    {$endif}
  end;
  PHTTP_REQUEST = ^HTTP_REQUEST;

  {$ifdef HTTPAPI20}
   HTTP_RESPONSE_INFO_TYPE = (
      HttpResponseInfoTypeMultipleKnownHeaders,
      HttpResponseInfoTypeAuthenticationProperty,
      HttpResponseInfoTypeQosProperty,
      HttpResponseInfoTypeChannelBind
      );

   HTTP_RESPONSE_INFO = record
      Typ: HTTP_RESPONSE_INFO_TYPE;
      Length: ULONG;
      pInfo: Pointer;
   end;
   PHTTP_RESPONSE_INFO = ^HTTP_RESPONSE_INFO;
  {$endif HTTPAPI20}

  HTTP_RESPONSE = object
  public
    Flags: cardinal;
    // The raw HTTP protocol version number
    Version: HTTP_VERSION;
    // The HTTP status code (e.g., 200)
................................................................................
    // The HTTP reason (e.g., "OK"). This MUST not contain non-ASCII characters
    // (i.e., all chars must be in range 0x20-0x7E).
    pReason: PAnsiChar;
    // The response headers
    Headers: HTTP_RESPONSE_HEADERS;
    // number of elements in pEntityChunks[] array
    EntityChunkCount: word;
    // pEntityChunks points to an array of EntityChunkCount HTTP_DATA_CHUNK_*
    pEntityChunks: pointer;
    {$ifdef HTTPAPI20}
    ResponseInfoCount: word;
    pResponseInfo: PHTTP_RESPONSE_INFO;
    {$endif HTTPAPI20}
    // will set both StatusCode and Reason
    // - OutStatus is a temporary variable which will be field with the
    // corresponding text
    procedure SetStatus(code: integer; var OutStatus: RawByteString);
    // will set the content of the reponse, and ContentType header
    procedure SetContent(var DataChunk: HTTP_DATA_CHUNK_INMEMORY;
      const Content: RawByteString; const ContentType: RawByteString='text/html');
................................................................................
    /// add one header value to the internal headers
    // - SetHeaders() method should have been called before to initialize the
    // internal UnknownHeaders[] array
    function AddCustomHeader(P: PAnsiChar; var UnknownHeaders: HTTP_UNKNOWN_HEADERs): PAnsiChar;
  end;
  PHTTP_RESPONSE = ^HTTP_RESPONSE;

{$ifdef HTTPAPI20}
  HTTP_PROPERTY_FLAGS = ULONG;

   HTTP_ENABLED_STATE = (
      HttpEnabledStateActive,
      HttpEnabledStateInactive
      );
   PHTTP_ENABLED_STATE = ^HTTP_ENABLED_STATE;

   HTTP_STATE_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      State: HTTP_ENABLED_STATE;
   end;
   PHTTP_STATE_INFO = ^HTTP_STATE_INFO;

   THTTP_503_RESPONSE_VERBOSITY = (
      Http503ResponseVerbosityBasic,
      Http503ResponseVerbosityLimited,
      Http503ResponseVerbosityFull
      );
   PHTTP_503_RESPONSE_VERBOSITY = ^ THTTP_503_RESPONSE_VERBOSITY;

   HTTP_QOS_SETTING_TYPE = (
      HttpQosSettingTypeBandwidth,
      HttpQosSettingTypeConnectionLimit,
      HttpQosSettingTypeFlowRate // Windows Server 2008 R2 and Windows 7 only.
      );
   PHTTP_QOS_SETTING_TYPE = ^HTTP_QOS_SETTING_TYPE;

   HTTP_QOS_SETTING_INFO = record
      QosType: HTTP_QOS_SETTING_TYPE;
      QosSetting: Pointer;
   end;
   PHTTP_QOS_SETTING_INFO = ^HTTP_QOS_SETTING_INFO;

   HTTP_CONNECTION_LIMIT_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      MaxConnections: ULONG;
   end;
   PHTTP_CONNECTION_LIMIT_INFO = ^HTTP_CONNECTION_LIMIT_INFO;

   HTTP_BANDWIDTH_LIMIT_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      MaxBandwidth: ULONG;
   end;
   PHTTP_BANDWIDTH_LIMIT_INFO = ^HTTP_BANDWIDTH_LIMIT_INFO;

const
   HTTP_MIN_ALLOWED_BANDWIDTH_THROTTLING_RATE {:ULONG} = 1024;
   HTTP_LIMIT_INFINITE {:ULONG} = ULONG(-1);

type
   HTTP_SERVICE_CONFIG_TIMEOUT_KEY = (
      IdleConnectionTimeout = 0,
      HeaderWaitTimeout
      );
   PHTTP_SERVICE_CONFIG_TIMEOUT_KEY = ^HTTP_SERVICE_CONFIG_TIMEOUT_KEY;

   HTTP_SERVICE_CONFIG_TIMEOUT_PARAM = word;
   PHTTP_SERVICE_CONFIG_TIMEOUT_PARAM = ^HTTP_SERVICE_CONFIG_TIMEOUT_PARAM;

   HTTP_SERVICE_CONFIG_TIMEOUT_SET = record
      KeyDesc: HTTP_SERVICE_CONFIG_TIMEOUT_KEY;
      ParamDesc: HTTP_SERVICE_CONFIG_TIMEOUT_PARAM;
   end;
   PHTTP_SERVICE_CONFIG_TIMEOUT_SET = ^HTTP_SERVICE_CONFIG_TIMEOUT_SET;

   HTTP_TIMEOUT_LIMIT_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      EntityBody: word;
      DrainEntityBody: word;
      RequestQueue: word;
      IdleConnection: word;
      HeaderWait: word;
      MinSendRate: word;
   end;
   PHTTP_TIMEOUT_LIMIT_INFO = ^HTTP_TIMEOUT_LIMIT_INFO;

   HTTP_LISTEN_ENDPOINT_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      EnableSharing: BOOLEAN;
   end;
   PHTTP_LISTEN_ENDPOINT_INFO = ^HTTP_LISTEN_ENDPOINT_INFO;

   HTTP_SERVER_AUTHENTICATION_DIGEST_PARAMS = record
      DomainNameLength: word;
      DomainName: PWideChar;
      RealmLength: word;
      Realm: PWideChar;
   end;
   PHTTP_SERVER_AUTHENTICATION_DIGEST_PARAMS = ^HTTP_SERVER_AUTHENTICATION_DIGEST_PARAMS;

   HTTP_SERVER_AUTHENTICATION_BASIC_PARAMS = record
      RealmLength: word;
      Realm: PWideChar;
   end;
   PHTTP_SERVER_AUTHENTICATION_BASIC_PARAMS = ^HTTP_SERVER_AUTHENTICATION_BASIC_PARAMS;

const
   HTTP_AUTH_ENABLE_BASIC        = $00000001;
   HTTP_AUTH_ENABLE_DIGEST       = $00000002;
   HTTP_AUTH_ENABLE_NTLM         = $00000004;
   HTTP_AUTH_ENABLE_NEGOTIATE    = $00000008;
   HTTP_AUTH_ENABLE_KERBEROS     = $00000010;
   HTTP_AUTH_ENABLE_ALL          = $0000001F;

   HTTP_AUTH_EX_FLAG_ENABLE_KERBEROS_CREDENTIAL_CACHING  = $01;
   HTTP_AUTH_EX_FLAG_CAPTURE_CREDENTIAL                  = $02;

type
   HTTP_SERVER_AUTHENTICATION_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      AuthSchemes: ULONG;
      ReceiveMutualAuth: BYTEBOOL;
      ReceiveContextHandle: BYTEBOOL;
      DisableNTLMCredentialCaching: BYTEBOOL;
      ExFlags: BYTE;
      DigestParams: HTTP_SERVER_AUTHENTICATION_DIGEST_PARAMS;
      BasicParams: HTTP_SERVER_AUTHENTICATION_BASIC_PARAMS;
   end;
   PHTTP_SERVER_AUTHENTICATION_INFO = ^HTTP_SERVER_AUTHENTICATION_INFO;


   HTTP_SERVICE_BINDING_TYPE=(
      HttpServiceBindingTypeNone = 0,
      HttpServiceBindingTypeW,
      HttpServiceBindingTypeA
   );

   HTTP_SERVICE_BINDING_BASE = record
      BindingType: HTTP_SERVICE_BINDING_TYPE;
   end;
   PHTTP_SERVICE_BINDING_BASE = ^HTTP_SERVICE_BINDING_BASE;

   HTTP_SERVICE_BINDING_A = record
      Base: HTTP_SERVICE_BINDING_BASE;
      Buffer: PAnsiChar;
      BufferSize: ULONG;
   end;
   PHTTP_SERVICE_BINDING_A = HTTP_SERVICE_BINDING_A;

   HTTP_SERVICE_BINDING_W = record
      Base: HTTP_SERVICE_BINDING_BASE;
      Buffer: PWCHAR;
      BufferSize: ULONG;
   end;
   PHTTP_SERVICE_BINDING_W = ^HTTP_SERVICE_BINDING_W;

   HTTP_AUTHENTICATION_HARDENING_LEVELS = (
      HttpAuthenticationHardeningLegacy = 0,
      HttpAuthenticationHardeningMedium,
      HttpAuthenticationHardeningStrict
   );

const
   HTTP_CHANNEL_BIND_PROXY = $1;
   HTTP_CHANNEL_BIND_PROXY_COHOSTING = $20;

   HTTP_CHANNEL_BIND_NO_SERVICE_NAME_CHECK = $2;
   HTTP_CHANNEL_BIND_DOTLESS_SERVICE = $4;

   HTTP_CHANNEL_BIND_SECURE_CHANNEL_TOKEN = $8;
   HTTP_CHANNEL_BIND_CLIENT_SERVICE = $10;

type
   HTTP_CHANNEL_BIND_INFO = record
      Hardening: HTTP_AUTHENTICATION_HARDENING_LEVELS;
      Flags: ULONG;
      ServiceNames: PHTTP_SERVICE_BINDING_BASE;
      NumberOfServiceNames: ULONG;
   end;
   PHTTP_CHANNEL_BIND_INFO = ^HTTP_CHANNEL_BIND_INFO;

   HTTP_REQUEST_CHANNEL_BIND_STATUS = record
      ServiceName: PHTTP_SERVICE_BINDING_BASE;
      ChannelToken: PUCHAR;
      ChannelTokenSize: ULONG;
      Flags: ULONG;
   end;
   PHTTP_REQUEST_CHANNEL_BIND_STATUS = ^HTTP_REQUEST_CHANNEL_BIND_STATUS;

const
   // Logging option flags. When used in the logging configuration alters
   // some default logging behaviour.

   // HTTP_LOGGING_FLAG_LOCAL_TIME_ROLLOVER - This flag is used to change
   //      the log file rollover to happen by local time based. By default
   //      log file rollovers happen by GMT time.
   HTTP_LOGGING_FLAG_LOCAL_TIME_ROLLOVER = 1;

   // HTTP_LOGGING_FLAG_USE_UTF8_CONVERSION - When set the unicode fields
   //      will be converted to UTF8 multibytes when writting to the log
   //      files. When this flag is not present, the local code page
   //      conversion happens.
   HTTP_LOGGING_FLAG_USE_UTF8_CONVERSION = 2;

   // HTTP_LOGGING_FLAG_LOG_ERRORS_ONLY -
   // HTTP_LOGGING_FLAG_LOG_SUCCESS_ONLY - These two flags are used to
   //      to do selective logging. If neither of them are present both
   //      types of requests will be logged. Only one these flags can be
   //      set at a time. They are mutually exclusive.
   HTTP_LOGGING_FLAG_LOG_ERRORS_ONLY = 4;
   HTTP_LOGGING_FLAG_LOG_SUCCESS_ONLY = 8;

   // The known log fields recognized/supported by HTTPAPI. Following fields
   // are used for W3C logging. Subset of them are also used for error logging
   HTTP_LOG_FIELD_DATE              = $00000001;
   HTTP_LOG_FIELD_TIME              = $00000002;
   HTTP_LOG_FIELD_CLIENT_IP         = $00000004;
   HTTP_LOG_FIELD_USER_NAME         = $00000008;
   HTTP_LOG_FIELD_SITE_NAME         = $00000010;
   HTTP_LOG_FIELD_COMPUTER_NAME     = $00000020;
   HTTP_LOG_FIELD_SERVER_IP         = $00000040;
   HTTP_LOG_FIELD_METHOD            = $00000080;
   HTTP_LOG_FIELD_URI_STEM          = $00000100;
   HTTP_LOG_FIELD_URI_QUERY         = $00000200;
   HTTP_LOG_FIELD_STATUS            = $00000400;
   HTTP_LOG_FIELD_WIN32_STATUS      = $00000800;
   HTTP_LOG_FIELD_BYTES_SENT        = $00001000;
   HTTP_LOG_FIELD_BYTES_RECV        = $00002000;
   HTTP_LOG_FIELD_TIME_TAKEN        = $00004000;
   HTTP_LOG_FIELD_SERVER_PORT       = $00008000;
   HTTP_LOG_FIELD_USER_AGENT        = $00010000;
   HTTP_LOG_FIELD_COOKIE            = $00020000;
   HTTP_LOG_FIELD_REFERER           = $00040000;
   HTTP_LOG_FIELD_VERSION           = $00080000;
   HTTP_LOG_FIELD_HOST              = $00100000;
   HTTP_LOG_FIELD_SUB_STATUS        = $00200000;

   HTTP_ALL_NON_ERROR_LOG_FIELDS = HTTP_LOG_FIELD_SUB_STATUS*2-1;

   // Fields that are used only for error logging
   HTTP_LOG_FIELD_CLIENT_PORT    = $00400000;
   HTTP_LOG_FIELD_URI            = $00800000;
   HTTP_LOG_FIELD_SITE_ID        = $01000000;
   HTTP_LOG_FIELD_REASON         = $02000000;
   HTTP_LOG_FIELD_QUEUE_NAME     = $04000000;

type
   HTTP_LOGGING_TYPE = (
      HttpLoggingTypeW3C,
      HttpLoggingTypeIIS,
      HttpLoggingTypeNCSA,
      HttpLoggingTypeRaw
      );

   HTTP_LOGGING_ROLLOVER_TYPE = (
      HttpLoggingRolloverSize,
      HttpLoggingRolloverDaily,
      HttpLoggingRolloverWeekly,
      HttpLoggingRolloverMonthly,
      HttpLoggingRolloverHourly
      );

   HTTP_LOGGING_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      LoggingFlags: ULONG;
      SoftwareName: PWideChar;
      SoftwareNameLength: word;
      DirectoryNameLength: word;
      DirectoryName: PWideChar;
      Format: HTTP_LOGGING_TYPE;
      Fields: ULONG;
      pExtFields: pointer;
      NumOfExtFields: word;
      MaxRecordSize: word;
      RolloverType: HTTP_LOGGING_ROLLOVER_TYPE;
      RolloverSize: ULONG;
      pSecurityDescriptor: PSECURITY_DESCRIPTOR;
   end;
   PHTTP_LOGGING_INFO = ^HTTP_LOGGING_INFO;

   HTTP_LOG_DATA_TYPE = (
      HttpLogDataTypeFields
      );

   HTTP_LOG_DATA = record
      Typ: HTTP_LOG_DATA_TYPE
   end;
   PHTTP_LOG_DATA = ^HTTP_LOG_DATA;

   HTTP_LOG_FIELDS_DATA = record
      Base: HTTP_LOG_DATA;
      UserNameLength: word;
      UriStemLength: word;
      ClientIpLength: word;
      ServerNameLength: word;
      ServiceNameLength: word;
      ServerIpLength: word;
      MethodLength: word;
      UriQueryLength: word;
      HostLength: word;
      UserAgentLength: word;
      CookieLength: word;
      ReferrerLength: word;
      UserName: PWideChar;
      UriStem: PWideChar;
      ClientIp: PAnsiChar;
      ServerName: PAnsiChar;
      ServiceName: PAnsiChar;
      ServerIp: PAnsiChar;
      Method: PAnsiChar;
      UriQuery: PAnsiChar;
      Host: PAnsiChar;
      UserAgent: PAnsiChar;
      Cookie: PAnsiChar;
      Referrer: PAnsiChar;
      ServerPort: word;
      ProtocolStatus: word;
      Win32Status: ULONG;
      MethodNum: THttpVerb;
      SubStatus: word;
   end;
   PHTTP_LOG_FIELDS_DATA = ^HTTP_LOG_FIELDS_DATA;

   HTTP_BINDING_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      RequestQueueHandle: THandle;
   end;

   HTTP_PROTECTION_LEVEL_TYPE=(
      HttpProtectionLevelUnrestricted,
      HttpProtectionLevelEdgeRestricted,
      HttpProtectionLevelRestricted
   );

   HTTP_PROTECTION_LEVEL_INFO = record
      Flags: HTTP_PROPERTY_FLAGS;
      Level: HTTP_PROTECTION_LEVEL_TYPE;
   end;
   PHTTP_PROTECTION_LEVEL_INFO = ^HTTP_PROTECTION_LEVEL_INFO;
{$endif HTTPAPI20}

const
  HTTP_VERSION_UNKNOWN: HTTP_VERSION = (MajorVersion: 0; MinorVersion: 0);
  HTTP_VERSION_0_9: HTTP_VERSION = (MajorVersion: 0; MinorVersion: 9);
  HTTP_VERSION_1_0: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 0);
  HTTP_VERSION_1_1: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 1);
  HTTPAPI_VERSION_1: HTTP_VERSION = (MajorVersion: 1; MinorVersion: 0);
  HTTPAPI_VERSION_2: HTTP_VERSION = (MajorVersion: 2; MinorVersion: 0);
................................................................................
  HTTP_RECEIVE_REQUEST_FLAG_COPY_BODY = 1;
  // there is more entity body to be read for this request
  HTTP_REQUEST_FLAG_MORE_ENTITY_BODY_EXISTS = 1;
  // initialization for applications that use the HTTP Server API
  HTTP_INITIALIZE_SERVER = 1;
  // initialization for applications that use the HTTP configuration functions
  HTTP_INITIALIZE_CONFIG = 2;
  {$ifdef HTTPAPI20}
  HTTP_URL_FLAG_REMOVE_ALL = 1;
  {$endif}
  // see http://msdn.microsoft.com/en-us/library/windows/desktop/aa364496
  HTTP_RECEIVE_REQUEST_ENTITY_BODY_FLAG_FILL_BUFFER = 1;
  // see http://msdn.microsoft.com/en-us/library/windows/desktop/aa364499
  HTTP_SEND_RESPONSE_FLAG_PROCESS_RANGES = 1;

  KNOWNHEADERS_NAME: array[reqCacheControl..reqUserAgent] of string[19] = (
    'Cache-Control','Connection','Date','Keep-Alive','Pragma','Trailer',
................................................................................
  {$ifopt C+}         
  inc(D,2);
  assert(D-pointer(result)=L);
  {$endif}
end;

type
  {$ifdef HTTPAPI20}
  HTTP_SERVER_PROPERTY = (
      HttpServerAuthenticationProperty,
      HttpServerLoggingProperty,
      HttpServerQosProperty,
      HttpServerTimeoutsProperty,
      HttpServerQueueLengthProperty,
      HttpServerStateProperty,
      HttpServer503VerbosityProperty,
      HttpServerBindingProperty,
      HttpServerExtendedAuthenticationProperty,
      HttpServerListenEndpointProperty,
      HttpServerChannelBindProperty,
      HttpServerProtectionLevelProperty
  );
  {$endif HTTPAPI20}
  
  THttpAPI = packed record
    Module: THandle;
    {/ The HttpInitialize function initializes the HTTP Server API driver, starts it,
    if it has not already been started, and allocates data structures for the
    calling application to support response-queue creation and other operations.
    Call this function before calling any other functions in the HTTP Server API. }
    Initialize: function(Version: HTTP_VERSION; Flags: cardinal;
................................................................................
      ConfigId: THttpServiceConfigID; pConfigInformation: pointer;
      ConfigInformationLength: ULONG; pOverlapped: pointer=nil): HRESULT; stdcall;
    {/ deletes specified data, such as IP addresses or SSL Certificates, from the
      HTTP Server API configuration store}
    DeleteServiceConfiguration: function(ServiceHandle: THandle;
      ConfigId: THttpServiceConfigID; pConfigInformation: pointer;
      ConfigInformationLength: ULONG; pOverlapped: pointer=nil): HRESULT; stdcall;
    /// removes from the HTTP Server API cache associated with a given request
    // queue all response fragments that have a name whose site portion matches
    // a specified UrlPrefix
    FlushResponseCache: function(ReqQueueHandle: THandle; pUrlPrefix: PWideChar; Flags: ULONG;
      pOverlapped: POverlapped): ULONG; stdcall;
    {$ifdef HTTPAPI20}
    /// cancels a specified request
    CancelHttpRequest: function(ReqQueueHandle: THandle; RequestId: HTTP_REQUEST_ID;
      pOverlapped: pointer = nil): HRESULT; stdcall;
    /// creates a server session for the specified HTTP API version
    CreateServerSession: function(Version: HTTP_VERSION;
      var ServerSessionId: HTTP_SERVER_SESSION_ID; Reserved: ULONG = 0): HRESULT; stdcall;
    /// deletes the server session identified by the server session ID
    CloseServerSession: function(ServerSessionId: HTTP_SERVER_SESSION_ID): HRESULT; stdcall;
    ///  creates a new request queue or opens an existing request queue
    // - replaces the HTTP version 1.0 CreateHttpHandle() function
    CreateRequestQueue: function(Version: HTTP_VERSION;
      pName: PWideChar; pSecurityAttributes: Pointer;
      Flags: ULONG; var ReqQueueHandle: THandle): HRESULT; stdcall;
    /// sets a new server session property or modifies an existing property
    // on the specified server session
    SetServerSessionProperty: function(ServerSessionId: HTTP_SERVER_SESSION_ID;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG): HRESULT; stdcall;
    /// queries a server property on the specified server session
    QueryServerSessionProperty: function(ServerSessionId: HTTP_SERVER_SESSION_ID;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG; pReturnLength: PULONG = nil): HRESULT; stdcall;
    /// creates a URL Group under the specified server session
    CreateUrlGroup: function(ServerSessionId: HTTP_SERVER_SESSION_ID;
      var UrlGroupId: HTTP_URL_GROUP_ID; Reserved: ULONG = 0): HRESULT; stdcall;
    /// closes the URL Group identified by the URL Group ID
    // - this call also removes all of the URLs that are associated with
    // the URL Group
    CloseUrlGroup: function(UrlGroupId: HTTP_URL_GROUP_ID): HRESULT; stdcall;
    /// adds the specified URL to the URL Group identified by the URL Group ID
    // - this function replaces the HTTP version 1.0 AddUrl() function
    AddUrlToUrlGroup: function(UrlGroupId: HTTP_URL_GROUP_ID;
      pFullyQualifiedUrl: PWideChar; UrlContext: HTTP_URL_CONTEXT = 0;
      Reserved: ULONG = 0): HRESULT; stdcall;
    /// removes the specified URL from the group identified by the URL Group ID
    // - this function removes one, or all, of the URLs from the group
    // - it replaces the HTTP version 1.0 RemoveUrl() function
    RemoveUrlFromUrlGroup: function(UrlGroupId: HTTP_URL_GROUP_ID;
      pFullyQualifiedUrl: PWideChar; Flags: ULONG = HTTP_URL_FLAG_REMOVE_ALL): HRESULT; stdcall;
    /// sets a new property or modifies an existing property on the specified
    // URL Group
    SetUrlGroupProperty: function(UrlGroupId: HTTP_URL_GROUP_ID;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG): HRESULT; stdcall;
    /// queries a property on the specified URL Group
    QueryUrlGroupProperty: function(UrlGroupId: HTTP_URL_GROUP_ID;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG; pReturnLength: PULONG = nil): HRESULT; stdcall;
    /// sets a new property or modifies an existing property on the request
    // queue identified by the specified handle
    SetRequestQueueProperty: function(ReqQueueHandle: THandle;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG; Reserved: ULONG; pReserved: Pointer): HRESULT; stdcall;
    ///  queries a property of the request queue identified by the
    // specified handle
    QueryRequestQueueProperty: function(ReqQueueHandle: THandle;
      aProperty: HTTP_SERVER_PROPERTY; pPropertyInformation: Pointer;
      PropertyInformationLength: ULONG; Reserved: ULONG; pReturnLength: PULONG; pReserved: Pointer): HRESULT; stdcall;
    {$endif}
  end;

var
  Http: THttpAPI;

type
  THttpAPIs = (hInitialize,hTerminate,hCreateHttpHandle,
    hAddUrl, hRemoveUrl, hReceiveHttpRequest,
    hSendHttpResponse, hReceiveRequestEntityBody,
    hSetServiceConfiguration, hDeleteServiceConfiguration, hFlushResponseCache
    {$ifdef HTTPAPI20} ,
    hCancelHttpRequest,
    hCreateServerSession, hCloseServerSession,
    hCreateRequestQueue,
    hSetServerSessionProperty, hQueryServerSessionProperty,
    hCreateUrlGroup, hCloseUrlGroup,
    hAddUrlToUrlGroup, hRemoveUrlFromUrlGroup,
    hSetUrlGroupProperty, hQueryUrlGroupProperty,
    hSetRequestQueueProperty, hQueryRequestQueueProperty
    {$endif HTTPAPI20}
    );
const
  HttpNames: array[THttpAPIs] of PChar = (
    'HttpInitialize','HttpTerminate','HttpCreateHttpHandle',
    'HttpAddUrl', 'HttpRemoveUrl', 'HttpReceiveHttpRequest',
    'HttpSendHttpResponse', 'HttpReceiveRequestEntityBody',
    'HttpSetServiceConfiguration', 'HttpDeleteServiceConfiguration',
    'HttpFlushResponseCache'
    {$ifdef HTTPAPI20} , 
    'HttpCancelHttpRequest',
    'HttpCreateServerSession', 'HttpCloseServerSession',
    'HttpCreateRequestQueue',
    'HttpSetServerSessionProperty', 'HttpQueryServerSessionProperty',
    'HttpCreateUrlGroup', 'HttpCloseUrlGroup',
    'HttpAddUrlToUrlGroup', 'HttpRemoveUrlFromUrlGroup',
    'HttpSetUrlGroupProperty', 'HttpQueryUrlGroupProperty',
    'HttpSetRequestQueueProperty', 'HttpQueryRequestQueueProperty'
    {$endif HTTPAPI20}
    );

function RegURL(aRoot, aPort: RawByteString; Https: boolean;
  aDomainName: RawByteString): RawByteString;
const Prefix: array[boolean] of RawByteString = ('http://','https://');
begin
  if aPort='' then
    aPort := '80';
................................................................................

type
  EHttpApiServer = class(Exception)
  protected
    fLastError: integer;
    fLastApi: THttpAPIs;
  public
    class procedure RaiseOnError(api: THttpAPIs; Error: integer);
    constructor Create(api: THttpAPIs; Error: integer);
    property LastApi: THttpAPIs read fLastApi;
    property LastError: integer read fLastError;
  end;

class procedure EHttpApiServer.RaiseOnError(api: THttpAPIs; Error: integer);
begin
  if Error<>NO_ERROR then
    raise self.Create(api,Error);
end;

constructor EHttpApiServer.Create(api: THttpAPIs; Error: integer);
begin
  fLastError := Error;
  fLastApi := api;
  inherited CreateFmt('%s failed: %s (%d)',
    [HttpNames[api],SysErrorMessage(Error),Error])
................................................................................
  if (Self=nil) or (fReqQueue=0) or (Http.Module=0) then
    exit;
  s := RegURL(aRoot, aPort, Https, aDomainName);
  if s='' then
    exit; // invalid parameters
  if aRegisterURI then
    AddUrlAuthorize(aRoot,aPort,Https,aDomainName);
  {$ifdef HTTPAPI20}
    result := Http.AddUrlToUrlGroup(FUrlGroupID,pointer(s));
  {$else}
    result := Http.AddUrl(fReqQueue,pointer(s));
  {$endif}
  if result=NO_ERROR then begin
    n := length(fRegisteredUnicodeUrl);
    SetLength(fRegisteredUnicodeUrl,n+1);
    fRegisteredUnicodeUrl[n] := s;
  end;
end;

................................................................................
    Config: HTTP_SERVICE_CONFIG_URLACL_SET;
begin
  try
    HttpApiInitialize;
    prefix := RegURL(aRoot, aPort, Https, aDomainName);
    if prefix='' then
      result := 'Invalid parameters' else begin
      EHttpApiServer.RaiseOnError(hInitialize,Http.Initialize(
        HTTPAPI_VERSION_1,HTTP_INITIALIZE_CONFIG));

      try
        fillchar(Config,sizeof(Config),0);
        Config.KeyDesc.pUrlPrefix := pointer(prefix);
        // first delete any existing information
        Error := Http.DeleteServiceConfiguration(0,hscUrlAclInfo,@Config,Sizeof(Config));
        // then add authorization rule
        if not OnlyDelete then begin
................................................................................
  if ChildThreadCount>256 then
    ChildThreadCount := 256; // not worth adding
  for i := 1 to ChildThreadCount do
    fClones.Add(THttpApiServer.CreateClone(self));
end;

constructor THttpApiServer.Create(CreateSuspended: Boolean);
{$ifdef HTTPAPI20}
var bindInfo: HTTP_BINDING_INFO;
{$endif}
begin
  inherited Create(true);
  HttpApiInitialize; // will raise an exception in case of failure
  EHttpApiServer.RaiseOnError(hInitialize,Http.Initialize(
    {$ifdef HTTPAPI20}HTTPAPI_VERSION_2{$else}HTTPAPI_VERSION_1{$endif},
    HTTP_INITIALIZE_SERVER));


  {$ifdef HTTPAPI20}
  EHttpApiServer.RaiseOnError(hCreateServerSession,Http.CreateServerSession(
    HTTPAPI_VERSION_2,FServerSessionID));
  EHttpApiServer.RaiseOnError(hCreateUrlGroup,Http.CreateUrlGroup(
    FServerSessionID,FUrlGroupID));
  EHttpApiServer.RaiseOnError(hCreateRequestQueue,Http.CreateRequestQueue(
    HTTPAPI_VERSION_2,nil,nil,0,fReqQueue));
  bindInfo.Flags := 1;
  bindInfo.RequestQueueHandle := FReqQueue;
  EHttpApiServer.RaiseOnError(hSetUrlGroupProperty,Http.SetUrlGroupProperty(
    FUrlGroupID,HttpServerBindingProperty,@bindInfo,SizeOf(bindInfo)));
  {$else}
  EHttpApiServer.RaiseOnError(hCreateHttpHandle,Http.CreateHttpHandle(fReqQueue));


  {$endif}
  fClones := TObjectList.Create;
  if not CreateSuspended then
    Suspended := False;
end;

constructor THttpApiServer.CreateClone(From: THttpApiServer);
begin
................................................................................
end;

destructor THttpApiServer.Destroy;
var i: Integer;
begin
  if (fClones<>nil) and (Http.Module<>0) then begin  // fClones=nil for clone threads
    if fReqQueue<>0 then begin
      {$ifdef HTTPAPI20}
         for i := 0 to high(fRegisteredUnicodeUrl) do
            Http.RemoveUrlFromUrlGroup(FUrlGroupID, Pointer(fRegisteredUnicodeUrl[i]));
         if FUrlGroupID<>0 then
            Http.CloseUrlGroup(FUrlGroupID);
         CloseHandle(FReqQueue); // will break all THttpApi2Server.Execute
         if FServerSessionID<>0 then
            Http.CloseServerSession(FServerSessionID);
      {$else}
        for i := 0 to high(fRegisteredUnicodeUrl) do
          Http.RemoveUrl(fReqQueue,pointer(fRegisteredUnicodeUrl[i]));
        CloseHandle(fReqQueue); // will break all THttpApiServer.Execute
      {$endif}
      fReqQueue := 0;
      Http.Terminate(HTTP_INITIALIZE_SERVER);
    end;
    FreeAndNil(fClones);
  end;
  inherited Destroy;
end;
................................................................................
    repeat
      // retrieve next pending request, and read its headers
      fillchar(Req^,sizeof(HTTP_REQUEST),0);
      Err := Http.ReceiveHttpRequest(fReqQueue,ReqID,0,Req^,length(ReqBuf),bytesRead);
      if Terminated then
        break;
      case Err of
      NO_ERROR:
      try
        // parse method and headers
        Context.fURL := Req^.pRawUrl;
        if Req^.Verb in [low(VERB_TEXT)..high(VERB_TEXT)] then
          Context.fMethod := VERB_TEXT[Req^.Verb] else
          SetString(Context.fMethod,Req^.pUnknownVerb,Req^.UnknownVerbLength);
        with Req^.Headers.KnownHeaders[reqContentType] do
          SetString(Context.fInContentType,pRawValue,RawValueLength);
        with Req^.Headers.KnownHeaders[reqAcceptEncoding] do
          SetString(InAcceptEncoding,pRawValue,RawValueLength);
        InCompressAccept := ComputeContentEncoding(fCompress,pointer(InAcceptEncoding));
        Context.fInHeaders := RetrieveHeaders(Req^);
        // retrieve body
        Context.fInContent := '';
        if HTTP_REQUEST_FLAG_MORE_ENTITY_BODY_EXISTS and Req^.Flags<>0 then begin
          with Req^.Headers.KnownHeaders[reqContentLength] do
            InContentLength := GetCardinal(pRawValue,pRawValue+RawValueLength);
          if InContentLength<>0 then begin
            SetLength(Context.fInContent,InContentLength);
            BufRead := pointer(Context.InContent);
            InContentLengthRead := 0;
            repeat
              BytesRead := 0;
              if Win32MajorVersion>5 then // speed optimization for Vista+
                flags := HTTP_RECEIVE_REQUEST_ENTITY_BODY_FLAG_FILL_BUFFER else
                flags := 0;
              Err := Http.ReceiveRequestEntityBody(fReqQueue,Req^.RequestId,flags,
                BufRead,InContentLength-InContentLengthRead,BytesRead);
              inc(InContentLengthRead,BytesRead);
              if Err=ERROR_HANDLE_EOF then begin
                if InContentLengthRead<InContentLength then
                  SetLength(Context.fInContent,InContentLengthRead);
                Err := NO_ERROR;
                break; // should loop until returns ERROR_HANDLE_EOF
              end;
              if Err<>NO_ERROR then
                break;
              inc(BufRead,BytesRead);
            until InContentLengthRead=InContentLength;
            if Err<>NO_ERROR then begin
              SendError(406,SysErrorMessage(Err));
              continue;
            end;
            with Req^.Headers.KnownHeaders[reqContentEncoding] do
            if RawValueLength<>0 then begin
              SetString(InContentEncoding,pRawValue,RawValueLength);
              for i := 0 to high(fCompress) do
                if fCompress[i].Name=InContentEncoding then begin
                  fCompress[i].Func(Context.fInContent,false); // uncompress
                  break;
                end;
            end;
          end;
        end;
        try
          // compute response
          Context.OutContent := '';
          Context.OutContentType := '';
          Context.OutCustomHeaders := '';
          fillchar(Resp^,sizeof(Resp^),0);
          Resp^.SetStatus(Request(Context),OutStatus);
          if Terminated then
            exit;
          // send response
          Resp^.Version := Req^.Version;
          Resp^.SetHeaders(pointer(Context.OutCustomHeaders),Heads);
          if fCompressAcceptEncoding<>'' then
            Resp^.AddCustomHeader(pointer(fCompressAcceptEncoding),Heads);
          if Context.OutContentType=HTTP_RESP_STATICFILE then begin
            // response is file -> let http.sys serve it (OutContent is UTF-8)
            FileHandle := FileOpen(
              {$ifdef UNICODE}UTF8ToUnicodeString{$else}Utf8ToAnsi{$endif}(Context.OutContent),
              fmOpenRead or fmShareDenyNone);
            if PtrInt(FileHandle)<0 then begin
              SendError(404,SysErrorMessage(GetLastError));
              continue;
            end;
            try
              DataChunkFile.DataChunkType := hctFromFileHandle;
              DataChunkFile.FileHandle := FileHandle;
              flags := 0;
              DataChunkFile.ByteRange.StartingOffset.QuadPart := 0;
              Int64(DataChunkFile.ByteRange.Length.QuadPart) := -1; // to eof
              with Req^.Headers.KnownHeaders[reqRange] do
                if (RawValueLength>6) and IdemPChar(pRawValue,'BYTES=') and
                   (pRawValue[6] in ['0'..'9']) then begin
                  SetString(Range,pRawValue+6,RawValueLength-6); // need #0 end
                  R := pointer(Range);
                  RangeStart := GetNextItemUInt64(R);
                  if R^='-' then begin
                    inc(R);
                    flags := HTTP_SEND_RESPONSE_FLAG_PROCESS_RANGES;
                    DataChunkFile.ByteRange.StartingOffset := ULARGE_INTEGER(RangeStart);
                    if R^ in ['0'..'9'] then begin
                      RangeLength := GetNextItemUInt64(R)-RangeStart+1;
                      if RangeLength>=0 then // "bytes=0-499" -> start=0, len=500
                        DataChunkFile.ByteRange.Length := ULARGE_INTEGER(RangeLength);
                    end; // "bytes=1000-" -> start=1000, len=-1 (to eof)
                  end;
                end;
              Resp^.EntityChunkCount := 1;
              Resp^.pEntityChunks := @DataChunkFile;
              Http.SendHttpResponse(fReqQueue,Req^.RequestId,flags,Resp^,nil,bytesSent);
            finally
              FileClose(FileHandle);
            end;
          end else begin
            // response is in OutContent -> sent it from memory
            if fCompress<>nil then begin
              with Resp^.Headers.KnownHeaders[reqContentEncoding] do
              if RawValueLength=0 then begin
                // no previous encoding -> try if any compression
                OutContentEncoding := CompressDataAndGetHeaders(InCompressAccept,
                  fCompress,Context.OutContentType,Context.fOutContent);
                pRawValue := pointer(OutContentEncoding);
                RawValueLength := length(OutContentEncoding);
              end;
            end;
            Resp^.SetContent(DataChunkInMemory,Context.OutContent,Context.OutContentType);
            EHttpApiServer.RaiseOnError(hSendHttpResponse,Http.SendHttpResponse(
              fReqQueue,Req^.RequestId,0,Resp^,nil,bytesSent));


          end;
        except
          on E: Exception do
            // handle any exception raised during process: show must go on!
            if not E.InheritsFrom(EHttpApiServer) or // ensure still connected
               (EHttpApiServer(E).LastError<>HTTPAPI_ERROR_NONEXISTENTCONNECTION) then
              SendError(500,E.Message,E);
        end;
      finally    
        ReqId := 0; // reset Request ID to handle the next pending request
      end;
      ERROR_MORE_DATA: begin
        // input buffer was too small to hold the request headers
        // -> increase buffer size and call the API again
        ReqID := Req^.RequestId;
        SetLength(ReqBuf,bytesRead);
        Req := pointer(ReqBuf);
      end;
      ERROR_CONNECTION_INVALID:
        if ReqID=0 then
          break else
          // TCP connection was corrupted by the peer -> ignore + next request
          ReqID := 0;
      else break; // unhandled Err value
      end;
    until Terminated;
  finally
    Context.Free;
  end;
end;

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

{$ifdef HTTPAPI20}
function THttpApiServer.GetServerQueueLength: Cardinal;
var
  aError: HRESULT;
  returnLength: ULONG;
begin
  if fReqQueue = 0 then begin
    result := 0;
    exit;
  end;
  aError := Http.QueryRequestQueueProperty(fReqQueue, HttpServerQueueLengthProperty, @Result, sizeof(Result),
    0, @returnLength, nil);
  if aError<>NO_ERROR then
    raise EHttpApiServer.Create(hQueryRequestQueueProperty, Error);
end;

procedure THttpApiServer.SetServerQueueLength(aValue: Cardinal);
var
  aError: HRESULT;
begin
  if fReqQueue = 0 then
    exit;

  aError := Http.SetRequestQueueProperty(fReqQueue, HttpServerQueueLengthProperty, @aValue, sizeof(aValue), 0, nil);
  if aError<>NO_ERROR then
    raise EHttpApiServer.Create(hQueryRequestQueueProperty, Error);
end;
{$endif HTTPAPI20}

{ HTTP_RESPONSE }

procedure HTTP_RESPONSE.SetContent(var DataChunk: HTTP_DATA_CHUNK_INMEMORY;
  const Content, ContentType: RawByteString);
begin
  fillchar(DataChunk,sizeof(DataChunk),0);
................................................................................

{$endif}


initialization
  {$ifdef DEBUGAPI}AllocConsole;{$endif}
  {$ifdef CPU64}
  Assert((sizeof(HTTP_REQUEST)={$ifdef HTTPAPI20}864{$else}848{$endif}) and
    (sizeof(HTTP_SSL_INFO)=48) and
    (sizeof(HTTP_DATA_CHUNK_INMEMORY)=32) and
    (sizeof(HTTP_DATA_CHUNK_FILEHANDLE)=32) and
    (sizeof(HTTP_REQUEST_HEADERS)=688) and
    (sizeof(HTTP_RESPONSE_HEADERS)=512) and
    (sizeof(HTTP_COOKED_URL)=40) and
    (sizeof(HTTP_RESPONSE)={$ifdef HTTPAPI20}568{$else}552{$endif}) and
    (ord(reqUserAgent)=40) and
    (ord(respLocation)=23) and (sizeof(THttpHeader)=4));
  {$else}
  Assert((sizeof(HTTP_REQUEST)={$ifdef HTTPAPI20}472{$else}464{$endif}) and
    (sizeof(HTTP_SSL_INFO)=28) and
    (sizeof(HTTP_DATA_CHUNK_INMEMORY)=24) and
    (sizeof(HTTP_DATA_CHUNK_FILEHANDLE)=32) and
    (sizeof(HTTP_REQUEST_HEADERS)=344) and
    (sizeof(HTTP_RESPONSE_HEADERS)=256) and
    (sizeof(HTTP_COOKED_URL)=24) and
    (sizeof(HTTP_RESPONSE)={$ifdef HTTPAPI20}288{$else}280{$endif}) and
    (ord(reqUserAgent)=40) and
    (ord(respLocation)=23) and (sizeof(THttpHeader)=4));
  {$endif}
  if InitSocketInterface then
    WSAStartup(WinsockLevel, WsaDataOnce) else
    fillchar(WsaDataOnce,sizeof(WsaDataOnce),0);

finalization

  // undefined by default: BCC32 -pr fastcall (=Delphi resgister) is broken
  // because of issues with BCC32 itself, or some obfuscated calls in source?
  // -> allow to use external SQlite3 libraries in addition to static version
  {.$define SQLITE3_FASTCALL}
{$endif}

  // undefined by default: BCC32 -pr fastcall (=Delphi resgister) is broken
  // because of issues with BCC32 itself, or some obfuscated calls in source?
  // -> allow to use external SQlite3 libraries in addition to static version
  {.$define SQLITE3_FASTCALL}
{$endif}


// for SynCrtSock unit, you may define it for Windows XP or Windows Server 2003,
// which sadly do not support HTTP API 2.0 and its features
{.$define NOHTTPAPI20}