diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 853ecf59ab..3a619cef1b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,151 @@ 2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-02-13 00:29 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) + * harbour/contrib/gtwvg/wvgcore.c + ! Fixed hb_wvt_Get|SetStringAttrib()s to respect return errcode. + + + harbour/contrib/examples/terminal + + harbour/contrib/examples/terminal/terminal.prg + + harbour/contrib/examples/terminal/terminal.ch + + harbour/contrib/examples/terminal/trm_server.prg + + harbour/contrib/examples/terminal/trm_client.prg + + harbour/contrib/examples/terminal/trm_appn.prg + + harbour/contrib/examples/terminal/reame.txt + + Added components for Harbour Terminal Protocol + + Welcome in the world of Harbour Terminal Protocol + ================================================= + + Harbour Terminal Protocol is build on three components: + + 1) Terminal Server + 2) Terminal Client + 3) The Harbour Application + + Terminal Server + =============== + Source => trm_server.prg + Link => GTWVG + Run => trm_server.exe 2011 + Parameter => MT ( Multi Threaded ) + + Terminal Server will reside on the same machine or network ( as of now ) + where Harbour Application resides. Harbour Application must be able + to be run by ShellExecute() WINAPI function issued by the Terminal Server. + + + Terminal Client + =============== + Source => trm_client.prg + Link => GTWVG + Run => trm_client.exe + + + [Parameters - Norammly Supplied to Appln - Separated by SPACE ] + [InitDirectory - Harbour Application's Startup Folder ] + Mode => ST ( Single Threaded ) + + Terminal Client can be distributed anywhere there is ACCESS TO designated TCP/IP port, + be it a network clinet or any computer having internet avalable. + Parameters supplied TO Harbour Client can be on command line or as an .ini file. + .Ini file may contain these entries: + + ServerIP = 127.0.0.1 | vouch.dynalias.com + ServerPort = 2011 + Application = c:\harbour\contrib\examples\terminal\trm_appn.exe + Parameters = any number of parameters separated by a space + InitDirectory = Complete Folder path from where Harbour Appln will be invoked. + + IF parameters are supplied as .ini file, then .ini filename ( without path ) will be the + only parameter - note - only one parameter passed on the command line. + + + Harbour Application + =================== + Source(s) => trm_appn.prg | Your program sources + + terminal.prg + + terminal.ch + Link => GTWVG + Run => No + Mode => ST ( Single Thread ) + + Main() FUNCTION in Harbour Application will have TO be modified TO accept + one additional parameter at the END of the usual parameters + your application is accepting as ususal. And make sure that you send the same + number of parameter either on the command line or through .ini file. + parameter is supplied by Harbour Terminal Server. + + At just start of the Harbour Application, immediately after variable definitions + in main() add these lines: + + FUNCTION Main( [p1] [, p2] [, p3], cServerInfo ) + LOCAL x, y + + // Required it initialize the GTWVG window + SetColor( 'N/W,W/B,W+/N' ) + CLS + ? ' ' + + #ifdef __REMOTE__ + // cServerInfo will be supplied by the Remote Server + // + RmtSvrSetInfo( cServerInfo ) + + IF ( nServerPort := RmtSvrSetInfo( 1 ) ) <> NIL .and. nServerPort > 0 + IF !RmtSvrInitialize( NTRIM( nServerPort ), 60/*nTimeoutClient*/, 0.5 /*nTimeRefresh*/ ) + Quit + ENDIF + ENDIF + #endif + + ... + ... + + RETURN + + + Must remember to issue - ANNOUNCE HB_NOSTARTUPWINDOW - somewhere in your sources + Please note that we do not want to show up the Harbour console on the server so + HB_NOSTARTUPWINDOW symbol must be defined. + + And this is the only requirement for your appln to be NET ready. + + + Technical Overview + ================== + Client connects to Server. + Server looks for a free port - 45000+. + Server invokes Harbour Application with client supplied parameters + . + Harbour Application itself behaves as server on start listening on designated port. + Server informs back to Client about this port where Harbour Application is listening. + Client connects to Harbour Application on designated port. + If connection is successful, Server closes the connection from Client and Application. + Client and Application then have the direct communication. + Client transmits the keystrokes and Application reacts TO those events as IF supplied via keyboard. + Application transmits the screen buffer back TO client IF there have been any changes. + Application also transmits special commands, call them 'Remote Procedure Calls'. + Client responds TO received buffer according TO instruction it contains. + Client retrieves buffer per command basis. + Events are not serialized. + + + The Bottom Line + =============== + The protocol above works as expected but is not as sophisticated as it should be. + GTNET as Przemek has been talking about will be the perfect solution though this + can be the basis FOR future enhancements. A lot can be improved, i.e., remote + printing, etc., which I hope you Gurus can implement in no times. + + It is my humble contribution TO the Harbour world. + + + Regards + Pritpal Bedi + a student of software analysis & design + + 2009-02-13 09:25 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * contrib/rddads/rddads.h ! Added missing extern directive. diff --git a/harbour/contrib/examples/terminal/readme.txt b/harbour/contrib/examples/terminal/readme.txt new file mode 100644 index 0000000000..f0ae3db84c --- /dev/null +++ b/harbour/contrib/examples/terminal/readme.txt @@ -0,0 +1,132 @@ + +Welcome in the world of Harbour Terminal Protocol +================================================= + +Harbour Terminal Protocol is build on three components: + +1) Terminal Server +2) Terminal Client +3) The Harbour Application + +Terminal Server +=============== + Source => trm_server.prg + Link => GTWVG + Run => trm_server.exe 2011 + Parameter => MT ( Multi Threaded ) + + Terminal Server will reside on the same machine or network ( as of now ) + where Harbour Application resides. Harbour Application must be able + to be run by ShellExecute() WINAPI function issued by the Terminal Server. + + +Terminal Client +=============== + Source => trm_client.prg + Link => GTWVG + Run => trm_client.exe + + + [Parameters - Norammly Supplied to Appln - Separated by SPACE ] + [InitDirectory - Harbour Application's Startup Folder ] + Mode => ST ( Single Threaded ) + + Terminal Client can be distributed anywhere there is ACCESS TO designated TCP/IP port, + be it a network clinet or any computer having internet avalable. + Parameters supplied TO Harbour Client can be on command line or as an .ini file. + .Ini file may contain these entries: + + ServerIP = 127.0.0.1 | vouch.dynalias.com + ServerPort = 2011 + Application = c:\harbour\contrib\examples\terminal\trm_appn.exe + Parameters = any number of parameters separated by a space + InitDirectory = Complete Folder path from where Harbour Appln will be invoked. + + IF parameters are supplied as .ini file, then .ini filename ( without path ) will be the + only parameter - note - only one parameter passed on the command line. + + +Harbour Application +=================== + Source(s) => trm_appn.prg | Your program sources + + terminal.prg + + terminal.ch + Link => GTWVG + Run => No + Mode => ST ( Single Thread ) + + Main() FUNCTION in Harbour Application will have TO be modified TO accept + one additional parameter at the END of the usual parameters + your application is accepting as ususal. And make sure that you send the same + number of parameter either on the command line or through .ini file. + parameter is supplied by Harbour Terminal Server. + + At just start of the Harbour Application, immediately after variable definitions + in main() add these lines: + + FUNCTION Main( [p1] [, p2] [, p3], cServerInfo ) + LOCAL x, y + + // Required it initialize the GTWVG window + SetColor( 'N/W,W/B,W+/N' ) + CLS + ? ' ' + + #ifdef __REMOTE__ + // cServerInfo will be supplied by the Remote Server + // + RmtSvrSetInfo( cServerInfo ) + + IF ( nServerPort := RmtSvrSetInfo( 1 ) ) <> NIL .and. nServerPort > 0 + IF !RmtSvrInitialize( NTRIM( nServerPort ), 60/*nTimeoutClient*/, 0.5 /*nTimeRefresh*/ ) + Quit + ENDIF + ENDIF + #endif + + ... + ... + + RETURN + + + Must remember to issue - ANNOUNCE HB_NOSTARTUPWINDOW - somewhere in your sources + Please note that we do not want to show up the Harbour console on the server so + HB_NOSTARTUPWINDOW symbol must be defined. + + And this is the only requirement for your appln to be NET ready. + + +Technical Overview +================== + Client connects to Server. + Server looks for a free port - 45000+. + Server invokes Harbour Application with client supplied parameters + . + Harbour Application itself behaves as server on start listening on designated port. + Server informs back to Client about this port where Harbour Application is listening. + Client connects to Harbour Application on designated port. + If connection is successful, Server closes the connection from Client and Application. + Client and Application then have the direct communication. + Client transmits the keystrokes and Application reacts TO those events as IF supplied via keyboard. + Application transmits the screen buffer back TO client IF there have been any changes. + Application also transmits special commands, call them 'Remote Procedure Calls'. + Client responds TO received buffer according TO instruction it contains. + Client retrieves buffer per command basis. + Events are not serialized. + + +The Bottom Line +=============== + The protocol above works as expected but is not as sophisticated as it should be. + GTNET as Przemek has been talking about will be the perfect solution though this + can be the basis FOR future enhancements. A lot can be improved, i.e., remote + printing, etc., which I hope you Gurus can implement in no times. + + It is my humble contribution TO the Harbour world. + + +Regards +Pritpal Bedi +a student of software analysis & design + diff --git a/harbour/contrib/examples/terminal/terminal.ch b/harbour/contrib/examples/terminal/terminal.ch new file mode 100644 index 0000000000..b9fa46b8a6 --- /dev/null +++ b/harbour/contrib/examples/terminal/terminal.ch @@ -0,0 +1,126 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * Copyright 2009 Pritpal Bedi + * http://www.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. + * + */ + +#define WSABASEERR 10000 + +/* + * Windows Sockets definitions of regular Microsoft C error constants + */ +#define WSAEINTR (WSABASEERR+4) +#define WSAEBADF (WSABASEERR+9) +#define WSAEACCES (WSABASEERR+13) +#define WSAEFAULT (WSABASEERR+14) +#define WSAEINVAL (WSABASEERR+22) +#define WSAEMFILE (WSABASEERR+24) + +/* + * Windows Sockets definitions of regular Berkeley error constants + */ +#define WSAEWOULDBLOCK (WSABASEERR+35) +#define WSAEINPROGRESS (WSABASEERR+36) +#define WSAEALREADY (WSABASEERR+37) +#define WSAENOTSOCK (WSABASEERR+38) +#define WSAEDESTADDRREQ (WSABASEERR+39) +#define WSAEMSGSIZE (WSABASEERR+40) +#define WSAEPROTOTYPE (WSABASEERR+41) +#define WSAENOPROTOOPT (WSABASEERR+42) +#define WSAEPROTONOSUPPORT (WSABASEERR+43) +#define WSAESOCKTNOSUPPORT (WSABASEERR+44) +#define WSAEOPNOTSUPP (WSABASEERR+45) +#define WSAEPFNOSUPPORT (WSABASEERR+46) +#define WSAEAFNOSUPPORT (WSABASEERR+47) +#define WSAEADDRINUSE (WSABASEERR+48) +#define WSAEADDRNOTAVAIL (WSABASEERR+49) +#define WSAENETDOWN (WSABASEERR+50) +#define WSAENETUNREACH (WSABASEERR+51) +#define WSAENETRESET (WSABASEERR+52) +#define WSAECONNABORTED (WSABASEERR+53) +#define WSAECONNRESET (WSABASEERR+54) +#define WSAENOBUFS (WSABASEERR+55) +#define WSAEISCONN (WSABASEERR+56) +#define WSAENOTCONN (WSABASEERR+57) +#define WSAESHUTDOWN (WSABASEERR+58) +#define WSAETOOMANYREFS (WSABASEERR+59) +#define WSAETIMEDOUT (WSABASEERR+60) +#define WSAECONNREFUSED (WSABASEERR+61) +#define WSAELOOP (WSABASEERR+62) +#define WSAENAMETOOLONG (WSABASEERR+63) +#define WSAEHOSTDOWN (WSABASEERR+64) +#define WSAEHOSTUNREACH (WSABASEERR+65) +#define WSAENOTEMPTY (WSABASEERR+66) +#define WSAEPROCLIM (WSABASEERR+67) +#define WSAEUSERS (WSABASEERR+68) +#define WSAEDQUOT (WSABASEERR+69) +#define WSAESTALE (WSABASEERR+70) +#define WSAEREMOTE (WSABASEERR+71) + +/* + * Extended Windows Sockets error constant definitions + */ +#define WSASYSNOTREADY (WSABASEERR+91) +#define WSAVERNOTSUPPORTED (WSABASEERR+92) +#define WSANOTINITIALISED (WSABASEERR+93) +#define WSAEDISCON (WSABASEERR+101) +#define WSAENOMORE (WSABASEERR+102) +#define WSAECANCELLED (WSABASEERR+103) +#define WSAEINVALIDPROCTABLE (WSABASEERR+104) +#define WSAEINVALIDPROVIDER (WSABASEERR+105) +#define WSAEPROVIDERFAILEDINIT (WSABASEERR+106) +#define WSASYSCALLFAILURE (WSABASEERR+107) +#define WSASERVICE_NOT_FOUND (WSABASEERR+108) +#define WSATYPE_NOT_FOUND (WSABASEERR+109) +#define WSA_E_NO_MORE (WSABASEERR+110) +#define WSA_E_CANCELLED (WSABASEERR+111) +#define WSAEREFUSED (WSABASEERR+112) + +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// diff --git a/harbour/contrib/examples/terminal/terminal.prg b/harbour/contrib/examples/terminal/terminal.prg new file mode 100644 index 0000000000..b199fd4cfe --- /dev/null +++ b/harbour/contrib/examples/terminal/terminal.prg @@ -0,0 +1,523 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * Copyright 2009 Pritpal Bedi + * http://www.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' +#include 'terminal.ch' + +//----------------------------------------------------------------------// + +#define TOP t_[ 1 ] +#define LFT t_[ 2 ] +#define BTM t_[ 3 ] +#define RGT t_[ 4 ] + +#define ENDBLOCK '|/END\|' + +#define NTRIM( n ) ltrim( str( n ) ) + +#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 srvrSocket +STATIC commSocket +STATIC lSendingClient := .f. + +//----------------------------------------------------------------------// +#pragma BEGINDUMP + +#include "hbapi.h" +#include "hbgtcore.h" + +#include + +#if 0 +#define TIMER_RECEIVE 1001 +#define TIMER_SEND 1002 +#define TIMER_PING 1010 +#endif + +HB_FUNC( OUTPUTDEBUGSTRING ) +{ + OutputDebugString( hb_parc( 1 ) ); +} + +extern void hb_wvt_GetStringAttrib( USHORT, USHORT left, USHORT bottom, USHORT right, BYTE * sBuffer, BYTE * sAttrib ); + +#pragma ENDDUMP +//----------------------------------------------------------------------// + +Function RmtSvrInitialize( cServerInfo, nTimeoutClient, nTimeRefresh ) + Local lExit := .t. + Local nTimeOut := 50 // PICK FROM EXTERNASL SOURCE + + srvrSocket := NIL + commSocket := NIL + + DEFAULT nTimeoutClient TO 60 // 60 SECONDS + DEFAULT nTimeRefresh TO .5 // 0.5 SECONDS + + nTimeRefresh := 0.1 + + if !empty( cServerInfo ) + if RmtSvrInitAsServer( cServerInfo, @srvrSocket, nTimeOutClient*1000 ) + + if RmtSvrAcceptClient( srvrSocket, @commSocket ) + // Very Important Factor 20-50 No more + // + Hb_INetTimeout( commSocket, 10 ) + + lExit := .f. + + RmtSvrRunning( .t. ) + + 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 srvrSocket != NIL + if Hb_INetErrorCode( srvrSocket ) == 0 + Hb_InetClose( srvrSocket ) + endif + endif + if commSocket != NIL + if Hb_INetErrorCode( commSocket ) == 0 + Hb_InetClose( 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!', 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!', INetPort( pClientSocket ) ) + else +TrmDebug( 'CLIENT: Connection TimedOut!' ) + endif + + Return .t. + +//----------------------------------------------------------------------// + +Function RmtSvrSendClient( nMode, xData ) + Local cScr, 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 !( lSendingClient ) + lSendingClient := .t. + + do case + case nMode == SND_SCREEN + cCurs := NTRIM( Row() ) +';'+ ; + NTRIM( Col() ) +';'+ ; + NTRIM( Set( _SET_CURSOR ) ) +';' + + if !( cCurs == cCursor ) + lSendCurs := .t. + cCursor := cCurs + endif + + t_:= xData + DEFAULT t_ TO { 0, 0, maxrow( .t. ), maxcol( .t. ) } + + cOdd := "" + cEvn := "" + + HB_INLINE( TOP,LFT,BTM,RGT,@cOdd,@cEvn ){ + ULONG uiSize; + void * pBuffer; + void * qBuffer; + + hb_gtRectSize( hb_parnl( 1 ),hb_parnl( 2 ),hb_parnl( 3 ),hb_parnl( 4 ),&uiSize ); + pBuffer = hb_xgrab( (uiSize/2)+1 ); + qBuffer = hb_xgrab( (uiSize/2)+1 ); + + hb_wvt_GetStringAttrib( hb_parnl( 1 ),hb_parnl( 2 ),hb_parnl( 3 ),hb_parnl( 4 ), pBuffer, qBuffer ); + hb_storclen( pBuffer, (uiSize/2), 5 ); + hb_storclen( qBuffer, (uiSize/2), 6 ); + + hb_xfree( pBuffer ); + hb_xfree( qBuffer ); + } + + if !( cSOdd == cOdd ) .or. !( cSEvn == cEvn ) + lSendScrn := .t. + cSOdd := cOdd + cSEvn := cEvn + endif + + if lSendScrn + nScreen++ + + cOdd0 := hb_compress( cOdd ) + cEvn0 := hb_compress( cEvn ) + + cData := '' +; + NTRIM( TOP ) +';'+ NTRIM( LFT ) +';'+ NTRIM( BTM ) +';'+ NTRIM( RGT ) +';'+; + NTRIM( len( cOdd0 ) ) +';'+ ; + NTRIM( len( cEvn0 ) ) +';'+ ; + '' +; + cOdd0 +; + cEvn0 +; + '' +; + '' +; + '' + cCurs + '' +; + '' + NTRIM( 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 := INetSendAll( commSocket, cData, nBytesToSend ) + + if nBytesSent <> nBytesToSend + nError := INetErrorCode( 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 + + lSendingClient := .f. + endif + endif + + Return nil + +//----------------------------------------------------------------------// + +Static Function RmtSvrReceiveClient() + Local cKey, nBytes, nError + + static lInProcess := .f. + + if !lInProcess + if INetDataReady( commSocket ) > 0 + lInProcess := .t. + + cKey := INetRecvLine( commSocket, @nBytes ) + + if nBytes > 0 + Wvt_Keyboard( val( cKey ) ) + + elseif nBytes == 1 + + else + nError := INetErrorCode( commSocket ) + if ascan( { -2, WSAECONNABORTED, WSAECONNRESET }, nError ) > 0 +TrmDebug( 'VouchAsServer - Quitting : Error =', INetErrorCode( 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 !( lSendingClient ) + INetSendAll( commSocket, ENDBLOCK ) + endif + exit + + end + + Return ( 0 ) + +//----------------------------------------------------------------------// + +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 + + OutputDebugString( cDebug ) + + Return nil + +//----------------------------------------------------------------------// + +Function TrmXtoS( xVar ) + Local cVar := '' + Local cType := valtype( xVar ) + + do case + case cType == 'C' + cVar := xVar + + case cType == 'N' + cVar := str( xVar ) + + case cType == 'D' + cVar := dtoc( xVar ) + + case cType == 'L' + cVar := if( xVar, 'T','F' ) + + otherwise + cVar := 'NIL' + + endcase + + Return cVar + +//----------------------------------------------------------------------// + +Function TrmDummy() + Return nil + +//----------------------------------------------------------------------// + diff --git a/harbour/contrib/examples/terminal/trm_appn.prg b/harbour/contrib/examples/terminal/trm_appn.prg new file mode 100644 index 0000000000..eac1582f76 --- /dev/null +++ b/harbour/contrib/examples/terminal/trm_appn.prg @@ -0,0 +1,206 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * Copyright 2009 Pritpal Bedi + * http://www.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 Application +// +// Pritpal Bedi (pritpal@vouchcac.com) +// 13 Feb 2009 +// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// +/* + Just comment it out if you want a normal application + This is the only requirement to turn your application + as a remote server. +*/ + +#include 'hbgtinfo.ch' + + +#define __REMOTE__ + +#define SND_SCREEN 1 // Through Timer Only +#define SND_CODEBLOCK 2 // Application +#define SND_CLOCKINFO 3 +#define SND_CLOCKONOFF 4 +#define SND_MUSIC 5 + +#define NTRIM( n ) ltrim( str( n ) ) + +//----------------------------------------------------------------------// + +ANNOUNCE HB_NOSTARTUPWINDOW + +//----------------------------------------------------------------------// + +FUNCTION Main( cServerInfo ) + LOCAL aMenu := {} + LOCAL aOptions := {} + LOCAL nSel + LOCAL nServerPort + + SetColor( 'N/W,W/B,W+/N' ) + CLS + ? ' ' + + #ifdef __REMOTE__ + // This can be redefined in case user want another format + // + // cServerInfo will be supplied by the Remote Server + // + RmtSvrSetInfo( cServerInfo ) + + IF ( nServerPort := RmtSvrSetInfo( 1 ) ) <> NIL .and. nServerPort > 0 + IF !RmtSvrInitialize( NTRIM( nServerPort ), 60/*nTimeoutClient*/, 0.5 /*nTimeRefresh*/ ) + Quit + ENDIF + hb_gtInfo( HB_GTI_WINTITLE, NTRIM( nServerPort ) ) + ENDIF + #endif + + aadd( aMenu, { 'Play Music', {|| App_PlayMusic() } } ) + aadd( aMenu, { ' ' , {|| NIL } } ) + aadd( aMenu, { 'Show Clock', {|| App_DispClock() } } ) + + aeval( aMenu, {|e_| aadd( aOptions, e_[ 1 ] ) } ) + + DO WHILE .t. + nSel := AChoice( 10,30,20,50, aOptions ) + + IF nSel == 0 + EXIT + ENDIF + + Eval( aMenu[ nSel,2 ] ) + ENDDO + + RETURN nil + +//----------------------------------------------------------------------// + +FUNCTION HB_GTSys() + + REQUEST HB_GT_WVG_DEFAULT + + RETURN NIL + +//----------------------------------------------------------------------// + +FUNCTION App_DispClock() + + RETURN nil + +//----------------------------------------------------------------------// + +FUNCTION App_PlayMusic() + LOCAL cTheme := 'CHARGE' + LOCAL aOptions := {'THUD','WAITON','WAITOFF','CHARGE','NANNYBOO','BADKEY' } + LOCAL cScr := SaveScreen( 0, 0, maxrow(), maxcol() ) + LOCAL nSel + + #ifdef __REMOTE__ + DO WHILE .t. + nSel := AChoice( 10, 10, 17, 20, aOptions ) + RestScreen( 0, 0, maxrow(), maxcol(), cScr ) + IF nSel == 0 + RETURN nil + ENDIF + cTheme := aOptions[ nSel ] + RmtSvrSendClient( SND_MUSIC, cTheme ) + ENDDO + #endif + + DO CASE + + case cTheme == 'THUD' + #ifndef __REMOTE__ + tone(60,0.5) + #endif + + case cTheme == 'WAITON' + #ifndef __REMOTE__ + tone(800,1); tone(1600,1) + #endif + + case cTheme == 'WAITOFF' + #ifndef __REMOTE__ + tone(1600,1); tone(800,1) + #endif + + case cTheme == 'CHARGE' + #ifndef __REMOTE__ + Eval( {|| tone(523,2),tone(698,2),tone(880,2),tone(1046,4),tone(880,2),tone(1046,8) } ) + #endif + + case cTheme == 'NANNYBOO' + #ifndef __REMOTE__ + AEval( {{196,2},{196,2},{164,2},{220,2},{196,4},{164,4}}, {|a| tone(a[1],a[2]) } ) + #endif + + case cTheme == 'BADKEY' + #ifndef __REMOTE__ + tone(480,0.25); tone(240,0.25) + #endif + + endcase + + #ifdef __REMOTE__ + RmtSvrSendClient( SND_MUSIC, cTheme ) + #endif + + RETURN nil + +//----------------------------------------------------------------------// + diff --git a/harbour/contrib/examples/terminal/trm_client.prg b/harbour/contrib/examples/terminal/trm_client.prg new file mode 100644 index 0000000000..8db9f5527e --- /dev/null +++ b/harbour/contrib/examples/terminal/trm_client.prg @@ -0,0 +1,856 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * Copyright 2009 Pritpal Bedi + * http://www.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 Client +// +// Pritpal Bedi (pritpal@vouchcac.com) +// 13 Feb 2009 +// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// + +#include 'hbgtinfo.ch' +#include 'fileio.ch' + +//----------------------------------------------------------------------// + +#define WSABASEERR 10000 +#define WSAECONNABORTED (WSABASEERR+53) + +//----------------------------------------------------------------------// + +#define TIMER_RECEIVE 5001 +#define TIMER_SEND 5002 +#define TIMER_PING 5010 +#define TIMER_CLOCK 5020 +#define TIMER_REFRESH 5030 + +#define COMPILE( cStr ) &( '{|v| '+cStr+ '}' ) +#define CR_LF chr(13)+chr(10) +#define NTRIM( n ) ltrim( str( n ) ) + +#define VouchClientVersion '0.9.4' + +#define __TRACE__ + +//----------------------------------------------------------------------// + +REQUEST Tone + +//----------------------------------------------------------------------// + +Static commSocket +static nTotalBytes := 0 +static nScreens := 0 +static nPing := 0 +static lReceiving := .f. +static lSending := .f. +static lTraceLog := .f. +static nTrace := 0 +static aDat := { {'',''} } + +//----------------------------------------------------------------------// +#pragma BEGINDUMP +//----------------------------------------------------------------------// + +#include "hbapi.h" +#include "hbapigt.h" + +extern void hb_wvt_GetStringAttrib( USHORT top, USHORT left, USHORT bottom, USHORT right, BYTE * sBuffer, BYTE * sAttrib ); +extern void hb_wvt_PutStringAttrib( USHORT top, USHORT left, USHORT bottom, USHORT right, BYTE * sBuffer, BYTE * sAttrib ); + +#include +HB_FUNC( OUTPUTDEBUGSTRING ) +{ + LPTSTR text = HB_TCHAR_CONVTO( hb_parc( 1 ) ); + OutputDebugString( text ); + HB_TCHAR_FREE( text ); +} + +//----------------------------------------------------------------------// +#pragma ENDDUMP +//----------------------------------------------------------------------// + +Function Main( cAddress, cPort, cAppln, cParams, cDirectory ) + LOCAL Socket, n, cText, cResponse, nThread, hMutex, hMutex1 + + ResolveParams( @cAddress, @cPort, @cAppln, @cParams, @cDirectory ) + + TrmInitFont() + + SetCursor( 0 ) + SetColor( 'W/N' ) + SetBlink( .T. ) + + CLS + + /* Comment out following line if you wish to receive log */ + // lTraceLog := .t. + + Hb_InetInit() + + TrmDispLogin( cAddress, cPort ) + + Socket := Hb_InetConnect( cAddress, Val( cPort ) ) + IF Hb_InetErrorCode( Socket ) != 0 + DispOutAt( 17,0, padc( "Can't connect with " + cAddress +" : " + Hb_InetErrorDesc( Socket ),maxcol()+1 ), 'w+/n' ) + DispOutAt( 18,0, padc( "Press a key to terminate the program...", maxcol()+1 ), 'w+/n' ) + Inkey( 0 ) + RETURN nil + ENDIF + + // Wvt_SetTitle( '[ '+cAddress+' ][ '+cPort+' ]' ) + hb_gtInfo( HB_GTI_WINTITLE, '[ '+cAddress+' ][ '+cPort+' ]' ) + DispOutAt( 18,0, padc( "Connection Secured",maxcol()+1 ), 'w+/n' ) + // Wvt_SetTitle( '[ '+cAddress+' ][ '+cPort+' ]'+'[Secured]' ) + hb_gtInfo( HB_GTI_WINTITLE, '[ '+cAddress+' ][ '+cPort+' ]'+'[Secured]' ) + + cText := 'VOUCH|'+ cAppln +'|'+ cParams +'|'+ cDirectory +'|' + + Hb_InetSend( Socket, cText + CR_LF ) + + if TrmReceiveALine( Socket, @cResponse ) + if ( n := at( ';', cResponse ) ) > 0 + if substr( cResponse,1,n-1 ) == 'CONNECT' + TrmServeServer( Socket, cAddress, substr( cResponse,n+1 ) ) + endif + endif + endif + + Hb_InetClose( Socket ) + Hb_InetCleanup() + + RETURN( 0 ) + +//----------------------------------------------------------------------// + +FUNCTION HB_GTSys() + + REQUEST HB_GT_WVG_DEFAULT + + RETURN nil + +//----------------------------------------------------------------------// + +STATIC FUNCTION ResolveParams( cAddress, cPort, cAppln, cParams, cDirectory ) + Local i, n, cLine, cVal, nLines, cTxt, cPath, cFile + Local lFile := .f. + Local dat_ := {} + + if PCount() == 1 + cFile := cAddress + cAddress := '' + else + cFile := 'vclient.ini' + endif + + cPath := HB_INLINE(){ + int iSize; + TCHAR buffer[ MAX_PATH ]; + + iSize = GetModuleFileName( NULL, buffer, MAX_PATH ); + if ( iSize > 0 ) + { + hb_retc( HB_TCHAR_CONVFROM( buffer ) ); + } + else + { + hb_retc( "" ); + } + } + + if !empty( cPath ) + n := rat( '\', cPath ) + if n > 0 + cPath := substr( cPath, 1, n ) + endif + endif + cFile := cPath + cFile + + lFile := file( cFile ) + + if empty( cAddress ) .and. lFile + alert( 'File found: '+cFile ) + lFile := .t. + cTxt := memoread( cFile ) + nLines := mlCount( cTxt,254,3,.f. ) + for i := 1 to nLines + if !empty( cLine := memoLine( cTxt,254,i,3,.f. ) ) + if ( n := at( '#',cLine ) ) > 0 + cLine := substr( cLine,1,n-1 ) + endif + if ( n := at( '=',cLine ) ) > 0 + if !empty( cVal := alltrim( substr( cLine,n+1 ) ) ) + aadd( dat_,{ lower( alltrim( substr( cLine,1,n-1 ) ) ),cVal } ) + endif + endif + endif + next + + if !empty( dat_ ) + if ( n := ascan( dat_, {|e_| e_[ 1 ] == 'serverip' } ) ) > 0 + cAddress := dat_[ n,2 ] + endif + if ( n := ascan( dat_, {|e_| e_[ 1 ] == 'serverport' } ) ) > 0 + cPort := dat_[ n,2 ] + endif + if ( n := ascan( dat_, {|e_| e_[ 1 ] == 'application' } ) ) > 0 + cAppln := dat_[ n,2 ] + endif + if ( n := ascan( dat_, {|e_| e_[ 1 ] == 'parameters' } ) ) > 0 + cParams := dat_[ n,2 ] + endif + if ( n := ascan( dat_, {|e_| e_[ 1 ] == 'initdirectory' } ) ) > 0 + cDirectory := dat_[ n,2 ] + endif + endif + endif + + if !empty( cAddress ) + if empty( cPort ) .or. empty( cAppln ) + cAddress := '' + endif + endif + + // Defaults to Vouch Server + // + if empty( cAddress ) + cAddress := 'vouch.dynalias.com' + cPort := '2011' + cAppln := '\Creative.acp\VouchRMT\Vouch.exe' + cParams := '\creative.dat\vouchsvr' + cDirectory := '\Creative.acp\VouchRMT\' + endif + + if empty( cParams ) + cParams := '' + endif + if empty( cDirectory ) + cDirectory := '' + endif + + Return nil + +//----------------------------------------------------------------------// + +Function TrmServeServer( Socket, cAddress, cServerInfo ) + Local nPort, hDlg, a_, nError + Local nSeconds := Seconds() + + a_:= hb_aTokens( cServerInfo, ';' ) + nPort := val( a_[ 2 ] ) + + commSocket := Hb_INetConnect( cAddress, nPort ) + + do while Hb_INetErrorCode( commSocket ) != 0 + + commSocket := Hb_INetConnect( cAddress, nPort ) + if Seconds()-nSeconds > 60 .or. Seconds()-nSeconds < 0 + exit + endif + enddo + IF Hb_InetErrorCode( commSocket ) != 0 + Hb_INetClose( Socket ) + DispOutAt( 17,0, padc( "Can't connect with " + cAddress+": " + Hb_InetErrorDesc( commSocket ),maxcol()+1), 'w+/n' ) + DispOutAt( 18,0, padc( "Press a key to terminate the program", maxcol()+1 ), 'w+/n' ) + Inkey(0) + quit + ENDIF + + // Very Important Factor 10-50 ok + // + Hb_INetTimeout( commSocket, -1 ) + + Hb_INetSend( Socket, 'ARCONNECTED' + CR_LF ) + Hb_INetClose( Socket ) + + Wvt_SetTimer( TIMER_RECEIVE, 10 ) + Wvt_SetTimer( TIMER_SEND , 1 ) + Wvt_SetTimer( TIMER_CLOCK , 5000 ) + Wvt_SetTimer( TIMER_PING , 3000 ) + + nSeconds := Seconds() + do while .t. + Wvt_ProcessMessages() + + nError := Hb_INetErrorCode( commSocket ) + if ascan( { -2, WSAECONNABORTED, 10054 }, nError ) > 0 + Exit + endif + enddo + + Wvt_KillTimer( TIMER_RECEIVE ) + Wvt_KillTimer( TIMER_SEND ) + Wvt_KillTimer( TIMER_CLOCK ) + Wvt_KillTimer( TIMER_PING ) + + Return nil + +//----------------------------------------------------------------------// + +Function TrmReceiveServer() + Local a_, b_, cBuffer, nBytes, cCommand, cData, nError, cOdd, cEvn, n, cMix + LOCAL cOdd1, cEvn1 + + if !( lReceiving ) .and. ( commSocket != NIL ) + lReceiving := .t. + if ( nBytes := Hb_INetDataReady( commSocket ) ) > 0 + + Hb_INetTimeout( commSocket, 10 ) + cBuffer := Hb_INetRecvEndBlock( commSocket, '|/END\|', @nBytes ) + Hb_INetTimeout( commSocket, -1 ) + if nBytes > 0 .and. !empty( cBuffer ) + nTotalBytes += nBytes + + do while .t. + cCommand := TrmFetchCommand( @cBuffer, @cData ) + if empty( cCommand ) + exit + endif + + do case + case cCommand == 'SCR' + nScreens++ + a_:= Str2A( cData, '' ) + b_:= hb_aTokens( a_[ 1 ], ';' ) + aeval( b_, {|e,i| b_[ i ] := val( e ) } ) + + n := ( b_[ 3 ]-b_[ 1 ]+1 ) * ( b_[ 4 ]-b_[ 2 ]+1 ) + + cOdd1 := substr( a_[ 2 ], 1, b_[ 5 ] ) + cOdd := hb_uncompress( n, cOdd1 ) + cEvn1 := substr( a_[ 2 ], b_[ 5 ]+1 ) + cEvn := hb_uncompress( n, cEvn1 ) + + HB_INLINE( b_[ 1 ], b_[ 2 ], b_[ 3 ], b_[ 4 ], cOdd, cEvn ){ + hb_wvt_PutStringAttrib( hb_parnl( 1 ), hb_parnl( 2 ), + hb_parnl( 3 ), hb_parnl( 4 ), + ( BYTE* ) hb_parc( 5 ), + ( BYTE* ) hb_parc( 6 ) ); + } + + case cCommand == 'CRS' + a_:= hb_aTokens( @cData, ';' ) + SetPos( val( a_[ 1 ] ), val( a_[ 2 ] ) ) + SetCursor( val( a_[ 3 ] ) ) + + case cCommand == 'ID' + // Verify if objects are serialized and executed accordingly + + case cCommand == 'MUSIC' + PlayMusic( cData ) + + case cCommand == 'CLK_ONOFF' + SetClock( cData == 'TRUE' ) + + case cCommand == 'CLK_INFO' + SetClockInfo( cData ) + + case cCommand == 'BLK' + BEGIN SEQUENCE + Eval( COMPILE( cData ) ) + ENDSEQUENCE + + endcase + enddo + endif + ENDIF + + lReceiving := .f. + endif + + Return ( 0 ) + +//----------------------------------------------------------------------// + +Function WVT_TIMER( wParam ) + + switch wParam + + case TIMER_SEND + inkey() + exit + + case TIMER_RECEIVE + TrmReceiveServer() + exit + + case TIMER_PING + Keyboard( 1021 ) + exit + + case TIMER_CLOCK + DispClock() + exit + + end + + Return 0 + +//----------------------------------------------------------------------// + +Function Wvt_Key( nKey ) + + if commSocket <> NIL .and. !empty( nKey ) .and. ( nKey < 1000 ) + lSending := .t. + Hb_INetSendAll( commSocket, ltrim( str( nKey ) ) + CR_LF ) + lSending := .f. + endif + + Return ( 0 ) + +//----------------------------------------------------------------------// + +Static Function TrmFetchCommand( cBuffer, cData ) + Local cToken, c, cCmd := '' + Local n + + if left( @cBuffer,1 ) == '<' + if ( n := at( '>', @cBuffer ) ) > 0 + c := substr( cBuffer, 2, n-2 ) + cBuffer := substr( cBuffer, n+1 ) + + cToken := '' + if ( n := at( cToken, cBuffer ) ) > 0 + cData := substr( cBuffer, 1, n-1 ) + cBuffer := substr( cBuffer, n+len( cToken ) ) + + cCmd := c + endif + endif + endif + + Return cCmd + +//----------------------------------------------------------------------// + +Static Function TrmReceiveALine( Socket, cInfo ) + Local lRet := .t. + Local nBytes + + do while .t. + if Hb_InetDataReady( Socket, 100 ) > 0 + BEGIN SEQUENCE + cInfo := Hb_InetRecvLine( Socket, @nBytes ) + RECOVER + lRet := .f. + END + + exit + endif + enddo + + Return lRet + +//----------------------------------------------------------------------// + +Static Function uiDebug( p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 ) + #ifdef __TRACE__ + + Local cDebug := '' + + if p1 <> nil + cDebug += uiXtos( p1 ) + endif + if p2 <> nil + cDebug += ' ' + uiXtos( p2 ) + endif + if p3 <> nil + cDebug += ' ' + uiXtos( p3 ) + endif + if p4 <> nil + cDebug += ' ' + uiXtos( p4 ) + endif + if p5 <> nil + cDebug += ' ' + uiXtos( p5 ) + endif + if p6 <> nil + cDebug += ' ' + uiXtos( p6 ) + endif + if p7 <> nil + cDebug += ' ' + uiXtos( p7 ) + endif + if p8 <> nil + cDebug += ' ' + uiXtos( p8 ) + endif + if p9 <> nil + cDebug += ' ' + uiXtos( p9 ) + endif + if p10 <> nil + cDebug += ' ' + uiXtos( p10 ) + endif + + if lTraceLog + DbgTraceLog( cDebug ) + else + OutputDebugString( cDebug ) + endif + + #endif + Return nil + +//----------------------------------------------------------------------// + +Static Function TrmXtoS( xVar ) + Local cType := valtype( xVar ) + + do case + case cType $ 'CM' + + case cType == 'N' + xVar := ltrim( str( xVar ) ) + + case cType == 'D' + xVar := dtoc( xVar ) + + case cType == 'L' + xVar := if( xVar, 'T','F' ) + + otherwise + xVar := '' + + endcase + + Return xVar + +//----------------------------------------------------------------------// + +Static Function Str2A( 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_ + +//----------------------------------------------------------------------// + +Static Function uiXtos( xVar ) + Local cVar := '' + Local cType := valtype( xVar ) + + do case + case cType == 'C' + cVar := xVar + + case cType == 'N' + cVar := str( xVar ) + + case cType == 'D' + cVar := dtoc( xVar ) + + case cType == 'L' + cVar := if( xVar, 'Yes','No ' ) + + otherwise + cVar := 'NIL' + + endcase + + Return cVar + +//----------------------------------------------------------------------// + +Static Function TrmInitFont() + #ifdef __JUSTGT__ + /* set OEM font encoding for non unicode modes */ + hb_gtInfo( HB_GTI_CODEPAGE, 255 ) + + /* Set EN CP-437 encoding */ + hb_setCodePage( "EN" ) + hb_setTermCP( "EN" ) + + #ifdef __WINCE__ + /* Set font size */ + hb_gtInfo( HB_GTI_FONTSIZE, 10 ) + hb_gtInfo( HB_GTI_FONTWIDTH, 5 ) + #endif + + #else + Local cFont := GetEnv( 'VouchFont' ) + Local nSize := val( GetEnv( 'VouchFontSize' ) ) + Local nScrWidth + + Wvt_SetCodepage( 255 ) + hb_setCodePage( "EN" ) + hb_setTermCP( "EN" ) + + if empty( cFont ) + cFont := 'Courier New' + endif + if empty( nSize ) + nScrWidth := Wvt_GetScreenWidth() + + if nScrWidth >= 1280 + nSize := 28 + elseif nScrWidth >= 1200 + nSize := 22 + elseif nScrWidth >= 1000 + nSize := 18 + elseif nScrWidth >= 800 + nSize := 16 + else + nSize := 15 + endif + endif + + Wvt_SetFont( cFont, nSize, 0, 0 ) + #endif + + SetMode( 25,80 ) + + return nil + +//----------------------------------------------------------------------// + +Static Function TrmDispLogin( cAddress, cPort ) + Local nMaxCol := maxcol()+1 + + DispOutAt( 0,0, padc( "Vouch Client "+VouchClientVersion, nMaxCol ), 'W+/r' ) + + DispOutAt( 10,0, padc( '...Please Wait...', nMaxCol ), 'W+/N' ) + DispOutAt( 12,0, padc( 'Securing Server Connection', nMaxCol ), 'W+/N' ) + DispOutAt( 13,0, padc( 'Address[ '+cAddress+' ] Port[ '+cPort+' ]', nMaxCol ), 'W+/N' ) + + DispOutAt( maxrow(), 0, padc( 'the software that GROWS with you', nMaxCol ), 'W+/r' ) + + Return nil + +//----------------------------------------------------------------------// + +Static Function SetClockInfo( cData ) + Local lInfo, a_ + + static aInfo := {} + + lInfo := aclone( aInfo ) + + if cData <> NIL + a_:= hb_aTokens( cData, ';' ) + if len( a_ ) >= 3 + aInfo := { val( a_[ 1 ] ), val( a_[ 2 ] ), a_[ 3 ] } + endif + endif + + Return lInfo + +//----------------------------------------------------------------------// + +Static Function SetClock( lOnOff ) + Local oClock + static lClock := .f. + + oClock := lClock + + if valtype( lOnOff ) == 'L' + lClock := lOnOff + endif + + Return oClock + +//----------------------------------------------------------------------// + +Static Function DispClock() + Local aInfo, nCrs, nRow, nCol + + if SetClock() + if !empty( aInfo := SetClockInfo() ) + nCrs := SetCursor( 0 ) + nRow := row() + nCol := col() + DispOutAt( aInfo[ 1 ], aInfo[ 2 ], time(), aInfo[ 3 ] ) + setpos( nRow,nCol ) + SetCursor( nCrs ) + endif + endif + + Return nil + +//----------------------------------------------------------------------// + +Static Function PlayMusic( cTheme ) + + do case + case cTheme == 'THUD' + tone(60,0.5) + + case cTheme == 'WAITON' + tone(800,1); tone(1600,1) + + case cTheme == 'WAITOFF' + tone(1600,1); tone(800,1) + + case cTheme == 'CHARGE' + Eval( {|| tone(523,2),tone(698,2),tone(880,2),tone(1046,4),tone(880,2),tone(1046,8) } ) + + case cTheme == 'NANNYBOO' + AEval( {{196,2},{196,2},{164,2},{220,2},{196,4},{164,4}}, {|a| tone(a[1],a[2]) } ) + + case cTheme == 'BADKEY' + tone(480,0.25); tone(240,0.25) + + endcase + + Return nil + +//----------------------------------------------------------------------// + +#define S_LBL 1 +#define S_TYP 2 +#define S_LEN 3 +#define S_DEC 4 +#define S_PIC 5 +#define S_ROW 6 +#define S_COL 7 +#define S_CLR 8 +#define S_DEF 9 + +Static Function GetForm( cForm ) + Local cReply := '' + Local i, scr , n,s + Local aFields := {} + Local a_:={} + Local frm_:={} + Local getlist := {} + + aFields := hb_aTokens( cForm, '^' ) + + for i := 1 to len( aFields ) + //a_:= Str2A( aFields[ i ], ',' ) + a_:= hb_aTokens( aFields[ i ], ',' ) + + a_[ S_LEN ] := val(a_[ S_LEN ]) + a_[ S_DEC ] := val(a_[ S_DEC ]) + a_[ S_ROW ] := val(a_[ S_ROW ]) + a_[ S_COL ] := val(a_[ S_COL ]) + + if empty( a_[ S_CLR ] ) + a_[ S_CLR ] := 'W+/BG,W+/B' + endif + if empty( a_[ S_PIC ] ) + a_[ S_PIC ] := '@ ' + endif + + do case + case a_[ S_TYP ] == 'C' + a_[ S_DEF ] := pad( a_[ S_DEF ], a_[ S_LEN ] ) + case a_[ S_TYP ] == 'N' + a_[ S_DEF ] := val( a_[ S_DEF ] ) + case a_[ S_TYP ] == 'D' + a_[ S_DEF ] := ctod( a_[ S_DEF ] ) + case a_[ S_TYP ] == 'L' + a_[ S_DEF ] := if( a_[ S_DEF ] == 'T', .t., .f. ) + endcase + + /* + aadd( frm_, { a_[ S_LBL ], a_[ S_TYP ], a_[ S_LEN ], a_[ S_DEC ], ; + a_[ S_PIC ], a_[ S_ROW ], a_[ S_COL ], a_[ S_CLR ], a_[ S_DEF ] } ) + */ + aadd( frm_, a_ ) + next + + scr := savescreen( 0,0,maxrow(),maxcol() ) + cls + for i := 1 to len( frm_ ) + DispOutAt( frm_[ i,S_ROW ], frm_[ i,S_COL ]-10, frm_[ i,S_LBL ], 'W+/B' ) + @ frm_[ i,S_ROW ], frm_[ i,S_COL ] GET frm_[ i,S_DEF ] ; + PICTURE frm_[ i,S_PIC ] COLOR frm_[ i,S_CLR ] + next + READ + + RestScreen( 0,0,maxrow(),maxcol(),scr ) + for i := 1 to len( frm_ ) + cReply += TrmXtos( frm_[ i,S_DEF ] ) + '^' + next + + Return cReply + +//----------------------------------------------------------------------// + +Static Function dbgTraceLog( cString, cFile ) + Local lRet := .f. + Local nBytes + + static nHandle + + if nHandle == NIL + if ( nHandle := fopen( cFile,FO_WRITE ) ) == F_ERROR + if ( nHandle := fcreate( cFile ) ) == F_ERROR + Return .f. + endif + endif + endif + + if nHandle <> F_ERROR + fseek( nHandle, 0, FS_END ) + nBytes := fwrite( nHandle, cString+chr(13)+chr(10), len( cString )+2 ) + + lRet := nBytes == len( cString )+2 + endif + + Return lRet + +//----------------------------------------------------------------------// + diff --git a/harbour/contrib/examples/terminal/trm_server.prg b/harbour/contrib/examples/terminal/trm_server.prg new file mode 100644 index 0000000000..3e8a5af92f --- /dev/null +++ b/harbour/contrib/examples/terminal/trm_server.prg @@ -0,0 +1,518 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * Copyright 2009 Pritpal Bedi + * http://www.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 +// +// Pritpal Bedi (pritpal@vouchcac.com) +// 13 Feb 2009 +// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// +//----------------------------------------------------------------------// + +#include 'inkey.ch' + +//----------------------------------------------------------------------// + +static g_nUserCount +static g_nTotalCount +static MutexDB +static MutexCount + +Static nMaxCol + +//----------------------------------------------------------------------// + +Function Main( cPort ) + LOCAL GetList + LOCAL socket + LOCAL Key, nKey + LOCAL cCommand + LOCAL hView, hAccept + + nMaxCol := maxcol()+1 + + IF Empty( cPort ) .OR. Val( cPort ) == 0 + cPort := "8085" + ENDIF + + GetList := {} + g_nUserCount := 0 + g_nTotalCount := 0 + + MutexDB := HB_MutexCreate() + MutexCount := HB_MutexCreate() + + SetColor( 'W+/N' ) + SetCursor( 0 ) + SetCursor( .f. ) + + BuildScreen() + + hb_InetInit() + + Socket := hb_InetServer( val( cPort ) ) + + DispOutAt( 3, 0, padc( "Waiting for connections on port " + cPort, nMaxCol ), 'W+/N' ) + + hView := hb_ThreadStart( @ViewUpdate() , Socket ) + hAccept := hb_ThreadStart( @AcceptIncoming(), Socket ) + + DO WHILE .T. + nKey := inkey() + + if nKey == K_CTRL_F12 + //hb_ThreadStop( hView ) + + // closing the socket will release the accept() request + //hb_InetClose( Socket ) + + //hb_ThreadStop( hAccept ) + EXIT + ENDIF + ENDDO + + DispOutAt( maxrow()-2, 0, padc( 'Please kill the window if not closed automatically',nMaxCol ), 'W+/N' ) + + hb_InetClose( Socket ) + hb_InetCleanup() + + RETURN nil + +//----------------------------------------------------------------------// +// +// Server Socket manager +// +PROCEDURE AcceptIncoming( Socket ) + LOCAL pClientSocket + + DO WHILE .T. + pClientSocket := hb_InetAccept( Socket ) + + IF pClientSocket != NIL + hb_mutexLock( MutexCount ) + g_nUserCount++ + g_nTotalCount++ + hb_mutexUnlock( MutexCount ) + + hb_ThreadStart( @ServeClient(), pClientSocket ) + hb_gcAll( .T. ) + ELSE + ? "Catched error ", hb_InetErrorCode( Socket ), hb_InetErrorDesc( Socket ) + //EXIT + ENDIF + ENDDO + + RETURN + +//----------------------------------------------------------------------// +// +// Service incoming connection +// +PROCEDURE ServeClient( Socket ) + LOCAL cRequest, cReply, cReq, cCmdLine, cLine, lExit, aFields + LOCAL oXmlDoc, oXmlForm, oXmlName, cFields, cData, oXmlData, oXmlNode + LOCAL aProcessInfo := array( 4 ) + LOCAL cPostData := "" + LOCAL nLength := 0 + LOCAL nContLen := 0 + Local nn := 0 + Local a_ := {} + + static nServerPort := 45000 + + do while .t. + lExit := .f. + BEGIN SEQUENCE + *** First of all, we must take the request of the user + cRequest := alltrim( hb_InetRecvLine( Socket, @nLength ) ) + + RECOVER + lExit := .t. + + END SEQUENCE + + if lExit + EXIT + endif + + if nLength < 0 + exit + + elseif nLength > 1 + a_:= hb_aTokens( cRequest, '|' ) + + cReq := upper( a_[ 1 ] ) + + do case + case cReq == 'AR' + nServerPort++ + SvrExecuteAPP( 'C:\DEV\C5\BIN\AR32.EXE', ltrim( str( nServerPort++ ) ), 'R:\ARTEST\' ) + inkey( 5 ) + cReply := 'CONNECT;'+'127.0.0.1'+';'+ltrim( str( nServerPort++ ) )+';' + + case cReq == 'VOUCH' + nServerPort++ + + cCmdLine := a_[ 3 ] +' '+ ltrim( str( nServerPort ) ) + SvrExecuteAPP( a_[ 2 ], cCmdLine, a_[ 4 ] ) + cReply := 'CONNECT;'+'127.0.0.1'+';'+ltrim( str( nServerPort ) )+';'+a_[ 2 ]+';' + + case cReq == 'ARCONNECTED' + // No further info required, close connection + EXIT + + case cReq == 'FORM' +#if 0 + oXmlDoc := TXmlDocument():new( '' ) + + oXmlNode := TXmlNode():New( ,'form', { 'name' => 'CLIENT' } ) + oXmlDoc:oRoot:addBelow( oXmlNode ) + + cFields := 'Code,C,8,0,@!,10,20,,^'+; + 'Name,C,20,0,@!,12,20,,^'+; + 'Salary,N,10,2,@Z 9999999.99,14,20,,^'+; + 'Job,C,20,0,,16,20,,^'+; + 'Birth,D,8,0,,18,20,,^' + + oXmlNode := TXmlNode():New( ,'fields', { 'fields' => cFields } ) + oXmlDoc:oRoot:addBelow( oXmlNode ) + + cData := 'C01|JOHNY WALKER|200|DRUMMER|01/01/1956|' + oXmlNode := TXmlNode():New( ,'data', { 'data' => cData } ) + oXmlDoc:oRoot:addBelow( oXmlNode ) + + cReply := 'FORM;'+oXmlDoc:ToString( 1 ) + + /* + cReply := 'FORM;'+; + ''+; + 'CLIENT'+; + ''+; + '
'+; + 'Code,C,8,0,@!,10,20,,^'+; + 'Name,C,20,0,@!,12,20,,^'+; + 'Salary,N,10,2,@Z 9999999.99,14,20,,^'+; + 'Job,C,20,0,,16,20,,^'+; + 'Birth,D,8,0,,18,20,,^'+; + '
'+; + ''+; + 'C01|JOHNY WALKER|200|DRUMMER|01/01/1956|'+; + '' + + */ +#endif + case cReq == 'SCREEN' + cReply := 'SCREEN;'+SaveScreen( 0,0,MAXROW(),MAXCOL() ) + + case cReq == 'INFO' + cReply := 'INFO;' + ltrim( str( hb_INetPort( Socket ) ) )+';'+hb_INetAddress( Socket )+';' + + otherwise + cReply := 'GENERIC;' + 'Request # '+ltrim( str( ++nn,10,0 ) ) + + endcase + + DispOutAt( 15, 0, " REQ: " + Substr( cRequest, 0 , 75 ) + Space( 80 ),'W+/BG' ) + DispOutAt( 16, 0, " RLY: " + Substr( cReply, 0 , 75 ) + Space( 80 ), 'W+/B' ) + + cReply += chr(13)+chr(10) + + hb_InetSend( Socket, @cReply ) + + else + //ThreadSleep( 50 ) + inkey( 0.05 ) + + endif + + enddo + + hb_InetClose( Socket ) + + RETURN + +//----------------------------------------------------------------------// + +Function SvrExecuteApp( cAppln, cParams, cDirectory ) + + Return ShellExecute( cAppln, cParams, cDirectory ) + +//----------------------------------------------------------------------// +// +// Managing visual updates +// +PROCEDURE ViewUpdate( Socket ) + LOCAL nProgress := 0 + + DO WHILE .T. + HB_MutexLock( MutexCount ) + + Looping( @nProgress, 5, 39 ) + + DispOutAt( 8, 5, "Main socket status : " + Str( hb_InetErrorCode( Socket ) ) +" :"+; + hb_InetErrorDesc( Socket ) ) + + DispOutAt( 9, 5, "Connected Users : " + Str( g_nUserCount ) ) + DispOutAt( 10, 5, "Total users : " + Str( g_nTotalCount ) ) + + HB_MutexUnlock( MutexCount ) + + inkey( 0.1 ) + ENDDO + + RETURN + +//----------------------------------------------------------------------// + +PROCEDURE Progress( nProgress, nDrow, nDcol ) + + DispOutAt( nDrow, nDcol, "[ ]" ) + + DO CASE + CASE nProgress = 0 + DispOutAt( nDrow, nDcol+1, "-" ) + CASE nProgress = 1 + DispOutAt( nDrow, nDcol+1, "\" ) + CASE nProgress = 2 + DispOutAt( nDrow, nDcol+1, "|" ) + CASE nProgress = 3 + DispOutAt( nDrow, nDcol+1, "/" ) + ENDCASE + + nProgress++ + + IF nProgress == 4 + nProgress := 0 + ENDIF + + RETURN + +//----------------------------------------------------------------------// + +PROCEDURE Looping( nProgress, nDrow, nDcol ) + + IF nProgress > 3 .OR. nProgress < 0 + nProgress := 0 + ENDIF + + DispOutAt( nDrow, nDcol, "[ ]" ) + + DO CASE + CASE nProgress = 0 + DispOutAt( nDrow, nDcol+1, "-" ) + CASE nProgress = 1 + DispOutAt( nDrow, nDcol+1, "\" ) + CASE nProgress = 2 + DispOutAt( nDrow, nDcol+1, "|" ) + CASE nProgress = 3 + DispOutAt( nDrow, nDcol+1, "/" ) + ENDCASE + + nProgress++ + + IF nProgress == 4 + nProgress := 0 + ENDIF + + RETURN + +//----------------------------------------------------------------------// + +Function BuildScreen() + + CLEAR SCREEN + + DispOutAt( 0,0, padc( "Welcome to V o u c h Server", maxcol()+1 ), 'w+/r' ) + + DispOutAt( maxrow(),0,padc( 'Press CTRL+F12 to QUIT',maxcol()+1 ), 'w+/r' ) + + Return nil + +//----------------------------------------------------------------------// + +Function uiDebug( p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 ) + Local cDebug := '' + + if p1 <> nil + cDebug += uiXtos( p1 ) + endif + if p2 <> nil + cDebug += ' ' + uiXtos( p2 ) + endif + if p3 <> nil + cDebug += ' ' + uiXtos( p3 ) + endif + if p4 <> nil + cDebug += ' ' + uiXtos( p4 ) + endif + if p5 <> nil + cDebug += ' ' + uiXtos( p5 ) + endif + if p6 <> nil + cDebug += ' ' + uiXtos( p6 ) + endif + if p7 <> nil + cDebug += ' ' + uiXtos( p7 ) + endif + if p8 <> nil + cDebug += ' ' + uiXtos( p8 ) + endif + if p9 <> nil + cDebug += ' ' + uiXtos( p9 ) + endif + if p10 <> nil + cDebug += ' ' + uiXtos( p10 ) + endif + + OutputDebugString( cDebug ) + + Return nil + +//----------------------------------------------------------------------// + +Function uiXtos( xVar ) + Local cVar := '' + Local cType := valtype( xVar ) + + do case + case cType == 'C' + cVar := xVar + + case cType == 'N' + cVar := str( xVar ) + + case cType == 'D' + cVar := dtoc( xVar ) + + case cType == 'L' + cVar := if( xVar, 'Yes','No ' ) + + otherwise + cVar := 'NIL' + + endcase + + Return cVar + +//----------------------------------------------------------------------// + +Function HB_GTSYS() + REQUEST HB_GT_WVG_DEFAULT + Return nil + +//----------------------------------------------------------------------// +#pragma BEGINDUMP + +#include "hbapi.h" +#include +#include + +// CreateProcess( cExe, cCmdLineArgs, nFlags, cEnvPair, cInitDirectory, @aProcessInfo ) +// +HB_FUNC( CREATEPROCESS ) +{ + LPCTSTR lpApplicationName; // name of executable module + LPTSTR lpCommandLine; // command line string + LPSECURITY_ATTRIBUTES lpProcessAttributes; // SD + LPSECURITY_ATTRIBUTES lpThreadAttributes; // SD + BOOL bInheritHandles; // handle inheritance option + DWORD dwCreationFlags; // creation flags + LPVOID lpEnvironment; // new environment block + LPCTSTR lpCurrentDirectory; // current directory name + LPSTARTUPINFO lpStartupInfo; // startup information + LPPROCESS_INFORMATION lpProcessInformation; // process information + + lpApplicationName = NULL;//hb_parc( 1 ); + lpCommandLine = hb_parc( 1 );//NULL;//ISNIL( 2 ) ? NULL : hb_parc( 2 ); + lpProcessAttributes = NULL; + lpThreadAttributes = NULL; + bInheritHandles = TRUE; + dwCreationFlags = NULL; //ISNUM( 3 ) ? hb_parnl( 3 ) : CREATE_NEW_CONSOLE; + lpEnvironment = NULL; //ISCHAR( 4 ) ? hb_parc( 4 ) : NULL; + lpCurrentDirectory = NULL; //ISCHAR( 5 ) ? hb_parc( 5 ) : NULL; + lpStartupInfo = NULL; + + hb_retl( + CreateProcess( + lpApplicationName, + lpCommandLine, + lpProcessAttributes, + lpThreadAttributes, + bInheritHandles, + dwCreationFlags, + lpEnvironment, + lpCurrentDirectory, + lpStartupInfo, + NULL ) ); +} + +HB_FUNC( SHELLEXECUTE ) +{ + ShellExecute( NULL, + "OPEN", + hb_parc( 1 ), + ISNIL( 2 ) ? NULL : hb_parc( 2 ), + ISNIL( 3 ) ? NULL : hb_parc( 3 ), + SW_SHOWNORMAL ); +} + +HB_FUNC( OUTPUTDEBUGSTRING ) +{ + OutputDebugString( hb_parc( 1 ) ); +} + +#pragma ENDDUMP +//----------------------------------------------------------------------// + diff --git a/harbour/contrib/gtwvg/wvgcore.c b/harbour/contrib/gtwvg/wvgcore.c index 70f8ff6bf1..829ff1751a 100644 --- a/harbour/contrib/gtwvg/wvgcore.c +++ b/harbour/contrib/gtwvg/wvgcore.c @@ -112,7 +112,7 @@ void hb_wvt_GetStringAttrib( USHORT top, USHORT left, USHORT bottom, USHORT righ BYTE bColor, bAttr; USHORT usChar; - if( !hb_gtGetScrChar( irow, icol, &bColor, &bAttr, &usChar ) ) + if( hb_gtGetScrChar( irow, icol, &bColor, &bAttr, &usChar ) == HB_FAILURE ) break; sBuffer[ j ] = ( BYTE ) usChar; @@ -135,7 +135,7 @@ void hb_wvt_PutStringAttrib( USHORT top, USHORT left, USHORT bottom, USHORT righ { for( icol = left; icol <= right; icol++ ) { - if( !hb_gtPutScrChar( irow, icol, sAttrib[ j ], 0, sBuffer[ j ] ) ) + if( hb_gtPutScrChar( irow, icol, sAttrib[ j ], 0, sBuffer[ j ] ) == HB_FAILURE ) break; j++; }