// HTML5 WebSockets server example
#include "FiveWin.ch"
#include "hbcompat.ch"
extern hb_version
static oWnd, oSocket, oClient
#define MAGIC_KEY "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
//------------------------------------------------------------------------//
function Main()
local oBar
DEFINE WINDOW oWnd TITLE "HTML5 WebSockets server" ;
MENU BuildMenu()
DEFINE BUTTONBAR oBar OF oWnd 2007
DEFINE MSGBAR PROMPT "FWH WebSockets Server" OF oWnd 2007
ACTIVATE WINDOW oWnd ;
ON INIT Server()
return nil
//------------------------------------------------------------------------//
function BuildMenu()
local oMenu
MENU oMenu
MENUITEM "About" ACTION MsgAbout( "FWH WebSockets Server", "(c) FiveTech Software 2011-12" )
ENDMENU
return oMenu
//------------------------------------------------------------------------//
function Server()
oSocket = TSocket():New( 2000 )
oSocket:bAccept = { | oSocket | oClient := TSocket():Accept( oSocket:nSocket ),;
oClient:Cargo := .F.,; //if handshake is valid
oClient:bRead := { | oSocket | OnRead( oSocket ) },;
oClient:bClose := { | oSocket | OnClose( oSocket ) } }
oSocket:Listen()
return nil
//------------------------------------------------------------------------//
function OnRead( oSocket )
local cData := oSocket:GetData()
local cToken
local reHead
local cContext, cKey
local cSend
local cMask, cMsg := "", nMaskPos := 1
if ! oSocket:Cargo
cContext = GetContext( cData, "Sec-WebSocket-Key" )
cKey = hb_Base64Encode( hb_sha1( cContext + MAGIC_KEY, .t. ) )
cSend = "HTTP/1.1 101 Switching Protocols" + CRLF + ;
"Upgrade: websocket" + CRLF + ;
"Connection: Upgrade" + CRLF + ;
"Sec-WebSocket-Accept: " + cKey + CRLF + CRLF
oSocket:SendData( cSend )
oSocket:Cargo = .T.
else
cMask = SubStr( cData, 3, 4 )
for n = 1 to Len( SubStr( cData, 7 ) )
cMsg += Chr( nXor( Asc( SubStr( cMask, nMaskPos++, 1 ) ), Asc( SubStr( cData, 6 + n, 1 ) ) ) )
if nMaskPos == 5
nMaskPos = 1
endif
next
if Left( cMsg, 1 ) == "?"
TRY
cAnswer = cValToChar( &( SubStr( cMsg, 2 ) ) )
CATCH oError
cAnswer = "Error: " + oError:Description
END
else
cAnswer = "Please use ? <expression>"
endif
oSocket:SendData( Chr( 129 ) + Chr( Len( cAnswer ) ) + hb_StrToUtf8( cAnswer ) )
endif
return nil
//------------------------------------------------------------------------//
function OnClose( oSocket )
MsgInfo( "Client has closed!" )
oSocket:End()
oSocket = NIL
return nil
//------------------------------------------------------------------------//
static function GetContext( cData, cContext )
local nLen := Len( cContext )
local cValue := ""
local aLines := hb_ATokens( cData, CRLF )
local aSubLine
local cRow
for each cRow in aLines
if cContext $ cRow
aSubLine = hb_ATokens( cRow, ":" )
cValue = AllTrim( aSubLine[ 2 ] )
exit
endif
next
return cValue
Antonio Linares wrote:Enrico,
You need a HTML5 WebSockets support capable Internet browser like Chrome. Unfortunately IE does not apply...
// HTML5 WebSockets server example
#include "FiveWin.ch"
#include "hbcompat.ch"
extern hb_version, DbUseArea, FieldGet, DbCloseArea
static oWnd, oSocket, oClient, oPP
#define MAGIC_KEY "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
//------------------------------------------------------------------------//
function Main()
local oBar
oPP = __pp_Init( "c:\harbour\include", "std.ch" )
DEFINE WINDOW oWnd TITLE "HTML5 WebSockets server" ;
MENU BuildMenu()
DEFINE BUTTONBAR oBar OF oWnd 2007
DEFINE MSGBAR PROMPT "FWH WebSockets Server" OF oWnd 2007
ACTIVATE WINDOW oWnd ;
ON INIT Server()
return nil
//------------------------------------------------------------------------//
function BuildMenu()
local oMenu
MENU oMenu
MENUITEM "About" ACTION MsgAbout( "FWH WebSockets Server", "(c) FiveTech Software 2011-12" )
ENDMENU
return oMenu
//------------------------------------------------------------------------//
function Server()
oSocket = TSocket():New( 2000 )
oSocket:bAccept = { | oSocket | oClient := TSocket():Accept( oSocket:nSocket ),;
oClient:Cargo := .F.,; //if handshake is valid
oClient:bRead := { | oSocket | OnRead( oSocket ) },;
oClient:bClose := { | oSocket | OnClose( oSocket ) } }
oSocket:Listen()
return nil
//------------------------------------------------------------------------//
function OnRead( oSocket )
local cData := oSocket:GetData()
local cToken
local reHead
local cContext, cKey
local cSend
local cMask, cMsg := "", nMaskPos := 1
if ! oSocket:Cargo
cContext = GetContext( cData, "Sec-WebSocket-Key" )
cKey = hb_Base64Encode( hb_sha1( cContext + MAGIC_KEY, .t. ) )
cSend = "HTTP/1.1 101 Switching Protocols" + CRLF + ;
"Upgrade: websocket" + CRLF + ;
"Connection: Upgrade" + CRLF + ;
"Sec-WebSocket-Accept: " + cKey + CRLF + CRLF
oSocket:SendData( cSend )
oSocket:Cargo = .T.
else
cMask = SubStr( cData, 3, 4 )
for n = 1 to Len( SubStr( cData, 7 ) )
cMsg += Chr( nXor( Asc( SubStr( cMask, nMaskPos++, 1 ) ), Asc( SubStr( cData, 6 + n, 1 ) ) ) )
if nMaskPos == 5
nMaskPos = 1
endif
next
TRY
cMsg = __pp_Process( oPP, cMsg )
cAnswer = cValToChar( &cMsg )
CATCH oError
cAnswer = "Error: " + oError:Description
END
oSocket:SendData( Chr( 129 ) + Chr( Len( cAnswer ) ) + hb_StrToUtf8( cAnswer ) )
endif
return nil
//------------------------------------------------------------------------//
function OnClose( oSocket )
MsgInfo( "Client has closed!" )
oSocket:End()
oSocket = NIL
return nil
//------------------------------------------------------------------------//
static function GetContext( cData, cContext )
local nLen := Len( cContext )
local cValue := ""
local aLines := hb_ATokens( cData, CRLF )
local aSubLine
local cRow
for each cRow in aLines
if cContext $ cRow
aSubLine = hb_ATokens( cRow, ":" )
cValue = AllTrim( aSubLine[ 2 ] )
exit
endif
next
return cValue
//------------------------------------------------------------------------//
function QOut( c )
return cValToChar( c )
//------------------------------------------------------------------------//
Enrico Maria Giordano wrote:Antonio Linares wrote:Enrico,
You need a HTML5 WebSockets support capable Internet browser like Chrome. Unfortunately IE does not apply...
Ok, but I think that IE compatibility is the minimum required for any Internet programming tools that pretends to be useful. Am I wrong?
EMG
Antonio Linares wrote:IE is behind its competitors regarding HTML5 support. Thats why I use Chrome, and also because it is much faster
Microsoft has promised a new version with HTML5 support but it seems as it is not ready yet.
<html>
<script>
var canvas;
var ctx; // context
var row, col; // say coordinates
var socket;
function connect()
{
try
{
socket = new WebSocket( "ws://localhost:2000/harbour" );
Say( "Connecting to the Harbour WebSockets server..." );
socket.onopen = function( event )
{
Say( "Connected" );
}
socket.onmessage = function( msg )
{
Say( msg.data );
}
socket.onclose = function( event )
{
Say( "connection closed from the server" );
}
socket.onerror = function()
{
Say( "Error: " + socket.readyState );
}
}
catch( exception )
{
Say( "Exception ocurred" );
}
}
function Send( text )
{
try
{
socket.send( text );
Say( "sending request to the server..." );
}
catch( exception )
{
Say( "can't send to the server" );
}
}
function Say( cText )
{
if( row > canvas.height - 21 )
{
var oldCanvas = canvas.toDataURL();
var img = new Image();
canvas.height += 22;
ctx = canvas.getContext( '2d' );
ctx.fillStyle = '#0f0';
ctx.font = '20px verdana';
ctx.textBaseline = 'top';
img.src = oldCanvas;
img.onload = function() { ctx.drawImage( img, 0, 0 ); };
}
ctx.fillText( cText, col, row );
row += 22;
}
function init()
{
canvas = document.getElementById( 'canvas' );
ctx = canvas.getContext( '2d' );
ctx.fillStyle = '#0f0';
ctx.font = '20px verdana';
ctx.textBaseline = 'top';
row = 0;
col = 0;
Say( "Initializing..." );
Say( new Date() );
Say( "ready" );
connect();
document.getElementById( "command" ).focus();
}
function ProcessCommand( event )
{
if( event.keyCode == 13 )
{
var edit = document.getElementById( "command" );
if( edit.value.length == 0 )
return;
Say( edit.value );
Send( edit.value );
edit.value = "";
}
}
window.onload = init;
</script>
<head>
</head>
<body>
<h1>HTML5 WebSockets Harbour server demo</h1>
<div style="width: 820px; height: 500px; overflow: auto;">
<canvas id="canvas" width="800" height="570" style="background-color:#000"></canvas>
</div>
<br>
<b>Command:</b> <input id="command" type="text" name="command" style="width:750px;
background-color:#000; color:#0f0; font-size: 20px;"
onkeypress="ProcessCommand( event )">
</body>
</html>
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 31 guests