and Server over HTTP/1.1 - there will be no speed penalty on the
        server side, whereas deflate would use much more CPU
      - by default, will handle SynLZ compression for TSQLite3HttpServer
      - can make TCP/IP stream not HTTP compliant (against antivirus slowdown)
      - new TSQLite3HttpClientWinINet class, using WinINet API (very slow)
      - new TSQLite3HttpClientWinHTTP class, using WinHTTP API (fast and stable):
        this class should be considered to be used instead of TSQLite3HttpClient
        for any HTTP/1.1 client connection 
}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
  - SynLZ is much faster than deflate/zip, so is preferred
................................................................................
  - not defined by default - should be set globally to the project conditionals } 

{$define USEWININET}
// define this to define TSQLite3HttpClientWinHTTP or TSQLite3HttpClientWinINet
// - TSQLite3HttpClientWinHTTP was found out to be the faster implementation

uses

  Windows,



  SysUtils,
{$ifdef COMPRESSDEFLATE}
  SynZip,
{$endif}
{$ifdef COMPRESSSYNLZ}
  SynLZ,
{$endif}
................................................................................
    destructor Destroy; override;
  end;

{$ifdef USEWININET}
  /// HTTP/1.1 RESTFUL JSON SQLite3 Client abstract class using either WinINet
  // or TWinHTTP API
  // - not to be called directly, but via TSQLite3HttpClientWinINet or (even
  // prefered) TSQLite3HttpClientWinHTTP 
  TSQLite3HttpClientWinGeneric = class(TSQLite3HttpClientGeneric)
  protected
    fWinAPI: TWinHttpAPI;
    /// call fWinAPI.Request()
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); virtual; abstract;
    function InternalRequest(const url, method: RawUTF8;
      var Header, Data, DataType: RawUTF8): Int64Rec; override;
................................................................................
  TSQLite3HttpClientWinINet = class(TSQLite3HttpClientWinGeneric)
  protected
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); override;
  end;

  /// HTTP/1.1 RESTFUL JSON SQLite3 Client class using WinHTTP API
  // - has a common behavior as TSQLite3HttpClient and seems to be faster
  // (especially over a network) and will retrieve the current proxy settings
  // (if available) - so it seems to be the class to use in your programs
  // - this class is able to connect via the secure HTTPS protocol
  // - by design, the WinHTTP API can be used from a service or a server
  TSQLite3HttpClientWinHTTP = class(TSQLite3HttpClientWinGeneric)
  protected
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); override;
  end;
{$endif}


implementation


{ TSQLite3HttpClientGeneric }

function TSQLite3HttpClientGeneric.URI(const url, method: RawUTF8; Resp,
................................................................................
end;

destructor TSQLite3HttpClient.Destroy;
begin
  fSocket.Free;
  inherited Destroy;
end;


function TSQLite3HttpClient.InternalRequest(const url, method: RawUTF8;
  var Header, Data, DataType: RawUTF8): Int64Rec;
begin
  result.Lo := fSocket.Request(url,method,KeepAliveMS,Header,Data,DataType,false);
  result.Hi := GetCardinal(pointer(fSocket.HeaderValue('Server-InternalState')));
  Header := fSocket.HeaderGetText;

        and Server over HTTP/1.1 - there will be no speed penalty on the
        server side, whereas deflate would use much more CPU
      - by default, will handle SynLZ compression for TSQLite3HttpServer
      - can make TCP/IP stream not HTTP compliant (against antivirus slowdown)
      - new TSQLite3HttpClientWinINet class, using WinINet API (very slow)
      - new TSQLite3HttpClientWinHTTP class, using WinHTTP API (fast and stable):
        this class should be considered to be used instead of TSQLite3HttpClient
        for any HTTP/1.1 client connection over a network 
}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
  - SynLZ is much faster than deflate/zip, so is preferred
................................................................................
  - not defined by default - should be set globally to the project conditionals } 

{$define USEWININET}
// define this to define TSQLite3HttpClientWinHTTP or TSQLite3HttpClientWinINet
// - TSQLite3HttpClientWinHTTP was found out to be the faster implementation

uses
{$ifdef MSWINDOWS}
  Windows,
{$else}
  {$undef USEWININET}
{$endif}
  SysUtils,
{$ifdef COMPRESSDEFLATE}
  SynZip,
{$endif}
{$ifdef COMPRESSSYNLZ}
  SynLZ,
{$endif}
................................................................................
    destructor Destroy; override;
  end;

{$ifdef USEWININET}
  /// HTTP/1.1 RESTFUL JSON SQLite3 Client abstract class using either WinINet
  // or TWinHTTP API
  // - not to be called directly, but via TSQLite3HttpClientWinINet or (even
  // better) TSQLite3HttpClientWinHTTP 
  TSQLite3HttpClientWinGeneric = class(TSQLite3HttpClientGeneric)
  protected
    fWinAPI: TWinHttpAPI;
    /// call fWinAPI.Request()
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); virtual; abstract;
    function InternalRequest(const url, method: RawUTF8;
      var Header, Data, DataType: RawUTF8): Int64Rec; override;
