5ae08a0e0e
* src/vm/set.c
* Reset default value to "hb_out.log".
+ mpkg_nightly.sh
+ Added script to generate nightly sources.
; TODO: Upload nightlies to sf.net.
; TODO: Change nightly filenames to match our normal source releases.
; TOFIX: Current .zip nighly has wrong (*nix) EOLs. This has to be
changed to CRLF.
* INSTALL
* Changed nightly script URLs to point to sf.net file area.
! Minor fix to bug tracker address.
* contrib/xhb/regexrpl.prg
* contrib/hbtip/httpcli.prg
* contrib/hbtip/mail.prg
! Fixed to use EMPTY() on HB_REGEX[ALL]() return
value instead of NIL check.
Required after recent change in HB_REGEX*()
return values in no-match case.
* contrib/hbcurl/hbcurl.c
* contrib/hbcurl/hbcurl.ch
+ Added support to download-to/upload-from file handle.
* contrib/hbqt/qtgui/Makefile
* contrib/hbqt/qtcore/Makefile
* contrib/hbqt/Makefile
* contrib/hbqt/gtqtc/Makefile
* contrib/hbqt/qtnetwork/Makefile
! Fixed to not build separate HBQT libs for static
linkage for non-win/wce targets.
* package/mpkg_win.nsi
* package/winuni/mpkg_win_uni.nsi
* Changed to use 'Harbour Project' as folder name in registry.
(instead of 'Harbour'). Just to be consistent.
* package/winuni/mpkg_win_uni.nsi
+ Add major.minor version number to registry folder names.
This allows multiple major versions of Harbour to be installed
in parallel.
* contrib/xhb/ttable.prg
% '&("{||" + c + "}")' -> HB_MACROBLOCK()
* contrib/xhb/trpccli.prg
* contrib/xhb/hblognet.prg
* contrib/xhb/xcstr.prg
* contrib/xhb/tedit.prg
* contrib/xhb/xdbmodst.prg
* contrib/xhb/trpc.prg
* contrib/xhb/thtm.prg
* contrib/xhb/dumpvar.prg
* contrib/xhb/xhbmt.prg
* contrib/xhb/xhberr.prg
* contrib/xhb/ttable.prg
* contrib/xhb/txml.prg
* '.NOT.' -> '!'
% ValType( x ) == "Y" -> IS*()
* Some other basic formatting and cleanup.
* src/rtl/hbini.prg
* examples/httpsrv/session.prg
* Formatting.
* tests/db_brows.prg
* tests/server.prg
* tests/testrdd2.prg
* tests/setkeys.prg
* contrib/hbtip/tests/tiptest.prg
* contrib/hbtip/tests/loadhtml.prg
* examples/hbsqlit2/tests/hbsqlite.prg
* examples/gtwvw/tests/wvwtest9.prg
* examples/gtwvw/tests/ebtest7.prg
* '.NOT.' -> '!'
140 lines
3.3 KiB
Plaintext
140 lines
3.3 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
***************************************************
|
|
* X harbour Inet demo server program
|
|
*
|
|
* Giancarlo Niccolai
|
|
*
|
|
* In this program, the server uses just one thread
|
|
* to demonstrate how to use timeout sockets.
|
|
*
|
|
|
|
Procedure Main( cPort )
|
|
LOCAL Socket, s
|
|
LOCAL nResponse, cResponse
|
|
LOCAL nTurn := 0, nTurn1 := 0
|
|
LOCAL CRLF := hb_InetCRLF()
|
|
LOCAL bCont := .T.
|
|
|
|
CLS
|
|
|
|
IF Empty( cPort )
|
|
cPort := "2000"
|
|
ENDIF
|
|
|
|
hb_InetInit()
|
|
|
|
@ 1, 15 SAY "X H A R B O U R - Inet Api Server Demo"
|
|
@ 2, 5 SAY "Contact this server using telnet or the xHarbour Inet Client demo"
|
|
@ 3, 5 SAY "Press a [KEY] to terminate the program"
|
|
@ 5, 5 SAY "Server listening on port " + cPort + "..."
|
|
Socket := hb_InetServer( Val( cPort ) )
|
|
hb_InetTimeout( Socket, 500 )
|
|
|
|
DO WHILE bCont
|
|
|
|
@ 6, 5 SAY Space( 70 )
|
|
@ 7, 5 SAY Space( 70 )
|
|
@ 8, 5 SAY Space( 70 )
|
|
@ 9, 5 SAY Space( 70 )
|
|
@ 6, 5
|
|
|
|
* Accepting a connection
|
|
DO WHILE bCont
|
|
Progress( @nTurn, 5, 39 )
|
|
s := hb_InetAccept( Socket )
|
|
IF hb_InetErrorCode( Socket ) == 0
|
|
EXIT
|
|
ENDIF
|
|
IF Inkey() != 0
|
|
bCont := .f.
|
|
ENDIF
|
|
ENDDO
|
|
|
|
IF ! bCont
|
|
EXIT
|
|
ENDIF
|
|
|
|
hb_InetTimeout( s, 500 )
|
|
|
|
@ 6, 5 SAY "Connection from: " + hb_InetAddress( s ) + ":" + Str( hb_InetPort( s ), 5 )
|
|
@ 7, 5 SAY "Receiving: "
|
|
@ 8, 5
|
|
|
|
nResponse := hb_InetSend( s, "Welcome to my server!" + CRLF )
|
|
|
|
DO WHILE bCont
|
|
// This timeout ...
|
|
hb_InetTimeout( s, 250 )
|
|
// ... will trigger this periodic callback,
|
|
hb_InetPeriodCallback( s, { @Progress(), @nTurn, 6, 39 } )
|
|
// that will be called each TIMEOUT Milliseconds.
|
|
cResponse := hb_InetRecvLine( s, @nResponse )
|
|
// hb_InetRecvLine won't return until the periodic callback returns .F.,
|
|
// or the Timelimit has been reached. Timelimit is currently -1, so
|
|
// hb_InetRecvLine will wait forever.
|
|
|
|
DO CASE
|
|
CASE hb_InetErrorCode( s ) == 0
|
|
IF Lower( cResponse ) == "quit"
|
|
bCont := .F.
|
|
ENDIF
|
|
@ 8, 5 SAY space(70)
|
|
@ 8, 5 SAY cResponse
|
|
cResponse := "Count: " + Str( nResponse ) + " characters" + CRLF
|
|
hb_InetSend( s, cResponse )
|
|
|
|
CASE hb_InetErrorCode( s ) == -1
|
|
* idle (timed out)
|
|
Progress( @nTurn1, 7, 17 )
|
|
|
|
OTHERWISE
|
|
@7, 5 SAY "Received Error " + Str( hb_InetErrorCode( s ) ) + ": " + hb_InetErrorDesc( s )
|
|
@ 8, 5 SAY space(70)
|
|
@ 9, 5 SAY space(70)
|
|
@ 9, 5 SAY "Press a key to continue"
|
|
Inkey( 0 )
|
|
EXIT
|
|
|
|
END CASE
|
|
|
|
IF Inkey() != 0
|
|
bCont := .f.
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
|
|
hb_InetCleanup()
|
|
|
|
RETURN
|
|
|
|
|
|
PROCEDURE Progress( nProgress, nDrow, nDcol )
|
|
|
|
LOCAL nRow := Row(), nCol := Col()
|
|
|
|
@ nDrow, nDcol SAY "[ ]"
|
|
|
|
DO CASE
|
|
CASE nProgress = 0
|
|
@ nDrow, nDcol + 1 SAY "-"
|
|
CASE nProgress = 1
|
|
@ nDrow, nDcol + 1 SAY "\"
|
|
CASE nProgress = 2
|
|
@ nDrow, nDcol + 1 SAY "|"
|
|
CASE nProgress = 3
|
|
@ nDrow, nDcol + 1 SAY "/"
|
|
ENDCASE
|
|
|
|
nProgress++
|
|
|
|
IF nProgress == 4
|
|
nProgress := 0
|
|
ENDIF
|
|
|
|
@ nRow, nCol
|
|
|
|
RETURN
|