WinHttpWS.pas

unit WinHttpWS;

interface

uses Windows;

const
  // flags for WinHttpOpen
  WINHTTP_FLAG_ASYNC              = $10000000;  // this session is asynchronous (where supported)
  WINHTTP_FLAG_SECURE_DEFAULTS    = $30000000;  // note that this flag also forces async

  // flags for WinHttpOpenRequest
  WINHTTP_FLAG_SECURE                = $00800000;  // use SSL if applicable (HTTPS)
  WINHTTP_FLAG_ESCAPE_PERCENT        = $00000004;  // if escaping enabled, escape percent as well
  WINHTTP_FLAG_NULL_CODEPAGE         = $00000008;  // assume all symbols are ASCII, use fast convertion
  WINHTTP_FLAG_BYPASS_PROXY_CACHE    = $00000100;  // add "pragma: no-cache" request header
  WINHTTP_FLAG_REFRESH               = WINHTTP_FLAG_BYPASS_PROXY_CACHE;
  WINHTTP_FLAG_ESCAPE_DISABLE        = $00000040;  // disable escaping
  WINHTTP_FLAG_ESCAPE_DISABLE_QUERY  = $00000080;  // if escaping enabled escape path part, but do not escape query

  // WinHttpOpen dwAccessType values
  WINHTTP_ACCESS_TYPE_DEFAULT_PROXY              = 0;
  WINHTTP_ACCESS_TYPE_NO_PROXY                   = 1;
  WINHTTP_ACCESS_TYPE_NAMED_PROXY                = 3;
  WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY            = 4;

  // WinHttpSendRequest prettifiers for optional parameters.
  WINHTTP_NO_ADDITIONAL_HEADERS   = nil;
  WINHTTP_NO_REQUEST_DATA         = nil;

  WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET            = 114;
  WINHTTP_OPTION_WEB_SOCKET_CLOSE_TIMEOUT         = 115;
  WINHTTP_OPTION_WEB_SOCKET_KEEPALIVE_INTERVAL    = 116;

type
  HINTERNET = THandle;
  INTERNET_PORT = WORD;

type
  WINHTTP_WEB_SOCKET_BUFFER_TYPE = DWORD;
const
  WINHTTP_WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE       = 0;
  WINHTTP_WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE      = 1;
  WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE         = 2;
  WINHTTP_WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE        = 3;
  WINHTTP_WEB_SOCKET_CLOSE_BUFFER_TYPE                = 4;

type
  WINHTTP_WEB_SOCKET_CLOSE_STATUS = DWORD;
const
  WINHTTP_WEB_SOCKET_SUCCESS_CLOSE_STATUS                = 1000;
  WINHTTP_WEB_SOCKET_ENDPOINT_TERMINATED_CLOSE_STATUS    = 1001;
  WINHTTP_WEB_SOCKET_PROTOCOL_ERROR_CLOSE_STATUS         = 1002;
  WINHTTP_WEB_SOCKET_INVALID_DATA_TYPE_CLOSE_STATUS      = 1003;
  WINHTTP_WEB_SOCKET_EMPTY_CLOSE_STATUS                  = 1005;
  WINHTTP_WEB_SOCKET_ABORTED_CLOSE_STATUS                = 1006;
  WINHTTP_WEB_SOCKET_INVALID_PAYLOAD_CLOSE_STATUS        = 1007;
  WINHTTP_WEB_SOCKET_POLICY_VIOLATION_CLOSE_STATUS       = 1008;
  WINHTTP_WEB_SOCKET_MESSAGE_TOO_BIG_CLOSE_STATUS        = 1009;
  WINHTTP_WEB_SOCKET_UNSUPPORTED_EXTENSIONS_CLOSE_STATUS = 1010;
  WINHTTP_WEB_SOCKET_SERVER_ERROR_CLOSE_STATUS           = 1011;
  WINHTTP_WEB_SOCKET_SECURE_HANDSHAKE_ERROR_CLOSE_STATUS = 1015;

function WinHttpOpen(pszAgentW:PWideChar;dwAccessType:DWORD;pszProxyW:PWideChar;
  pszProxyBypassW:PWideChar;dwFlags:DWORD):HINTERNET; stdcall;

