Last active
April 5, 2023 19:37
-
-
Save stijnsanders/9868e47f32a06784ac9a9fbc3f2692cb to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Is there a Readme file for "how should we handle/use it" ?