fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2009-02-13 00:29 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com)

Browse Source 
* 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 => <TCP/IP Port number - [D] 8085 ]
       Mode      => 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  <IP - 127.0.0.1 | vouch.dynalias.com>
                                    <Port where Terminal Server is Listening - 2011>
                                    <Harbour Application - c:\harbour\contrib\examples\terminal\trm_appn.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 <cServerInfo> 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.
       <cServerInfo> 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 + <cSerrverInfo==45000+>.
       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 <pritpal@vouchcac.com>
    a student of software analysis & design
This commit is contained in:
Pritpal Bedi
2009-02-13 08:39:30 +00:00
parent f6dc1367ad
commit eab18c603b
8 changed files with 2508 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

145
harbour/ChangeLog
View File

@@ -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 => <TCP/IP Port number - [D] 8085 ]
Mode => 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 <IP - 127.0.0.1 | vouch.dynalias.com>
<Port where Terminal Server is Listening - 2011>
<Harbour Application - c:\harbour\contrib\examples\terminal\trm_appn.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 <cServerInfo> 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.
<cServerInfo> 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 + <cSerrverInfo==45000+>.
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 <pritpal@vouchcac.com>
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.

132
harbour/contrib/examples/terminal/readme.txt Normal file
View File

@@ -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 => <TCP/IP Port number - [D] 8085 ]
Mode => 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 <IP - 127.0.0.1 | vouch.dynalias.com>
<Port where Terminal Server is Listening - 2011>
<Harbour Application - c:\harbour\contrib\examples\terminal\trm_appn.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 <cServerInfo> 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.
<cServerInfo> 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 + <cSerrverInfo==45000+>.
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 <pritpal@vouchcac.com>
a student of software analysis & design

126
harbour/contrib/examples/terminal/terminal.ch Normal file
View File

@@ -0,0 +1,126 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2009 Pritpal Bedi <pritpal@vouchcac.com>
* 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)
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//

523
harbour/contrib/examples/terminal/terminal.prg Normal file
View File

@@ -0,0 +1,523 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2009 Pritpal Bedi <pritpal@vouchcac.com>
* 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 <windows.h>
#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 := '<SCR>' +;
NTRIM( TOP ) +';'+ NTRIM( LFT ) +';'+ NTRIM( BTM ) +';'+ NTRIM( RGT ) +';'+;
NTRIM( len( cOdd0 ) ) +';'+ ;
NTRIM( len( cEvn0 ) ) +';'+ ;
'</E?>' +;
cOdd0 +;
cEvn0 +;
'</E?>' +;
'</SCR>' +;
'<CRS>' + cCurs + '</CRS>' +;
'<ID>' + NTRIM( nScreen )+ '</ID>'
elseif lSendCurs
cData := '<CRS>'+ cCurs +'</CRS>'
endif
case nMode == SND_CODEBLOCK
cData := '<BLK>'+ xData +'</BLK>'
case nMode == SND_CLOCKINFO
cData := '<CLK_INFO>'+ xData +'</CLK_INFO>'
case nMode == SND_CLOCKONOFF
cData := '<CLK_ONOFF>'+ if( xData, 'TRUE','FALSE' ) +'</CLK_ONOFF>'
case nMode == SND_MUSIC
cData := '<MUSIC>'+ upper( xData ) +'</MUSIC>'
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
//----------------------------------------------------------------------//

206
harbour/contrib/examples/terminal/trm_appn.prg Normal file
View File

@@ -0,0 +1,206 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2009 Pritpal Bedi <pritpal@vouchcac.com>
* 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
//----------------------------------------------------------------------//

856
harbour/contrib/examples/terminal/trm_client.prg Normal file
View File

@@ -0,0 +1,856 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2009 Pritpal Bedi <pritpal@vouchcac.com>
* 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 <windows.h>
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, '</E?>' )
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 := '</'+ c +'>'
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
//----------------------------------------------------------------------//

518
harbour/contrib/examples/terminal/trm_server.prg Normal file
View File

@@ -0,0 +1,518 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
*
* Copyright 2009 Pritpal Bedi <pritpal@vouchcac.com>
* 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( '<?xml version="1.0"?>' )
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;'+;
'<NAME>'+;
'CLIENT'+;
'</NAME>'+;
'<FORM>'+;
'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,,^'+;
'</FORM>'+;
'<DATA>'+;
'C01|JOHNY WALKER|200|DRUMMER|01/01/1956|'+;
'</DATA>'
*/
#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 <windows.h>
#include <shellapi.h>
// 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
//----------------------------------------------------------------------//

4
harbour/contrib/gtwvg/wvgcore.c
View File

@@ -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++;
}