function WinHttpCloseHandle(hInternet:HINTERNET):boolean; stdcall;

function WinHttpConnect(hSession:HINTERNET;pswzServerName:PWideChar;
  nServerPort:INTERNET_PORT;dwReserved:DWORD):HINTERNET; stdcall;

function WinHttpOpenRequest(hConnect:HINTERNET;pwszVerb,pwszObjectName,
  pwszVersion,pwszReferrer:PWideChar;ppwszAcceptTypes:PPWideChar;
  dwFlags:DWORD):HINTERNET; stdcall;

function WinHttpSetOption(hInternet:HINTERNET;dwOption:DWORD;lpBuffer:pointer;
  dwBufferLength:DWORD):boolean; stdcall;

function WinHttpSetTimeouts(hInternet:HINTERNET;nResolveTimeout,
  nConnectTimeout,nSendTimeout,nReceiveTimeout:integer):boolean; stdcall;

function WinHttpSendRequest(hRequest:HINTERNET;lpszHeaders:PWideChar;
  dwHeadersLength:DWORD;lpOptional:pointer;dwOptionalLength:DWORD;
  dwTotalLength:DWORD;dwContext:PDWORD):boolean; stdcall;

function WinHttpReceiveResponse(hRequest:HINTERNET;
  lpReserved:pointer):boolean; stdcall;

function WinHttpWebSocketCompleteUpgrade(hRequest:HINTERNET;
  pContext:PDWORD):HINTERNET; stdcall;

function WinHttpWebSocketSend(hWebSocket:HINTERNET;
  eBufferType:WINHTTP_WEB_SOCKET_BUFFER_TYPE;pvBuffer:pointer;
  dwBufferLength:DWORD):DWORD; stdcall;

function WinHttpWebSocketReceive(hWebSocket:HINTERNET;pvBuffer:pointer;
  dwBufferLength:DWORD;var pdwBytesRead:DWORD;
  var peBufferType:WINHTTP_WEB_SOCKET_BUFFER_TYPE):DWORD; stdcall;

function WinHttpWebSocketShutdown(hWebSocket:HINTERNET;
  usStatus:USHORT;pvReason:pointer;dwReasonLength:DWORD):DWORD; stdcall;

function WinHttpWebSocketClose(hWebSocket:HINTERNET;usStatus:USHORT;
  pvReason:pointer;dwReasonLength:DWORD):DWORD; stdcall;

function WinHttpWebSocketQueryCloseStatus(hWebSocket:HINTERNET;
  var pusStatus:USHORT;pvReason:pointer;dwReasonLength:DWORD;
  var pdwReasonLengthConsumed:DWORD):DWORD; stdcall;

type
  TWebSocketMessage=procedure(Sender:TObject;const Data:string) of object;

  TWebSocket=class(TObject)
  private
    hSsn,hCon,hReq,hWeb:HINTERNET;
    FOnMessage:TWebSocketMessage;
  public
    constructor Create(const Agent:string);
    destructor Destroy; override;

    procedure Open(const URL:string);
    procedure CheckMessages;
    procedure SendMessage(const Data:string);
    procedure Close;

    property OnMessage:TWebSocketMessage read FOnMessage write FOnMessage;
  end;

implementation

const
  WinHttpDLL='winhttp.dll';

function WinHttpOpen; external WinHttpDll;
function WinHttpCloseHandle; external WinHttpDll;
function WinHttpConnect; external WinHttpDll;
function WinHttpOpenRequest; external WinHttpDll;
function WinHttpSetOption; external WinHttpDll;
function WinHttpSetTimeouts; external WinHttpDll;
function WinHttpSendRequest; external WinHttpDll;
function WinHttpReceiveResponse; external WinHttpDll;
function WinHttpWebSocketCompleteUpgrade; external WinHttpDll;
function WinHttpWebSocketSend; external WinHttpDll;
function WinHttpWebSocketReceive; external WinHttpDll;
function WinHttpWebSocketShutdown; external WinHttpDll;
function WinHttpWebSocketClose; external WinHttpDll;
function WinHttpWebSocketQueryCloseStatus; external WinHttpDll;