................................................................................
  TSQLite3HttpClientWinINet = class(TSQLite3HttpClientWinGeneric)
  protected
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); override;
  end;

  /// HTTP/1.1 RESTFUL JSON SQLite3 Client class using WinHTTP API
  // - has a common behavior as TSQLite3HttpClient and seems to be faster
  // over a network, and will retrieve the current proxy settings
  // (if available) - so it seems to be the class to use in your programs
  // - this class is able to connect via the secure HTTPS protocol
  // - by design, the WinHTTP API can be used from a service or a server
  TSQLite3HttpClientWinHTTP = class(TSQLite3HttpClientWinGeneric)
  protected
    procedure InternalCreate(const aServer, aPort: AnsiString; aHttps: boolean); override;
  end;
{$endif}


implementation


{ TSQLite3HttpClientGeneric }

function TSQLite3HttpClientGeneric.URI(const url, method: RawUTF8; Resp,
................................................................................
end;

destructor TSQLite3HttpClient.Destroy;
begin
  fSocket.Free;
  inherited Destroy;
end;


function TSQLite3HttpClient.InternalRequest(const url, method: RawUTF8;
  var Header, Data, DataType: RawUTF8): Int64Rec;
begin
  result.Lo := fSocket.Request(url,method,KeepAliveMS,Header,Data,DataType,false);
  result.Hi := GetCardinal(pointer(fSocket.HeaderValue('Server-InternalState')));
  Header := fSocket.HeaderGetText;

    /// the event handled called by the default implementation of the
    // virtual Request method
    // - warning: this process must be thread-safe (can be called by several
    // threads simultaneously)
    property OnRequest: TOnHttpServerRequest read fOnRequest write fOnRequest;
  end;

  /// the fastest unicode string available
  {$ifndef UNICODE}
  UnicodeString = WideString;
  {$endif}
  
  {{ 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.
................................................................................
   applications running simultaneously. }
  THttpApiServer = class(THttpServerGeneric)
  protected
    /// the internal request queue
		fReqQueue: THandle;
    /// contain clones list
    fClones: TObjectList;
    /// list of all registered URL
    fRegisteredUrl: array of UnicodeString;
    /// 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
................................................................................
    fCompressHeader: THttpSocketCompressSet;
    /// used for internal connection
    fSession, fConnection, fRequest: HINTERNET;
    procedure InternalConnect; virtual; abstract;
    procedure InternalRequest(const method, aURL: TSockData); virtual; abstract;
    procedure InternalCloseRequest; virtual; abstract;
    procedure InternalAddHeader(const hdr: TSockData); virtual; abstract;
    function InternalSendRequest(const aData: TSockData;  var OutHeader,
      OutData, OutDataEncoding, InAcceptEncoding: TSockData): integer; virtual; abstract;


  public
    /// connect to http://aServer:aPort or https://aServer:aPort
    constructor Create(const aServer, aPort: AnsiString; aHttps: boolean);
    /// low-level HTTP/1.1 request
    // - after an Create(server,port), return 200,202,204 if OK,
    // http status error otherwize
    function Request(const url, method: TSockData; KeepAlive: cardinal;
................................................................................
  TWinINet = class(TWinHttpAPI)
  protected
    // those internal methods will raise an EWinINet exception on error
    procedure InternalConnect; override;
    procedure InternalRequest(const method, aURL: TSockData); override;
    procedure InternalCloseRequest; override;
    procedure InternalAddHeader(const hdr: TSockData); override;
    function InternalSendRequest(const aData: TSockData; var OutHeader,
      OutData, OutDataEncoding, InAcceptEncoding: TSockData): integer; override;


  public
    /// relase the connection
    destructor Destroy; override;
  end;

  /// WinINet exception type
  EWinINet = class(Exception)
................................................................................
  TWinHTTP = class(TWinHttpAPI)
  protected
    // those internal methods will raise an EWinINet exception on error 
    procedure InternalConnect; override;
    procedure InternalRequest(const method, aURL: TSockData); override;
    procedure InternalCloseRequest; override;
    procedure InternalAddHeader(const hdr: TSockData); override;
    function InternalSendRequest(const aData: TSockData; var OutHeader,
      OutData, OutDataEncoding, InAcceptEncoding: TSockData): integer; override;


  public
    /// relase the connection
    destructor Destroy; override;
  end;

  /// type of a TWinHttpAPI class
  TWinHttpAPIClass = class of TWinHttpAPI;
................................................................................

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










function RegURL(aRoot, aPort: TSockData; Https: boolean;
  aDomainName: TSockData): UnicodeString;
const Prefix: array[boolean] of TSockData = ('http://','https://');
begin
  if aPort='' then
    aPort := '80';
  aRoot := trim(aRoot);
  aDomainName := trim(aDomainName);
  if aDomainName='' then begin
................................................................................
    if aRoot[1]<>'/' then
      insert('/',aRoot,1);
    if aRoot[length(aRoot)]<>'/' then
      aRoot := aRoot+'/';
  end else
    aRoot := '/'; // allow for instance 'http://*:2869/'
  aRoot := Prefix[Https]+aDomainName+':'+aPort+aRoot;
  result := UnicodeString(aRoot);
end;

function THttpApiServer.AddUrl(const aRoot, aPort: TSockData; Https: boolean;
  const aDomainName: TSockData): integer;
var s: UnicodeString;
    n: integer;
begin
  result := -1;
  if (Self=nil) or (fReqQueue=0) or (Http.Module=0) then
    exit;
  s := RegURL(aRoot, aPort, Https, aDomainName);
  if s='' then
................................................................................
  inherited CreateFmt('%s failed: %s (%d)',
    [HttpNames[NameIndex],SysErrorMessage(Error),Error])
end;


class function THttpApiServer.AddUrlAuthorize(const aRoot, aPort: TSockData;
  Https: boolean; const aDomainName: TSockData; OnlyDelete: boolean): string;
var prefix: UnicodeString;
    Error: HRESULT;
    Config: HTTP_SERVICE_CONFIG_URLACL_SET;
begin
  try
    HttpApiInitialize;
    prefix := RegURL(aRoot, aPort, Https, aDomainName);
    if prefix='' then
................................................................................
begin
  result := RegisterCompressFunc(fCompress,aFunction,fCompressAcceptEncoding)<>'';
end;

function TWinHttpAPI.Request(const url, method: TSockData;
  KeepAlive: cardinal; const InHeader, InData, InDataType: TSockData;
  out OutHeader, OutData: TSockData): integer;
var aData, aDataEncoding, aAccceptEncoding, aURL: TSockData;

    i: integer;
begin
  if (url='') or (url[1]<>'/') then
    aURL := '/'+url else // need valid url according to the HTTP/1.1 RFC
    aURL := url;
  fKeepAlive := KeepAlive;
  InternalRequest(method,aURL); // should raise an exception on error
................................................................................
        InDataType,aData);
      if aDataEncoding<>'' then
        InternalAddHeader(TSockData('Content-Encoding: ')+aDataEncoding);
    end;
    if fCompressAcceptEncoding<>'' then
      InternalAddHeader(fCompressAcceptEncoding);
    // send request to remote server
    result := InternalSendRequest(aData,OutHeader,OutData,aDataEncoding,aAccceptEncoding);



















    // handle incoming answer compression
    if OutData<>'' then begin
      if aDataEncoding<>'' then
        for i := 0 to high(fCompress) do
          with fCompress[i] do
          if Name=aDataEncoding then
            if Func(AnsiString(OutData),false)='' then
              raise ECrtSocket.CreateFmt('%s uncompress',[Name]) else
              break; // successfully uncompressed content
      if aAccceptEncoding<>'' then
        fCompressHeader := SetCompressHeader(fCompress,pointer(aAccceptEncoding));
    end;
  finally
    InternalCloseRequest;
  end; 
end;


................................................................................
    InternetCloseHandle(FSession);
  inherited;
end;

procedure TWinINet.InternalAddHeader(const hdr: TSockData);
begin
  if (hdr<>'') and not HttpAddRequestHeadersA(FRequest,
     Pointer(hdr),length(hdr),HTTP_ADDREQ_FLAG_COALESCE) then
    EWinINet.Create;
end;

procedure TWinINet.InternalCloseRequest;
begin
  if FRequest<>nil then begin
    InternetCloseHandle(FRequest);
    FRequest := nil;
  end;
end;

procedure TWinINet.InternalConnect;
begin
  FSession := InternetOpenA(DEFAULT_AGENT,INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
  if FSession=nil then
    raise EWinINet.Create;
  FConnection := InternetConnectA(FSession,pointer(FServer),FPort,nil,nil,
    INTERNET_SERVICE_HTTP,0,0);
  if FConnection=nil then
    raise EWinINet.Create;
end;

const
  ALL_ACCEPT: array[0..1] of PAnsiChar = ('*/*',nil);































procedure TWinINet.InternalRequest(const method, aURL: TSockData);
var Flags: DWORD;
begin
  Flags := INTERNET_FLAG_HYPERLINK or INTERNET_FLAG_PRAGMA_NOCACHE or
    INTERNET_FLAG_RESYNCHRONIZE; // options for a true RESTful request
  if FKeepAlive<>0 then
................................................................................
    Flags := Flags or INTERNET_FLAG_KEEP_CONNECTION;
  FRequest := HttpOpenRequestA(FConnection, Pointer(method), Pointer(aURL), nil,
    nil, @ALL_ACCEPT, Flags,0);
  if FRequest=nil then
    EWinINet.Create;
end;

function TWinINet.InternalSendRequest(const aData: TSockData;
  var OutHeader, OutData, OutDataEncoding, InAcceptEncoding: TSockData): integer;

  function GetInfo(Info: DWORD): TSockData;
  var dwSize, dwIndex: DWORD;
  begin
    result := '';
    dwSize := 0;
    dwIndex := 0;
    if not HttpQueryInfoA(fRequest,Info,nil,dwSize,dwIndex) and
       (GetLastError=ERROR_INSUFFICIENT_BUFFER) then begin
      SetLength(result,dwSize-1);
      if not HttpQueryInfoA(fRequest,Info,pointer(result),dwSize,dwIndex) then
        result := '';
    end;
  end;
  function GetInfo32(Info: DWORD): DWORD;
  var dwSize, dwIndex: DWORD;
  begin
    dwSize := sizeof(result);
    dwIndex := 0;
    Info := Info or HTTP_QUERY_FLAG_NUMBER;
    if not HttpQueryInfoA(fRequest,Info,@result,dwSize,dwIndex) then
      result := 0;
  end;

var Bytes, DataLen, Read: DWORD;
begin
  // send request to remote server
  if not HttpSendRequestA(fRequest,nil,0,pointer(aData),length(aData)) then
    EWinINet.Create;
  // retrieve status and headers
  result := GetInfo32(HTTP_QUERY_STATUS_CODE);
  OutHeader := GetInfo(HTTP_QUERY_RAW_HEADERS_CRLF);
  // retrieve body content
  OutData := '';
  DataLen := GetInfo32(HTTP_QUERY_CONTENT_LENGTH);
  if DataLen<>0 then begin
    SetLength(OutData,DataLen);
    Read := 0;
    repeat
      if InternetReadFile(fRequest,@PByteArray(OutData)[Read],DataLen-Read,Bytes) then
        if Bytes=0 then begin
          SetLength(OutData,Read);
          break;
        end else
        inc(Read,Bytes) else
        raise EWinINet.Create;
    until Read=DataLen;
    OutDataEncoding := GetInfo(HTTP_QUERY_CONTENT_ENCODING);
    InAcceptEncoding := GetInfo(HTTP_QUERY_ACCEPT_ENCODING);
  end;
end;


{ TWinHTTP }

const
  winhttpdll = 'winhttp.dll';

  WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
  WINHTTP_FLAG_REFRESH = $00000100;
  WINHTTP_FLAG_SECURE = $00800000;
  WINHTTP_ADDREQ_FLAG_COALESCE = $40000000;
  WINHTTP_QUERY_FLAG_NUMBER = $20000000;
  WINHTTP_QUERY_CONTENT_LENGTH = 5;
  WINHTTP_QUERY_STATUS_CODE = 19;
  WINHTTP_QUERY_RAW_HEADERS_CRLF = 22;
  WINHTTP_QUERY_CONTENT_ENCODING = 29;
  WINHTTP_QUERY_ACCEPT_ENCODING = 26;

function WinHttpOpen(pwszUserAgent: PWideChar; dwAccessType: DWORD;
  pwszProxyName, pwszProxyBypass: PWideChar; dwFlags: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpConnect(hSession: HINTERNET; pswzServerName: PWideChar;
  nServerPort: INTERNET_PORT; dwReserved: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpOpenRequest(hConnect: HINTERNET; pwszVerb: PWideChar;
  pwszObjectName: PWideChar; pwszVersion: PWideChar; pwszReferer: PWideChar;
................................................................................
  if fConnection<>nil then
    WinHttpCloseHandle(fConnection);
  if fSession<>nil then
    WinHttpCloseHandle(fSession);
  inherited;
end;

function TSockDataToUnicode(const Ansi: TSockData): TSockData;
var n, i: integer;
begin
  n := length(Ansi);
  SetLength(result,n*2+1);
  for i := 0 to n do // to n = including last #0
    PWordArray(result)[i] := PByteArray(Ansi)[i]; // fast ANSI 7 bit conversion
end;

procedure TWinHTTP.InternalAddHeader(const hdr: TSockData);
begin
  if hdr='' then
    exit;
  if not WinHttpAddRequestHeaders(FRequest,Pointer(TSockDataToUnicode(hdr)),
    length(hdr),WINHTTP_ADDREQ_FLAG_COALESCE) then
    RaiseLastOSError;
end;

procedure TWinHTTP.InternalCloseRequest;
begin
  if fRequest<>nil then begin
    WinHttpCloseHandle(fRequest);
    FRequest := nil;
  end;
end;

procedure TWinHTTP.InternalConnect;
begin
  fSession := WinHttpOpen(DEFAULT_AGENT,WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,nil,nil,0);

  if fSession=nil then
    RaiseLastOSError;
  fConnection := WinHttpConnect(fSession,pointer(TSockDataToUnicode(FServer)),fPort,0);
  if fConnection=nil then
    RaiseLastOSError;
end;





































procedure TWinHTTP.InternalRequest(const method, aURL: TSockData);
var Flags: DWORD;
begin
  Flags := WINHTTP_FLAG_REFRESH; // options for a true RESTful request
  if fHttps then
    Flags := Flags or WINHTTP_FLAG_SECURE;
  fRequest := WinHttpOpenRequest(fConnection, pointer(TSockDataToUnicode(method)),
    pointer(TSockDataToUnicode(aURL)), nil, nil, @ALL_ACCEPT, Flags);
  if fRequest=nil then
    RaiseLastOSError;
end;

function TWinHTTP.InternalSendRequest(const aData: TSockData;
  var OutHeader, OutData, OutDataEncoding, InAcceptEncoding: TSockData): integer;

  function GetInfo(Info: DWORD): TSockData;
  var dwSize, dwIndex: DWORD;
      tmp: TSockData;
      i: integer;
  begin
    result := '';
    dwSize := 0;
    dwIndex := 0;
    if not WinHttpQueryHeaders(fRequest,Info,nil,nil,dwSize,dwIndex) and
       (GetLastError=ERROR_INSUFFICIENT_BUFFER) then begin
      SetLength(tmp,dwSize);
      if WinHttpQueryHeaders(fRequest,Info,nil,pointer(tmp),dwSize,dwIndex) then begin
        dwSize := dwSize shr 1;
        SetLength(result,dwSize);
        for i := 0 to dwSize-1 do // fast ANSI 7 bit conversion
          PByteArray(result)[i] := PWordArray(tmp)[i];
      end;
    end;
  end;
  function GetInfo32(Info: DWORD): DWORD;
  var dwSize, dwIndex: DWORD;
  begin
    dwSize := sizeof(result);
    dwIndex := 0;
    Info := Info or WINHTTP_QUERY_FLAG_NUMBER;
    if not WinHttpQueryHeaders(fRequest,Info,nil,@result,dwSize,dwIndex) then
      result := 0;
  end;

var Bytes, DataLen, Read: DWORD;
begin

  if not WinHttpSendRequest(fRequest,nil,0,pointer(aData),length(aData),length(aData),0) or
     not WinHttpReceiveResponse(fRequest,nil) then
    RaiseLastOSError;
  // retrieve status and headers
  result := GetInfo32(WINHTTP_QUERY_STATUS_CODE);
  OutHeader := GetInfo(WINHTTP_QUERY_RAW_HEADERS_CRLF);
  // retrieve body content
  OutData := '';
  DataLen := GetInfo32(WINHTTP_QUERY_CONTENT_LENGTH);
  if DataLen<>0 then begin
    SetLength(OutData,DataLen);
    Read := 0;
    repeat
      if WinHttpReadData(fRequest,@PByteArray(OutData)[Read],DataLen-Read,Bytes) then
        if Bytes=0 then begin
          SetLength(OutData,Read);
          break;
        end else
        inc(Read,Bytes) else
        RaiseLastOSError;
    until Read=DataLen;
    OutDataEncoding := GetInfo(WINHTTP_QUERY_CONTENT_ENCODING);
    InAcceptEncoding := GetInfo(WINHTTP_QUERY_ACCEPT_ENCODING);
  end; 
end;

{$endif}


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

    /// the event handled called by the default implementation of the
    // virtual Request method
    // - warning: this process must be thread-safe (can be called by several
    // threads simultaneously)
    property OnRequest: TOnHttpServerRequest read fOnRequest write fOnRequest;
  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
   designed to work with I/O completion ports.
................................................................................
   applications running simultaneously. }
  THttpApiServer = class(THttpServerGeneric)
  protected
    /// the internal request queue
		fReqQueue: THandle;
    /// contain clones list
    fClones: TObjectList;
    /// list of all registered URL (Unicode-encoded)
    fRegisteredUrl: array of TSockData;
    /// 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
................................................................................
    fCompressHeader: THttpSocketCompressSet;
    /// used for internal connection
    fSession, fConnection, fRequest: HINTERNET;
    procedure InternalConnect; virtual; abstract;
    procedure InternalRequest(const method, aURL: TSockData); virtual; abstract;
    procedure InternalCloseRequest; virtual; abstract;
    procedure InternalAddHeader(const hdr: TSockData); virtual; abstract;
    procedure InternalSendRequest(const aData: TSockData); virtual; abstract;
    function InternalGetInfo(Info: DWORD): TSockData; virtual; abstract;
    function InternalGetInfo32(Info: DWORD): DWORD; virtual; abstract;
    function InternalReadData(var Data: TSockData; Read: integer): cardinal; virtual; abstract;
  public
    /// connect to http://aServer:aPort or https://aServer:aPort
    constructor Create(const aServer, aPort: AnsiString; aHttps: boolean);
    /// low-level HTTP/1.1 request
    // - after an Create(server,port), return 200,202,204 if OK,
    // http status error otherwize
    function Request(const url, method: TSockData; KeepAlive: cardinal;
................................................................................
  TWinINet = class(TWinHttpAPI)
  protected
    // those internal methods will raise an EWinINet exception on error
    procedure InternalConnect; override;
    procedure InternalRequest(const method, aURL: TSockData); override;
    procedure InternalCloseRequest; override;
    procedure InternalAddHeader(const hdr: TSockData); override;
    procedure InternalSendRequest(const aData: TSockData); override;
    function InternalGetInfo(Info: DWORD): TSockData; override;
    function InternalGetInfo32(Info: DWORD): DWORD; override;
    function InternalReadData(var Data: TSockData; Read: integer): cardinal; override;
  public
    /// relase the connection
    destructor Destroy; override;
  end;

  /// WinINet exception type
  EWinINet = class(Exception)
................................................................................
  TWinHTTP = class(TWinHttpAPI)
  protected
    // those internal methods will raise an EWinINet exception on error 
    procedure InternalConnect; override;
    procedure InternalRequest(const method, aURL: TSockData); override;
    procedure InternalCloseRequest; override;
    procedure InternalAddHeader(const hdr: TSockData); override;
    procedure InternalSendRequest(const aData: TSockData); override;
    function InternalGetInfo(Info: DWORD): TSockData; override;
    function InternalGetInfo32(Info: DWORD): DWORD; override;
    function InternalReadData(var Data: TSockData; Read: integer): cardinal; override;
  public
    /// relase the connection
    destructor Destroy; override;
  end;

  /// type of a TWinHttpAPI class
  TWinHttpAPIClass = class of TWinHttpAPI;
................................................................................

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

function ToUnicode(const Ansi: TSockData): TSockData;
var n, i: integer;
begin
  n := length(Ansi);
  SetLength(result,n*2+1);
  for i := 0 to n do // to n = including last #0
    PWordArray(result)[i] := PByteArray(Ansi)[i]; // fast ANSI 7 bit conversion
end;

function RegURL(aRoot, aPort: TSockData; Https: boolean;
  aDomainName: TSockData): TSockData;
const Prefix: array[boolean] of TSockData = ('http://','https://');
begin
  if aPort='' then
    aPort := '80';
  aRoot := trim(aRoot);
  aDomainName := trim(aDomainName);
  if aDomainName='' then begin
................................................................................
    if aRoot[1]<>'/' then
      insert('/',aRoot,1);
    if aRoot[length(aRoot)]<>'/' then
      aRoot := aRoot+'/';
  end else
    aRoot := '/'; // allow for instance 'http://*:2869/'
  aRoot := Prefix[Https]+aDomainName+':'+aPort+aRoot;
  result := ToUnicode(aRoot);
end;

function THttpApiServer.AddUrl(const aRoot, aPort: TSockData; Https: boolean;
  const aDomainName: TSockData): integer;
var s: TSockData;
    n: integer;
begin
  result := -1;
  if (Self=nil) or (fReqQueue=0) or (Http.Module=0) then
    exit;
  s := RegURL(aRoot, aPort, Https, aDomainName);
  if s='' then
................................................................................
  inherited CreateFmt('%s failed: %s (%d)',
    [HttpNames[NameIndex],SysErrorMessage(Error),Error])
end;


class function THttpApiServer.AddUrlAuthorize(const aRoot, aPort: TSockData;
  Https: boolean; const aDomainName: TSockData; OnlyDelete: boolean): string;
var prefix: TSockData;
    Error: HRESULT;
    Config: HTTP_SERVICE_CONFIG_URLACL_SET;
begin
  try
    HttpApiInitialize;
    prefix := RegURL(aRoot, aPort, Https, aDomainName);
    if prefix='' then
................................................................................
begin
  result := RegisterCompressFunc(fCompress,aFunction,fCompressAcceptEncoding)<>'';
end;

function TWinHttpAPI.Request(const url, method: TSockData;
  KeepAlive: cardinal; const InHeader, InData, InDataType: TSockData;
  out OutHeader, OutData: TSockData): integer;
var aData, aDataEncoding, aAcceptEncoding, aURL: TSockData;
    Bytes, DataLen, Read: DWORD;
    i: integer;
begin
  if (url='') or (url[1]<>'/') then
    aURL := '/'+url else // need valid url according to the HTTP/1.1 RFC
    aURL := url;
  fKeepAlive := KeepAlive;
  InternalRequest(method,aURL); // should raise an exception on error
................................................................................
        InDataType,aData);
      if aDataEncoding<>'' then
        InternalAddHeader(TSockData('Content-Encoding: ')+aDataEncoding);
    end;
    if fCompressAcceptEncoding<>'' then
      InternalAddHeader(fCompressAcceptEncoding);
    // send request to remote server
    InternalSendRequest(aData);
    // retrieve status and headers (HTTP_QUERY* and WINHTTP_QUERY* do match)
    result := InternalGetInfo32(HTTP_QUERY_STATUS_CODE);
    OutHeader := InternalGetInfo(HTTP_QUERY_RAW_HEADERS_CRLF);
    aDataEncoding := InternalGetInfo(HTTP_QUERY_CONTENT_ENCODING);
    aAcceptEncoding := InternalGetInfo(HTTP_QUERY_ACCEPT_ENCODING);
    // retrieve received content (if any)
    DataLen := InternalGetInfo32(HTTP_QUERY_CONTENT_LENGTH);
    if DataLen<>0 then begin
      SetLength(OutData,DataLen);
      Read := 0;
      repeat
        Bytes := InternalReadData(OutData,Read);
        if Bytes=0 then begin
          SetLength(OutData,Read);
          break;
        end else
          inc(Read,Bytes);
      until Read=DataLen;
    end;
    // handle incoming answer compression
    if OutData<>'' then begin
      if aDataEncoding<>'' then
        for i := 0 to high(fCompress) do
          with fCompress[i] do
          if Name=aDataEncoding then
            if Func(AnsiString(OutData),false)='' then
              raise ECrtSocket.CreateFmt('%s uncompress',[Name]) else
              break; // successfully uncompressed content
      if aAcceptEncoding<>'' then
        fCompressHeader := SetCompressHeader(fCompress,pointer(aAcceptEncoding));
    end;
  finally
    InternalCloseRequest;
  end; 
end;


................................................................................
    InternetCloseHandle(FSession);
  inherited;
end;

procedure TWinINet.InternalAddHeader(const hdr: TSockData);
begin
  if (hdr<>'') and not HttpAddRequestHeadersA(FRequest,
     Pointer(hdr), length(hdr), HTTP_ADDREQ_FLAG_COALESCE) then
    EWinINet.Create;
end;

procedure TWinINet.InternalCloseRequest;
begin
  if FRequest<>nil then begin
    InternetCloseHandle(FRequest);
    FRequest := nil;
  end;
end;

procedure TWinINet.InternalConnect;
begin
  FSession := InternetOpenA(DEFAULT_AGENT, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if FSession=nil then
    raise EWinINet.Create;
  FConnection := InternetConnectA(FSession, pointer(FServer), FPort, nil, nil,
    INTERNET_SERVICE_HTTP, 0, 0);
  if FConnection=nil then
    raise EWinINet.Create;
end;

const
  ALL_ACCEPT: array[0..1] of PAnsiChar = ('*/*',nil);

function TWinINet.InternalGetInfo(Info: DWORD): TSockData;
var dwSize, dwIndex: DWORD;
begin
  result := '';
  dwSize := 0;
  dwIndex := 0;
  if not HttpQueryInfoA(fRequest, Info, nil, dwSize, dwIndex) and
     (GetLastError=ERROR_INSUFFICIENT_BUFFER) then begin
    SetLength(result,dwSize-1);
    if not HttpQueryInfoA(fRequest, Info, pointer(result), dwSize, dwIndex) then
      result := '';
  end;
end;

function TWinINet.InternalGetInfo32(Info: DWORD): DWORD;
var dwSize, dwIndex: DWORD;
begin
  dwSize := sizeof(result);
  dwIndex := 0;
  Info := Info or HTTP_QUERY_FLAG_NUMBER;
  if not HttpQueryInfoA(fRequest, Info, @result, dwSize, dwIndex) then
    result := 0;
end;

function TWinINet.InternalReadData(var Data: TSockData; Read: integer): cardinal;
begin
  if not InternetReadFile(fRequest, @PByteArray(Data)[Read], length(Data)-Read, result) then
    raise EWinINet.Create;
end;

procedure TWinINet.InternalRequest(const method, aURL: TSockData);
var Flags: DWORD;
begin
  Flags := INTERNET_FLAG_HYPERLINK or INTERNET_FLAG_PRAGMA_NOCACHE or
    INTERNET_FLAG_RESYNCHRONIZE; // options for a true RESTful request
  if FKeepAlive<>0 then
................................................................................
    Flags := Flags or INTERNET_FLAG_KEEP_CONNECTION;
  FRequest := HttpOpenRequestA(FConnection, Pointer(method), Pointer(aURL), nil,
    nil, @ALL_ACCEPT, Flags,0);
  if FRequest=nil then
    EWinINet.Create;
end;

procedure TWinINet.InternalSendRequest(const aData: TSockData);




begin























  if not HttpSendRequestA(fRequest, nil, 0, pointer(aData), length(aData)) then
    EWinINet.Create;





















end;


{ TWinHTTP }

const
  winhttpdll = 'winhttp.dll';

  WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
  WINHTTP_FLAG_REFRESH = $00000100;
  WINHTTP_FLAG_SECURE = $00800000;
  WINHTTP_ADDREQ_FLAG_COALESCE = $40000000;
  WINHTTP_QUERY_FLAG_NUMBER = $20000000;






function WinHttpOpen(pwszUserAgent: PWideChar; dwAccessType: DWORD;
  pwszProxyName, pwszProxyBypass: PWideChar; dwFlags: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpConnect(hSession: HINTERNET; pswzServerName: PWideChar;
  nServerPort: INTERNET_PORT; dwReserved: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpOpenRequest(hConnect: HINTERNET; pwszVerb: PWideChar;
  pwszObjectName: PWideChar; pwszVersion: PWideChar; pwszReferer: PWideChar;
................................................................................
  if fConnection<>nil then
    WinHttpCloseHandle(fConnection);
  if fSession<>nil then
    WinHttpCloseHandle(fSession);
  inherited;
end;










procedure TWinHTTP.InternalAddHeader(const hdr: TSockData);
begin
  if hdr='' then
    exit;
  if not WinHttpAddRequestHeaders(FRequest, Pointer(ToUnicode(hdr)), length(hdr),
     WINHTTP_ADDREQ_FLAG_COALESCE) then
    RaiseLastOSError;
end;

procedure TWinHTTP.InternalCloseRequest;
begin
  if fRequest<>nil then begin
    WinHttpCloseHandle(fRequest);
    FRequest := nil;
  end;
end;

procedure TWinHTTP.InternalConnect;
begin
  fSession := WinHttpOpen(DEFAULT_AGENT, WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,
    nil, nil, 0);
  if fSession=nil then
    RaiseLastOSError;
  fConnection := WinHttpConnect(fSession, pointer(ToUnicode(FServer)), fPort, 0);
  if fConnection=nil then
    RaiseLastOSError;
end;

function TWinHTTP.InternalGetInfo(Info: DWORD): TSockData;
var dwSize, dwIndex: DWORD;
    tmp: TSockData;
    i: integer;
begin
  result := '';
  dwSize := 0;
  dwIndex := 0;
  if not WinHttpQueryHeaders(fRequest, Info, nil, nil, dwSize, dwIndex) and
     (GetLastError=ERROR_INSUFFICIENT_BUFFER) then begin
    SetLength(tmp,dwSize);
    if WinHttpQueryHeaders(fRequest, Info, nil, pointer(tmp), dwSize, dwIndex) then begin
      dwSize := dwSize shr 1;
      SetLength(result,dwSize);
      for i := 0 to dwSize-1 do // fast ANSI 7 bit conversion
        PByteArray(result)[i] := PWordArray(tmp)[i];
    end;
  end;
end;

function TWinHTTP.InternalGetInfo32(Info: DWORD): DWORD;
var dwSize, dwIndex: DWORD;
begin
  dwSize := sizeof(result);
  dwIndex := 0;
  Info := Info or WINHTTP_QUERY_FLAG_NUMBER;
  if not WinHttpQueryHeaders(fRequest, Info, nil, @result, dwSize, dwIndex) then
    result := 0;
end;

function TWinHTTP.InternalReadData(var Data: TSockData; Read: integer): cardinal;
begin
  if not WinHttpReadData(fRequest, @PByteArray(Data)[Read], length(Data)-Read, result) then
    RaiseLastOSError;
end;

procedure TWinHTTP.InternalRequest(const method, aURL: TSockData);
var Flags: DWORD;
begin
  Flags := WINHTTP_FLAG_REFRESH; // options for a true RESTful request
  if fHttps then
    Flags := Flags or WINHTTP_FLAG_SECURE;
  fRequest := WinHttpOpenRequest(fConnection, pointer(ToUnicode(method)),
    pointer(ToUnicode(aURL)), nil, nil, @ALL_ACCEPT, Flags);
  if fRequest=nil then
    RaiseLastOSError;
end;

procedure TWinHTTP.InternalSendRequest(const aData: TSockData);





var L: integer;
begin


























  L := length(aData);
  if not WinHttpSendRequest(fRequest, nil, 0, pointer(aData), L, L, 0) or
     not WinHttpReceiveResponse(fRequest,nil) then
    RaiseLastOSError;





















end;

{$endif}


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