Files
harbour-core/harbour/tests/ipsvr.prg
Viktor Szakats c0dc8c254d 2012-10-04 12:47 UTC+0200 Viktor Szakats (harbour syenar.net)
* src/rtl/tget.prg
    ! fixed regression from 2012-01-29 17:22 UTC+0100
      when non-numeric index was allowed on a non-hash
      variable and then an RTE generated.
      Caused rto_get.prg to RTE in the middle.

  * contrib/gtwvg/activex.prg
  * contrib/gtwvg/class.prg
  * contrib/gtwvg/tests/demoxbp.prg
  * contrib/gtwvg/tests/utils.prg
  * contrib/rddads/doc/en/adsfuncs.txt
  * contrib/rddads/doc/en/readme.txt
  * contrib/xhb/tfile.prg
  * contrib/xhb/txml.prg
  * contrib/xhb/xhbole.prg
  * doc/windll.txt
  * extras/gtwvw/gtwvw.c
  * extras/gtwvw/hbgtwvw.h
  * extras/gtwvw/tests/maincoor.prg
  * extras/gtwvw/wvwcheck.c
  * extras/gtwvw/wvwdraw.c
  * extras/gtwvw/wvwedit.c
  * extras/gtwvw/wvwfuncs.c
  * extras/gtwvw/wvwmenu.c
  * extras/gtwvw/wvwpush.c
  * extras/gtwvw/wvwstbar.c
  * extras/gtwvw/wvwtbar.c
  * extras/hbdoc/tmplates.prg
  * tests/gtcolors.prg
  * tests/ipclnt.prg
  * tests/ipsvr.prg
  * tests/rto_get.prg
  * tests/rto_tb.prg
  * tests/usrrdd/exarr.prg
  * tests/usrrdd/exfcm.prg
  * tests/usrrdd/exhsx.prg
  * tests/usrrdd/exlog.prg
  * tests/usrrdd/exmemo.prg
  * tests/usrrdd/exrlx.prg
  * tests/wcecon.prg
    * full formatting using hbformat (where needed)
    * Win32 -> Windows
    * 32-bit deleted where it didn't make sense
    * using K_* constants
    ! fixed != operators where used on strings (more to come)
      Thanks to Jose F. Gimenez for the ones in txml.prg.
    * avoid "common.ch"
    % use hb_ntos() in Harbour specific code
2012-10-04 10:54:07 +00:00

102 lines
2.2 KiB
Plaintext

/*
* $Id$
*/
#include "inkey.ch"
#include "hbsocket.ch"
#define ADDRESS "0.0.0.0"
#define PORT 10000
#define EOT hb_BChar( 4 )
#define TIMEOUT 3000 // 3 seconds
#ifndef __HBSCRIPT__HBSHELL
REQUEST HB_MT
#endif
PROCEDURE Main()
LOCAL hListen
LOCAL hSocket
IF ! hb_mtvm()
? "multithread support required"
RETURN
ENDIF
? "create listening socket"
IF Empty( hListen := hb_socketOpen() )
? "socket create error " + hb_ntos( hb_socketGetError() )
ENDIF
IF ! hb_socketBind( hListen, { HB_SOCKET_AF_INET, ADDRESS, PORT } )
? "bind error " + hb_ntos( hb_socketGetError() )
ENDIF
IF ! hb_socketListen( hListen )
? "listen error " + hb_ntos( hb_socketGetError() )
ENDIF
DO WHILE .T.
IF Empty( hSocket := hb_socketAccept( hListen, , TIMEOUT ) )
IF hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
? "loop"
ELSE
? "accept error " + hb_ntos( hb_socketGetError() )
ENDIF
ELSE
? "accept socket request"
hb_threadDetach( hb_threadStart( @process(), hSocket ) )
ENDIF
IF Inkey() == K_ESC
? "quitting - esc pressed"
EXIT
ENDIF
ENDDO
? "close listening socket"
hb_socketShutdown( hListen )
hb_socketClose( hListen )
RETURN
PROCEDURE process( hSocket )
LOCAL cRequest
LOCAL nLen
LOCAL cBuf
DO WHILE .T.
cRequest := ""
nLen := 1
DO WHILE hb_BAt( EOT, cRequest ) == 0 .AND. nLen > 0
cBuf := Space( 4096 )
IF ( nLen := hb_socketRecv( hSocket, @cBuf,,, 10000 ) ) > 0 /* Timeout */
cRequest += hb_BLeft( cBuf, nLen )
ELSE
IF nLen == -1 .AND. hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
nLen := 0
ENDIF
ENDIF
ENDDO
IF nLen == -1
? "recv() error:", hb_socketGetError()
ELSEIF nLen == 0
? "connection closed"
EXIT
ELSE
? cRequest
IF "quit" $ cRequest
? "exit"
EXIT
ENDIF
ENDIF
ENDDO
? "close socket"
hb_socketShutdown( hSocket )
hb_socketClose( hSocket )
RETURN