{ TWebSocket }

constructor TWebSocket.Create(const Agent:string);
begin
  inherited Create;

  //https://github.com/microsoft/Windows-classic-samples/blob/main/Samples/WinhttpWebsocket/cpp/WinhttpWebsocket.cpp

  hSsn:=WinHttpOpen(PWideChar(Agent),WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,nil,nil,0);
  if hSsn=0 then RaiseLastOSError;
  hCon:=0;
  hReq:=0;
  hWeb:=0;
end;

destructor TWebSocket.Destroy;
begin
  WinHttpCloseHandle(hSsn);
  inherited;
end;

procedure TWebSocket.Open(const URL: string);
var
  i,j,l,port:integer;
  host:string;
  f:DWORD;
begin
  f:=0;
  l:=Length(URL);
  if Copy(URL,1,5)='ws://' then
   begin
    i:=6;
    port:=80;//default
   end
  else
  if Copy(URL,1,6)='wss://' then
   begin
    i:=7;
    f:=WINHTTP_FLAG_SECURE;
    port:=443;//default
   end
  else
    raise Exception.Create('TWebSocket.Open: invalid URL');
  j:=i;
  while (j<=l) and (URL[j]<>'/') do inc(j);
  host:=Copy(URL,i,j-i);

  i:=1;
  while (i<=Length(host)) and (host[i]<>':') do inc(i);
  if i<=Length(host) then
   begin
    port:=StrToInt(string(Copy(host,i+1,Length(host)-i)));
    SetLength(host,i-1);
   end;

  hCon:=WinHttpConnect(hSsn,PWideChar(host),port,0);
  if hCon=0 then RaiseLastOSError;

  hReq:=WinHttpOpenRequest(hCon,'GET',PWideChar(Copy(URL,j,l-j+1)),nil,nil,nil,f);
  if hReq=0 then RaiseLastOSError;

  if not WinHttpSetOption(hReq,WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET,nil,0) then
    RaiseLastOSError;

  if not WinHttpSendRequest(hReq,WINHTTP_NO_ADDITIONAL_HEADERS,0,nil,0,0,nil) then
    RaiseLastOSError;

  if not WinHttpReceiveResponse(hReq,nil) then
    RaiseLastOSError;

  hWeb:=WinHttpWebSocketCompleteUpgrade(hReq,nil);
  if hWeb=0 then RaiseLastOSError;

  WinHttpCloseHandle(hReq);
  hReq:=0;
end;

procedure TWebSocket.CheckMessages;
var
  r,l:DWORD;
  s:UTF8String;
  t:WINHTTP_WEB_SOCKET_BUFFER_TYPE;
begin
  //TODO: WinHttpWebSocketQueryCloseStatus?
  //TODO: while?

  SetLength(s,$10000);
  r:=WinHttpWebSocketReceive(hWeb,@s[1],$10000,l,t);
  if r<>ERROR_SUCCESS then
    raise Exception.Create('TWebSocket.CheckMessages:'+SysErrorMessage(r));

  if @FOnMessage=nil then
    raise Exception.Create('TWebSocket.CheckMessages: OnMessages event not handled');

  if t=WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE then
   begin
    SetLength(s,l);
    FOnMessage(Self,UTF8ToWideString(s));
   end;
  //TODO: case t? more events?

end;

procedure TWebSocket.SendMessage(const Data: string);
var
  r:DWORD;
  s:UTF8String;
begin
  s:=UTF8Encode(Data);
  r:=WinHttpWebSocketSend(hWeb,WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,@s[1],Length(s));
  if r<>ERROR_SUCCESS then
    raise Exception.Create('TWebSocket.SendMessage:'+SysErrorMessage(r));
end;

procedure TWebSocket.Close;
begin
  if hWeb<>0 then WinHttpCloseHandle(hWeb);
  if hReq<>0 then WinHttpCloseHandle(hReq);
  if hCon<>0 then WinHttpCloseHandle(hCon);
  hWeb:=0;
  hReq:=0;
  hCon:=0;
end;

end.

Is there a Readme file for "how should we handle/use it" ?

I myself took most inspiration from this and here