/* * $Id$ */ /* * Harbour Project source code: * * Copyright 2009 Pritpal Bedi * http://harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). * * As a special exception, the Harbour Project gives permission for * additional uses of the text contained in its release of Harbour. * * The exception is that, if you link the Harbour libraries with other * files to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the Harbour library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the Harbour * Project under the name Harbour. If you copy code from other * Harbour Project or Free Software Foundation releases into a copy of * Harbour, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own for Harbour, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. * */ //----------------------------------------------------------------------// //----------------------------------------------------------------------// //----------------------------------------------------------------------// // // Terminal Server Application // // Pritpal Bedi (pritpal@vouchcac.com) // 13 Feb 2009 // //----------------------------------------------------------------------// //----------------------------------------------------------------------// //----------------------------------------------------------------------// #include "common.ch" //#include "wvtwin.ch" #define WSABASEERR 10000 #define WSAECONNABORTED (WSABASEERR+53) #define WSAECONNRESET (WSABASEERR+54) //----------------------------------------------------------------------// #define TOP t_[ 1 ] #define LFT t_[ 2 ] #define BTM t_[ 3 ] #define RGT t_[ 4 ] #define ENDBLOCK "|/END\|" #define TIMER_RECEIVE 1001 #define TIMER_SEND 1002 #define TIMER_PING 1010 #define SND_SCREEN 1 // Through Timer Only #define SND_CODEBLOCK 2 // Application #define SND_CLOCKINFO 3 #define SND_CLOCKONOFF 4 #define SND_MUSIC 5 //----------------------------------------------------------------------// STATIC s_srvrSocket STATIC s_commSocket STATIC s_lSendingClient := .F. STATIC s_mutexSend := hb_mutexCreate() Function RmtSvrInitialize( cServerInfo, nTimeoutClient, nTimeRefresh ) Local lExit := .t. s_srvrSocket := NIL s_commSocket := NIL DEFAULT nTimeoutClient TO 60 // 60 SECONDS DEFAULT nTimeRefresh TO .5 // 0.5 SECONDS nTimeRefresh := 0.1 if !empty( cServerInfo ) if RmtSvrInitAsServer( cServerInfo, @s_srvrSocket, nTimeOutClient*1000 ) if RmtSvrAcceptClient( s_srvrSocket, @s_commSocket ) // Very Important Factor 20-50 No more // Hb_INetTimeout( s_commSocket, 10 ) lExit := .f. RmtSvrRunning( .t. ) hb_threadStart( @Thread_Receive(), 0.05 ) hb_threadStart( @Thread_Send() , nTimeRefresh ) hb_threadStart( @Thread_Ping() , 3 ) // Wvt_SetTimer( TIMER_RECEIVE, 50 ) // 50 ok 1/20 of a second // Wvt_SetTimer( TIMER_SEND , nTimeRefresh*1000 ) // Wvt_SetTimer( TIMER_PING , 3000 ) endif endif endif if lExit if s_srvrSocket != NIL if Hb_INetErrorCode( s_srvrSocket ) == 0 Hb_InetClose( s_srvrSocket ) endif endif if s_commSocket != NIL if Hb_INetErrorCode( s_commSocket ) == 0 Hb_InetClose( s_commSocket ) endif endif Hb_INetCleanUp() endif Return !( lExit ) //----------------------------------------------------------------------// Static Function RmtSvrInitAsServer( cServerInfo, Socket, nTimeoutClient ) Local lRet := .f. Hb_INetInit() Socket := Hb_INetServer( val( cServerInfo ) ) if Hb_InetErrorCode( Socket ) == 0 lRet := .t. endif if lRet // Wait for 1 minutes maximum : W A T C H INI Controlled // Hb_INetTimeout( Socket, nTimeoutClient ) TrmDebug( "SERVER: Connection Established!", hb_INetPort( Socket ) ) else TrmDebug( "SERVER: Connection Failed" ) endif Return lRet //----------------------------------------------------------------------// // // Waits for 2 minutes each try // Static Function RmtSvrAcceptClient( Socket, pClientSocket ) Local lRet := .t. // Local i := 0 Do While .t. pClientSocket := Hb_InetAccept( Socket ) if pClientSocket != NIL lRet := .t. endif exit //TrmDebug( "SvrConnectClient()", i++, "TRY..." ) enddo if lRet TrmDebug( "CLIENT: Connection Established!", hb_INetPort( pClientSocket ) ) else TrmDebug( "CLIENT: Connection TimedOut!" ) endif Return .t. //----------------------------------------------------------------------// Function RmtSvrSendClient( nMode, xData ) Local cCurs, nError, nBytesSent, nBytesToSend, t_, cOdd, cEvn, cOdd0, cEvn0 Local lSendCurs := .f. Local lSendScrn := .f. Local cData := "" static cCursor := " " static cSOdd := " " static cSEvn := " " static n := 0 static nScreen := 0 n++ if RmtSvrRunning() if !( s_lSendingClient ) s_lSendingClient := .t. do case case nMode == SND_SCREEN cCurs := hb_ntos( Row() ) +";"+ ; hb_ntos( Col() ) +";"+ ; hb_ntos( Set( _SET_CURSOR ) ) +";" if !( cCurs == cCursor ) lSendCurs := .t. cCursor := cCurs endif t_:= xData DEFAULT t_ TO { 0, 0, maxrow( .t. ), maxcol( .t. ) } cOdd := "" cEvn := "" GETSCREENATTRIB( TOP,LFT,BTM,RGT,@cOdd,@cEvn ) if !( cSOdd == cOdd ) .or. !( cSEvn == cEvn ) lSendScrn := .t. cSOdd := cOdd cSEvn := cEvn endif if lSendScrn nScreen++ cOdd0 := hb_zcompress( cOdd ) cEvn0 := hb_zcompress( cEvn ) cData := '' +; hb_ntos( TOP ) +';'+ hb_ntos( LFT ) +';'+ hb_ntos( BTM ) +';'+ hb_ntos( RGT ) +';'+; hb_ntos( len( cOdd0 ) ) +';'+ ; hb_ntos( len( cEvn0 ) ) +';'+ ; '' +; cOdd0 +; cEvn0 +; '' +; '' +; '' + cCurs + '' +; '' + hb_ntos( nScreen )+ '' elseif lSendCurs cData := ''+ cCurs +'' endif case nMode == SND_CODEBLOCK cData := ''+ xData +'' case nMode == SND_CLOCKINFO cData := ''+ xData +'' case nMode == SND_CLOCKONOFF cData := ''+ if( xData, 'TRUE','FALSE' ) +'' case nMode == SND_MUSIC cData := ''+ upper( xData ) +'' endcase if len( cData ) > 0 cData += ENDBLOCK nBytesToSend := len( cData ) nBytesSent := hb_INetSendAll( s_commSocket, cData, nBytesToSend ) if nBytesSent <> nBytesToSend nError := hb_INetErrorCode( s_commSocket ) TrmDebug( n,'E','VouchServer - SvrSendClient : ', nError, nBytesSent, nBytesToSend ) do case case ascan( { -2, WSAECONNABORTED, WSAECONNRESET }, nError ) > 0 TrmDebug( n,'Q','VouchServer - SvrSendClient : ', nError, nBytesSent, nBytesToSend ) DbCloseAll() Quit otherwise endcase endif endif s_lSendingClient := .f. endif endif Return nil //----------------------------------------------------------------------// Static Function RmtSvrReceiveClient() Local cKey, nBytes, nError static lInProcess := .f. if !lInProcess if hb_INetDataReady( s_commSocket ) > 0 lInProcess := .t. cKey := hb_INetRecvLine( s_commSocket, @nBytes ) if nBytes > 0 hb_KeyPut( Val( cKey ) ) elseif nBytes == 1 else nError := hb_INetErrorCode( s_commSocket ) if ascan( { -2, WSAECONNABORTED, WSAECONNRESET }, nError ) > 0 TrmDebug( 'VouchAsServer - Quitting : Error =', hb_INetErrorCode( s_commSocket ), 'nBytes =', nBytes ) DbCloseAll() Quit endif endif lInProcess := .f. endif endif Return nil //----------------------------------------------------------------------// // Required as this receive all timer events // Function Wvt_Timer( wParam ) switch wParam case TIMER_RECEIVE RmtSvrReceiveClient() exit case TIMER_SEND RmtSvrSendClient( 1, NIL ) exit case TIMER_PING if !( s_lSendingClient ) hb_INetSendAll( s_commSocket, ENDBLOCK ) endif exit end Return 0 STATIC PROCEDURE Thread_Receive( nWait ) DO WHILE .T. RmtSvrReceiveClient() hb_idleSleep( nWait ) ENDDO RETURN STATIC PROCEDURE Thread_Send( nWait ) DO WHILE .T. hb_mutexLock( s_mutexSend ) RmtSvrSendClient( 1, NIL ) hb_mutexUnlock( s_mutexSend ) hb_idleSleep( nWait ) ENDDO RETURN STATIC PROCEDURE Thread_Ping( nWait ) DO WHILE .T. hb_mutexLock( s_mutexSend ) hb_INetSendAll( s_commSocket, ENDBLOCK ) hb_mutexUnlock( s_mutexSend ) hb_idleSleep( nWait ) ENDDO RETURN //----------------------------------------------------------------------// Function RmtSvrSetInfo( cnInfo ) Local xInfo static aInfo := { NIL,NIL,NIL } if valtype( cnInfo ) == 'C' // To Retrieve it will be N aInfo[ 1 ] := val( cnInfo ) // Port to Use elseif valtype( cnInfo ) == 'N' xInfo := aInfo[ cnInfo ] endif Return xInfo //----------------------------------------------------------------------// Function RmtSvrRunning( lYes ) Local sYes static oYes := .f. sYes := oYes if valtype( lYes ) == 'L' oYes := lYes endif return sYes //----------------------------------------------------------------------// Function TrmStr2A( cStr, cDel ) Local a_:={}, n Local nlen nLen := len( cDel ) do while .t. if ( n := at( cDel, cStr ) ) == 0 exit endif aadd( a_, substr( cStr,1,n-1 ) ) cStr := substr( cStr,n+nLen ) enddo Return a_ //----------------------------------------------------------------------// Function TrmDebug( p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 ) Local cDebug := '' if p1 <> nil cDebug += TrmXtoS( p1 ) endif if p2 <> nil cDebug += ' ' + TrmXtoS( p2 ) endif if p3 <> nil cDebug += ' ' + TrmXtoS( p3 ) endif if p4 <> nil cDebug += ' ' + TrmXtoS( p4 ) endif if p5 <> nil cDebug += ' ' + TrmXtoS( p5 ) endif if p6 <> nil cDebug += ' ' + TrmXtoS( p6 ) endif if p7 <> nil cDebug += ' ' + TrmXtoS( p7 ) endif if p8 <> nil cDebug += ' ' + TrmXtoS( p8 ) endif if p9 <> nil cDebug += ' ' + TrmXtoS( p9 ) endif if p10 <> nil cDebug += ' ' + TrmXtoS( p10 ) endif #if defined( __PLATFORM__WINDOWS ) wapi_OutputDebugString( cDebug ) #endif Return nil //----------------------------------------------------------------------// FUNCTION TrmXtoS( xVar ) SWITCH ValType( xVar ) CASE "C" RETURN xVar CASE "N" RETURN Str( xVar ) CASE "D" RETURN DToC( xVar ) CASE "L" RETURN iif( xVar, "T", "F" ) ENDSWITCH RETURN "NIL" //----------------------------------------------------------------------// Function TrmDummy() Return nil //----------------------------------------------------------------------// STATIC PROCEDURE GETSCREENATTRIB( nT, nL, nB, nR, cOdd, cEvn ) LOCAL s := SaveScreen( nT, nL, nB, nR ) cOdd := CharOdd( s ) cEvn := CharEven( s ) RETURN