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

2009-08-01 17:48 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/xhb/hblog.prg
    + Added HB_LogConsole:Out() method from xhb.
    + Added HB_LogDbf() class from xhb.
    ! Applied fix recently committed to xhb.
      Harbour version uses different (clean) method.

  * contrib/xhb/hblog.prg
  * contrib/xhb/hblognet.prg
  * contrib/xhb/stream.prg
    % Updated code to not require hbcompat.ch.
      Please test.

  * contrib/xhb/trpccli.prg
  * contrib/xhb/hblognet.prg
  * contrib/xhb/hblog.prg
  * contrib/xhb/trpc.prg
  * contrib/xhb/cstruct.prg
    % Updated code to not require xhb.ch.
      Please test.
    ; No more xhb lib code requires these compatibility headers.
This commit is contained in:
Viktor Szakats
2009-08-01 16:07:01 +00:00
parent f533da4d92
commit 89c3175137
7 changed files with 351 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
harbour/ChangeLog
View File

@@ -17,6 +17,28 @@
past entries belonging to author(s): Viktor Szakats.
*/
2009-08-01 17:48 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/xhb/hblog.prg
+ Added HB_LogConsole:Out() method from xhb.
+ Added HB_LogDbf() class from xhb.
! Applied fix recently committed to xhb.
Harbour version uses different (clean) method.
* contrib/xhb/hblog.prg
* contrib/xhb/hblognet.prg
* contrib/xhb/stream.prg
% Updated code to not require hbcompat.ch.
Please test.
* contrib/xhb/trpccli.prg
* contrib/xhb/hblognet.prg
* contrib/xhb/hblog.prg
* contrib/xhb/trpc.prg
* contrib/xhb/cstruct.prg
% Updated code to not require xhb.ch.
Please test.
; No more xhb lib code requires these compatibility headers.
2009-08-01 16:56 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* INSTALL
* bin/postinst.sh

5
harbour/contrib/xhb/cstruct.prg
View File

@@ -54,7 +54,6 @@
#include "common.ch"
#include "hboo.ch"
#include "error.ch"
#include "xhb.ch"
#define CLASS_PROPERTIES 6
@@ -231,7 +230,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli
IF ( nAt := At( "*", cElem ) ) > 1
IF nIndex < Len( aDefinitions )
aIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt + 1 ), .T. )
hb_aIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt + 1 ), .T. )
ELSE
aAdd( aDefinitions, SubStr( cElem, nAt + 1 ) )
ENDIF
@@ -239,7 +238,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli
aDefinitions[nIndex] := StrTran( Left( cElem, nAt ), " ", "" )
ELSEIF ( nAt := At( "-", cElem ) ) > 1
IF nIndex < Len( aDefinitions )
aIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt ), .T. )
hb_aIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt ), .T. )
ELSE
aAdd( aDefinitions, SubStr( cElem, nAt ) )
ENDIF

173
harbour/contrib/xhb/hblog.prg
View File

@@ -49,7 +49,6 @@
*
*/
#include "hbcompat.ch"
#include "hbclass.ch"
#include "common.ch"
#include "hblog.ch"
@@ -243,7 +242,7 @@ METHOD New() CLASS HB_Logger
LOCAL nCount
FOR nCount := 1 TO PCount()
::AddChannel( PValue( nCount ) )
::AddChannel( hb_PValue( nCount ) )
NEXT
RETURN Self
@@ -416,6 +415,7 @@ CLASS HB_LogConsole FROM HB_LogChannel
METHOD New( nLevel )
METHOD Open( cName )
METHOD Close( cName )
METHOD Out()
METHOD LogOnVt( ldo ) INLINE ::lRealConsole := ldo
@@ -435,36 +435,41 @@ METHOD Open( cName ) CLASS HB_LogConsole
RETURN .F.
ENDIF
IF ::lRealConsole
OutStd( HB_LogDateStamp(), Time(), "--", cName, "start --", HB_OSnewLine() )
ELSE
QOut( HB_LogDateStamp(), Time(), "--", cName, "start --" )
ENDIF
::Out( HB_LogDateStamp(), Time(), "--", cName, "start --" )
::lOpened := .T.
RETURN .T.
METHOD Close( cName ) CLASS HB_LogConsole
IF .not. ::lOpened
IF ! ::lOpened
RETURN .F.
ENDIF
IF ::lRealConsole
OutStd( HB_LogDateStamp(), Time(), "--", cName, "end --", HB_OSnewLine() )
ELSE
QOut( HB_LogDateStamp(), Time(), "--", cName, "end --" )
ENDIF
::Out( HB_LogDateStamp(), Time(), "--", cName, "end --" )
::lOpened := .F.
RETURN .T.
METHOD PROCEDURE Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogConsole
::Out( ::Format( nStyle, cMessage, cName, nPriority ) )
RETURN
METHOD PROCEDURE Out( ... ) CLASS HB_LogConsole
LOCAL cMsg := "", xPar
LOCAL nLen := Len( hb_aParams() )
FOR EACH xPar IN hb_aParams()
cMsg += hb_CStr( xPar )
IF HB_EnumIndex() < nLen
cMsg += " "
ENDIF
NEXT
IF ::lRealConsole
OutStd( ::Format( nStyle, cMessage, cName, nPriority ), HB_OSnewLine() )
OutStd( cMsg, HB_OSnewLine() )
ELSE
QOut( ::Format( nStyle, cMessage, cName, nPriority ) )
QOut( cMsg )
ENDIF
RETURN
@@ -516,7 +521,7 @@ METHOD Open( cProgName ) CLASS HB_LogFile
Fseek( ::nFileHandle, 0 ,FS_END )
END
ELSE
::nFileHandle := FCreate( ::cFileName )
::nFileHandle := hb_FCreate( ::cFileName, FC_NORMAL, FO_READWRITE )
ENDIF
IF ::nFileHandle < 0
@@ -532,7 +537,7 @@ RETURN .T.
METHOD Close( cProgName ) CLASS HB_LogFile
IF .not. ::lOpened
IF ! ::lOpened
RETURN .F.
ENDIF
@@ -568,7 +573,7 @@ METHOD Send( nStyle, cMessage, cProgName, nPrio ) CLASS HB_LogFile
ENDIF
IF FRename( ::cFileName, ::cFileName + ".000" ) == 0
::nFileHandle := FCreate( ::cFileName )
::nFileHandle := hb_FCreate( ::cFileName, FC_NORMAL, FO_READWRITE )
Fwrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "LogFile: Reopening file due to size limit breaking", HB_OsNewLine() ) )
ENDIF
ENDIF
@@ -577,6 +582,134 @@ METHOD Send( nStyle, cMessage, cProgName, nPrio ) CLASS HB_LogFile
RETURN Ferror() == 0
/**********************************************
* Console channel - to dbf
***********************************************/
CLASS HB_LogDbf FROM HB_LogChannel
DATA cDBFName INIT "messages.dbf"
DATA cIndexName INIT "messages.cdx"
DATA cDriver INIT "DBFCDX"
DATA aStruct INIT { ;
{ "PRIORITY", "N", 2, 0 } ,;
{ "PROGNAME", "C", 30, 0 } ,;
{ "MESSAGE" , "C", 250, 0 } ,;
{ "DATE" , "D", 8, 0 } ,;
{ "TIME" , "C", 8, 0 } ;
}
METHOD New( nLevel, cFile, cIndex, aStruct, cDriver )
METHOD Open( cName )
METHOD Close( cName )
PROTECTED:
METHOD Send( nStyle, cMessage, nPriority )
ENDCLASS
METHOD New( nLevel, cDBFName, cIndexName, aStruct, cDriver ) CLASS HB_LogDbf
LOCAL cPath, cName, cExt, cDrive
::Super:New( nLevel )
IF ISCHARACTER( cDBFName )
HB_FnameSplit( cDBFName, @cPath, @cName, @cExt, @cDrive )
IF Empty( cExt )
cExt := "dbf"
ENDIF
::cDBFName := IIF( !Empty( cDrive ), cDrive + ":\", "" ) + ;
IIF( !Empty( cPath ) , cPath + "\", "" ) + ;
cName + cExt
//__OutDebug( "::cDBFName", ::cDBFName )
ENDIF
IF ISCHARACTER( cIndexName )
HB_FnameSplit( cIndexName, @cPath, @cName, @cExt, @cDrive )
IF Empty( cExt )
cExt := "cdx"
ENDIF
::cIndexName := IIF( !Empty( cDrive ), cDrive + ":\", "" ) + ;
IIF( !Empty( cPath ) , cPath + "\", "" ) + ;
cName + cExt
//__OutDebug( "::cCDXName", ::cCDXName )
ENDIF
IF aStruct != NIL
::aStruct := aStruct
ENDIF
IF cDriver != NIL
::cDriver := cDriver
ENDIF
RETURN Self
METHOD Open( cProgName ) CLASS HB_LogDbf
IF ::lOpened
RETURN .F.
ENDIF
IF ! hb_FileExists( ::cDBFName )
dbCreate( ::cDBFName, ::aStruct )
dbUseArea( .T., ::cDriver, ::cDBFName, "LogDbf", .T. )
INDEX ON DToS( FIELD->date ) + FIELD->time + Str( FIELD->priority, 2 ) + FIELD->message TAG "datetime" TO (::cIndexName)
INDEX ON Str( FIELD->priority, 2 ) + DToS( FIELD->date ) + FIELD->time + FIELD->message TAG "priority" TO (::cIndexName)
LogDbf->( dbCloseArea() )
ELSEIF ! hb_FileExists( ::cIndexName )
dbUseArea( .T., ::cDriver, ::cDBFName, "LogDbf", .T. )
INDEX ON DToS( FIELD->date ) + FIELD->time + Str( FIELD->priority, 2 ) + FIELD->message TAG "datetime" TO (::cIndexName)
INDEX ON Str( FIELD->priority, 2 ) + DToS( FIELD->date ) + FIELD->time + FIELD->message TAG "priority" TO (::cIndexName)
LogDbf->( dbCloseArea() )
ENDIF
//__OutDebug( "::cDriver, ::cDBFName", ::cDriver, ::cDBFName )
dbUseArea( .T., ::cDriver, ::cDBFName, "LogDbf", .T. )
SET INDEX TO (::cIndexName)
LogDbf->( dbAppend() )
LogDbf->priority := HB_LOG_INFO
LogDbf->date := Date()
LogDbf->time := Time()
LogDbf->progname := cProgName
LogDbf->message := "-- start --"
LogDbf->( dbCommit() )
::lOpened := .T.
RETURN .T.
METHOD Close( cProgName ) CLASS HB_LogDbf
IF ! ::lOpened
RETURN .F.
ENDIF
LogDbf->( dbAppend() )
LogDbf->priority := HB_LOG_INFO
LogDbf->date := Date()
LogDbf->time := Time()
LogDbf->progname := cProgName
LogDbf->message := "-- end --"
LogDbf->( dbCommit() )
::lOpened := .F.
RETURN .T.
METHOD Send( nStyle, cMessage, cProgName, nPrio ) CLASS HB_LogDbf
LogDbf->( dbAppend() )
LogDbf->priority := nPrio
LogDbf->date := Date()
LogDbf->time := Time()
LogDbf->progname := cProgName
LogDbf->message := cMessage
LogDbf->( dbCommit() )
(nStyle)
RETURN .T.
/**********************************************
* Syslog channel - a wrapper for the low level
* C interface to syslog/ event log system
@@ -617,7 +750,7 @@ RETURN .F.
METHOD Close( cName ) CLASS HB_LogSyslog
IF .not. ::lOpened
IF ! ::lOpened
RETURN .F.
ENDIF
@@ -659,7 +792,7 @@ RETURN Self
METHOD PROCEDURE Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogDebug
IF .not. Empty( ::nMaxLevel )
IF ! Empty( ::nMaxLevel )
IF nPriority < ::nMaxLevel
RETURN
ENDIF

61
harbour/contrib/xhb/hblognet.prg
View File

@@ -49,7 +49,6 @@
*
*/
#include "hbcompat.ch"
#include "hbclass.ch"
#include "common.ch"
@@ -112,7 +111,7 @@ RETURN SELF
*/
METHOD Open( cName ) CLASS HB_LogEmail
HB_SYMBOL_UNUSED( cName )
InetInit()
hb_inetInit()
RETURN .T.
/**
@@ -120,7 +119,7 @@ RETURN .T.
*/
METHOD Close( cName ) CLASS HB_LogEmail
HB_SYMBOL_UNUSED( cName )
InetCleanup()
hb_inetCleanup()
RETURN .T.
@@ -129,45 +128,45 @@ RETURN .T.
*/
METHOD Send( nStyle, cMessage, cName, nPrio ) CLASS HB_LogEmail
LOCAL skCon := InetCreate()
LOCAL skCon := hb_inetCreate()
InetSetTimeout( skCon, 10000 )
hb_inetTimeout( skCon, 10000 )
InetConnect( ::cServer, ::nPort, skCon )
hb_inetConnect( ::cServer, ::nPort, skCon )
IF InetErrorCode( skCon ) != 0 .or. .not. ::GetOk( skCon )
IF hb_inetErrorCode( skCon ) != 0 .or. .not. ::GetOk( skCon )
RETURN .F.
ENDIF
InetSendAll( skCon, "HELO " + ::cHelo + InetCRLF() )
hb_inetSendAll( skCon, "HELO " + ::cHelo + hb_inetCRLF() )
IF .not. ::GetOk( skCon )
RETURN .F.
ENDIF
InetSendAll( skCon, "MAIL FROM: <" + ::cAddress +">" + InetCRLF() )
hb_inetSendAll( skCon, "MAIL FROM: <" + ::cAddress +">" + hb_inetCRLF() )
IF .not. ::GetOk( skCon )
RETURN .F.
ENDIF
InetSendAll( skCon, "RCPT TO: <" + ::cSendTo +">" + InetCRLF() )
hb_inetSendAll( skCon, "RCPT TO: <" + ::cSendTo +">" + hb_inetCRLF() )
IF .not. ::GetOk( skCon )
RETURN .F.
ENDIF
InetSendAll( skCon, "DATA" + InetCRLF() )
hb_inetSendAll( skCon, "DATA" + hb_inetCRLF() )
IF .not. ::GetOk( skCon )
RETURN .F.
ENDIF
cMessage := ::Prepare( nStyle, cMessage, cName, nPrio )
InetSendAll( skCon, cMessage + InetCRLF() + "." + InetCRLF() )
hb_inetSendAll( skCon, cMessage + hb_inetCRLF() + "." + hb_inetCRLF() )
IF .not. ::GetOk( skCon )
RETURN .F.
ENDIF
InetSendAll( skCon, "QUIT" + InetCRLF() )
hb_inetSendAll( skCon, "QUIT" + hb_inetCRLF() )
RETURN ::GetOk( skCon ) // if quit fails, the mail does not go!
@@ -178,26 +177,26 @@ RETURN ::GetOk( skCon ) // if quit fails, the mail does not go!
METHOD GetOk( skCon ) CLASS HB_LogEmail
LOCAL nLen, cReply
cReply := InetRecvLine( skCon, @nLen, 128 )
IF InetErrorCode( skcon ) != 0 .or. Substr( cReply, 1, 1 ) == '5'
cReply := hb_inetRecvLine( skCon, @nLen, 128 )
IF hb_inetErrorCode( skcon ) != 0 .or. Substr( cReply, 1, 1 ) == '5'
RETURN .F.
ENDIF
RETURN .T.
METHOD Prepare( nStyle, cMessage, cName, nPrio ) CLASS HB_LogEmail
LOCAL cPre
cPre := "FROM: " + ::cAddress + InetCRLF() + ;
"TO: " + ::cSendTo + InetCRLF() +;
"Subject:" + ::cSubject + InetCRLF() + InetCRLF()
cPre := "FROM: " + ::cAddress + hb_inetCRLF() + ;
"TO: " + ::cSendTo + hb_inetCRLF() +;
"Subject:" + ::cSubject + hb_inetCRLF() + hb_inetCRLF()
IF .not. Empty( ::cPrefix )
cPre += ::cPrefix + InetCRLF() + InetCRLF()
cPre += ::cPrefix + hb_inetCRLF() + hb_inetCRLF()
ENDIF
cPre += ::Format( nStyle, cMessage, cName, nPrio )
IF .not. Empty( ::cPostfix )
cPre += InetCRLF() +InetCRLF() + ::cPostfix + InetCRLF()
cPre += hb_inetCRLF() +hb_inetCRLF() + ::cPostfix + hb_inetCRLF()
ENDIF
RETURN cPre
@@ -249,9 +248,9 @@ METHOD Open( cName ) CLASS HB_LogInetPort
HB_SYMBOL_UNUSED( cName )
InetInit()
hb_inetInit()
::skIn := InetServer( ::nPort )
::skIn := hb_inetServer( ::nPort )
IF ::skIn == NIL
RETURN .F.
@@ -263,7 +262,7 @@ METHOD Open( cName ) CLASS HB_LogInetPort
#else
// If we have not threads, we have to sync accept incoming connection
// when we log a message
InetSetTimeout( ::skIn, 50 )
hb_inetTimeout( ::skIn, 50 )
#endif
RETURN .T.
@@ -284,17 +283,17 @@ METHOD Close( cName ) CLASS HB_LogInetPort
hb_ThreadJoin( ::nThread )
#endif
InetClose( ::skIn )
hb_inetClose( ::skIn )
// we now are sure that incoming thread index is not used.
DO WHILE Len( ::aListeners ) > 0
sk := ATail( ::aListeners )
ASize( ::aListeners, Len( ::aListeners ) - 1 )
InetClose( sk )
hb_inetClose( sk )
ENDDO
InetCleanup()
hb_inetCleanup()
RETURN .T.
@@ -306,7 +305,7 @@ METHOD Send( nStyle, cMessage, cName, nPrio ) CLASS HB_LogInetPort
HB_MutexLock( ::mtxBusy )
#else
// IF we have not a thread, we must see if there is a new connection
sk := InetAccept( ::skIn ) //timeout should be short
sk := hb_inetAccept( ::skIn ) //timeout should be short
IF sk != NIL
Aadd( ::aListeners, sk )
@@ -319,9 +318,9 @@ METHOD Send( nStyle, cMessage, cName, nPrio ) CLASS HB_LogInetPort
nCount := 1
DO WHILE nCount <= Len( ::aListeners )
sk := ::aListeners[ nCount ]
InetSendAll( sk, cMessage + InetCRLF() )
hb_inetSendAll( sk, cMessage + hb_inetCRLF() )
// if there is an error, we remove the listener
IF InetErrorCode( sk ) != 0
IF hb_inetErrorCode( sk ) != 0
ADel( ::aListeners, nCount )
ASize( ::aListeners , Len( ::aListeners ) - 1)
ELSE
@@ -340,9 +339,9 @@ RETURN .T.
METHOD AcceptCon() CLASS HB_LogInetPort
LOCAL sk
InetSetTimeout( ::skIn, 250 )
hb_inetTimeout( ::skIn, 250 )
DO WHILE .not. ::bTerminate
sk := InetAccept( ::skIn )
sk := hb_inetAccept( ::skIn )
// A gentle termination request, or an error
IF sk != NIL
HB_MutexLock( ::mtxBusy )

2
harbour/contrib/xhb/stream.prg
View File

@@ -55,7 +55,7 @@
#include "common.ch"
#include "fileio.ch"
#include "hbcompat.ch"
#xtranslate THROW(<oErr>) => (Eval(ErrorBlock(), <oErr>), Break(<oErr>))
#define BUFFER_SIZE 16384

112
harbour/contrib/xhb/trpc.prg
View File

@@ -197,8 +197,6 @@
#include "hbclass.ch"
#include "xhb.ch"
#include "hbrpc.ch"
@@ -460,7 +458,7 @@ METHOD Start() CLASS tRPCServeCon
HB_MutexLock( ::mtxBusy )
IF ::thSelf == NIL
::thSelf := StartThread( Self, "RUN" )
::thSelf := xhb_StartThread( Self, "RUN" )
lRet := .T.
ENDIF
HB_MutexUnlock( ::mtxBusy )
@@ -472,8 +470,8 @@ METHOD Stop() CLASS tRPCServeCon
LOCAL lRet := .F.
HB_MutexLock( ::mtxBusy )
IF IsValidThread( ::thSelf )
KillThread( ::thSelf )
IF hb_threadId( ::thSelf ) != 0
hb_threadQuitRequest( ::thSelf )
lRet := .T.
HB_MutexUnlock( ::mtxBusy )
JoinThread( ::thSelf )
@@ -491,11 +489,11 @@ METHOD Run() CLASS tRPCServeCon
LOCAL aData
LOCAL nSafeStatus
DO WHILE InetErrorCode( ::skRemote ) == 0 .and. .not. lBreak
DO WHILE hb_inetErrorCode( ::skRemote ) == 0 .and. .not. lBreak
/* Get the request code */
InetRecvAll( ::skRemote, @cCode, 6 )
IF InetErrorCode( ::skRemote ) != 0
hb_inetRecvAll( ::skRemote, @cCode, 6 )
IF hb_inetErrorCode( ::skRemote ) != 0
EXIT
ENDIF
@@ -507,7 +505,7 @@ METHOD Run() CLASS tRPCServeCon
/* Check for TCP server scan */
CASE cCode == "XHBR00"
InetSendAll( ::skRemote, ;
hb_inetSendAll( ::skRemote, ;
"XHBR10"+ HB_Serialize( ::oServer:cServerName ) )
/* Read autorization request */
@@ -652,7 +650,7 @@ METHOD Run() CLASS tRPCServeCon
HB_MutexLock( ::mtxBusy )
::lCanceled = .T.
HB_MutexUnlock( ::mtxBusy )
InetSendAll( ::skRemote, "XHBR34")
hb_inetSendAll( ::skRemote, "XHBR34")
ENDIF
OTHERWISE
@@ -662,10 +660,10 @@ METHOD Run() CLASS tRPCServeCon
/* Analisys of the nSafeStatus code */
DO CASE
CASE nSafeStatus == RPCS_STATUS_BUSY
InetSendAll( ::skRemote, "XHBR4011" )
hb_inetSendAll( ::skRemote, "XHBR4011" )
CASE nSafeStatus == RPCS_STATUS_ERROR
InetSendAll( ::skRemote, "XHBR4020" )
hb_inetSendAll( ::skRemote, "XHBR4020" )
/* Update real status only if not in error case */
OTHERWISE
@@ -692,7 +690,7 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon
LOCAL cUserID, cPassword
LOCAL cReadIn
IF InetRecvAll( ::skRemote, @cLength, 8 ) != 8
IF hb_inetRecvAll( ::skRemote, @cLength, 8 ) != 8
RETURN .F.
ENDIF
@@ -703,7 +701,7 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon
ENDIF
cReadIn := Space( nLen )
IF InetRecvAll( ::skRemote, @cReadin, nLen ) != nLen
IF hb_inetRecvAll( ::skRemote, @cReadin, nLen ) != nLen
RETURN .F.
ENDIF
@@ -718,12 +716,12 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon
IF .not. lEncrypt
::nAuthLevel := ::oServer:Authorize( cUserid, cPassword )
IF ::nAuthLevel == 0
InetSendAll( ::skRemote, "XHBR91NO" )
hb_inetSendAll( ::skRemote, "XHBR91NO" )
RETURN .F.
ENDIF
InetSendAll( ::skRemote, "XHBR91OK" )
IF InetErrorCode( ::skRemote ) != 0
hb_inetSendAll( ::skRemote, "XHBR91OK" )
IF hb_inetErrorCode( ::skRemote ) != 0
RETURN .F.
ENDIF
::cUserId := cUserId
@@ -753,9 +751,9 @@ METHOD LaunchChallenge( cUserid, cPassword ) CLASS tRPCServeCon
::nChallengeCRC = HB_Checksum( cChallenge )
cChallenge := HB_Crypt( cChallenge, ::cCryptKey )
InetSendAll( ::skRemote, "XHBR94" + HB_CreateLen8( Len( cChallenge ) ) + cChallenge )
hb_inetSendAll( ::skRemote, "XHBR94" + HB_CreateLen8( Len( cChallenge ) ) + cChallenge )
IF InetErrorCode( ::skRemote ) != 0
IF hb_inetErrorCode( ::skRemote ) != 0
RETURN .F.
ENDIF
@@ -765,7 +763,7 @@ RETURN .T.
METHOD RecvChallenge() CLASS tRPCServeCon
LOCAL cNumber := Space( 8 )
IF InetRecvAll( ::skRemote, @cNumber ) != 8
IF hb_inetRecvAll( ::skRemote, @cNumber ) != 8
RETURN .F.
ENDIF
@@ -773,8 +771,8 @@ METHOD RecvChallenge() CLASS tRPCServeCon
RETURN .F.
ENDIF
InetSendAll( ::skRemote, "XHBR91OK" )
IF InetErrorCode( ::skRemote ) != 0
hb_inetSendAll( ::skRemote, "XHBR91OK" )
IF hb_inetErrorCode( ::skRemote ) != 0
RETURN .F.
ENDIF
@@ -797,7 +795,7 @@ METHOD RecvFunction( bComp, bMode ) CLASS tRPCServeCon
LOCAL cData
/* Original lenght of data */
IF InetRecvAll( ::skRemote, @cLength, 8 ) != 8
IF hb_inetRecvAll( ::skRemote, @cLength, 8 ) != 8
RETURN NIL
ENDIF
@@ -808,7 +806,7 @@ METHOD RecvFunction( bComp, bMode ) CLASS tRPCServeCon
/* compressed lenght */
IF bComp
IF InetRecvAll( ::skRemote, @cLength, 8 ) != 8
IF hb_inetRecvAll( ::skRemote, @cLength, 8 ) != 8
RETURN NIL
ENDIF
@@ -819,14 +817,14 @@ METHOD RecvFunction( bComp, bMode ) CLASS tRPCServeCon
/* Mode */
IF bMode
IF InetRecvAll( ::skRemote, @cMode ) != 1
IF hb_inetRecvAll( ::skRemote, @cMode ) != 1
RETURN NIL
ENDIF
ENDIF
/* Get data */
cData := Space( nComp )
IF InetRecvAll( ::skRemote, @cData ) != nComp
IF hb_inetRecvAll( ::skRemote, @cData ) != nComp
RETURN NIL
ENDIF
@@ -917,7 +915,7 @@ METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon
IF Empty(oFunc)
// signal error
::oServer:OnFunctionError( Self, cFuncName, 00 )
InetSendAll( ::skRemote, "XHBR4000" )
hb_inetSendAll( ::skRemote, "XHBR4000" )
RETURN .T.
ENDIF
@@ -925,7 +923,7 @@ METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon
IF oFunc:nAuthLevel > ::nAuthLevel
// signal error
::oServer:OnFunctionError( Self, cFuncName, 01 )
InetSendAll( ::skRemote, "XHBR4001" )
hb_inetSendAll( ::skRemote, "XHBR4001" )
RETURN .T.
ENDIF
@@ -933,7 +931,7 @@ METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon
IF aParams == NIL .or. .not. oFunc:CheckTypes( aParams )
// signal error
::oServer:OnFunctionError( Self, cFuncName,02 )
InetSendAll( ::skRemote, "XHBR4002" )
hb_inetSendAll( ::skRemote, "XHBR4002" )
RETURN .T.
ENDIF
@@ -944,7 +942,7 @@ METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon
::lCanceled := .F.
// Set the running status
::nStatus := RPCS_STATUS_RUNNING
::thFunction := StartThread( Self, "FunctionRunner", ;
::thFunction := xhb_StartThread( Self, "FunctionRunner", ;
cFuncName, oFunc, nMode, aParams, aDesc )
HB_MutexUnlock( ::mtxBusy )
@@ -1097,7 +1095,7 @@ METHOD SendResult( oRet, cFuncName )
IF oRet == NIL
::oServer:OnFunctionError( Self, cFuncName, 10 )
InetSendAll( ::skRemote, "XHBR4010" )
hb_inetSendAll( ::skRemote, "XHBR4010" )
ELSE
cData := HB_Serialize( oRet )
cOrigLen := HB_CreateLen8( Len( cData ) )
@@ -1107,13 +1105,13 @@ METHOD SendResult( oRet, cFuncName )
IF Len( cData ) > 512
cData := HB_Compress( cData )
cCompLen := HB_CreateLen8( Len( cData ) )
InetSendAll( ::skRemote, "XHBR31" + cOrigLen + cCompLen + ::Encrypt( cData ) )
hb_inetSendAll( ::skRemote, "XHBR31" + cOrigLen + cCompLen + ::Encrypt( cData ) )
ELSE
InetSendAll( ::skRemote, "XHBR30" + cOrigLen + ::Encrypt( cData ) )
hb_inetSendAll( ::skRemote, "XHBR30" + cOrigLen + ::Encrypt( cData ) )
ENDIF
ENDIF
IF InetErrorCode( ::skRemote ) != 0
IF hb_inetErrorCode( ::skRemote ) != 0
RETURN .F.
ENDIF
@@ -1134,7 +1132,7 @@ METHOD SendProgress( nProgress, oData ) CLASS tRPCServeCon
::oServer:OnFunctionProgress( Self, nProgress, oData )
IF Empty( oData )
InetSendAll( ::skRemote, "XHBR33" + HB_Serialize( nProgress ) )
hb_inetSendAll( ::skRemote, "XHBR33" + HB_Serialize( nProgress ) )
ELSE
cData := HB_Serialize( oData )
cOrigLen := HB_CreateLen8( Len( cData ) )
@@ -1142,15 +1140,15 @@ METHOD SendProgress( nProgress, oData ) CLASS tRPCServeCon
IF Len( cData ) > 512
cData := HB_Compress( cData )
cCompLen := HB_CreateLen8( Len( cData ) )
InetSendAll(::skRemote, "XHBR35" + HB_Serialize( nProgress ) +;
hb_inetSendAll(::skRemote, "XHBR35" + HB_Serialize( nProgress ) +;
cOrigLen + cCompLen + ::Encrypt( cData ) )
ELSE
InetSendAll( ::skRemote, "XHBR34" + HB_Serialize( nProgress ) +;
hb_inetSendAll( ::skRemote, "XHBR34" + HB_Serialize( nProgress ) +;
cOrigLen + ::Encrypt( cData ) )
ENDIF
ENDIF
IF InetErrorCode( ::skRemote ) != 0
IF hb_inetErrorCode( ::skRemote ) != 0
lRet := .F.
ENDIF
@@ -1177,7 +1175,7 @@ RETURN cDataIn
CLASS tRPCService
DATA cServerName INIT "RPCGenericServer"
DATA aFunctions
CLASSDATA lInit INIT InetInit()
CLASSDATA lInit INIT hb_inetInit()
DATA nUdpPort INIT 1139
DATA nTcpPort INIT 1140
@@ -1335,17 +1333,17 @@ RETURN cRet
METHOD Start( lStartUdp ) CLASS tRPCService
IF Empty( ::cBindAddress )
::skServer := InetServer( ::nTcpPort )
::skUdp := InetDGramBind( ::nUdpPort )
::skServer := hb_inetServer( ::nTcpPort )
::skUdp := hb_inetDGramBind( ::nUdpPort )
ELSE
::skServer := InetServer( ::nTcpPort, ::cBindAddress )
::skUdp := InetDGramBind( ::nUdpPort, ::cBindAddress )
::skServer := hb_inetServer( ::nTcpPort, ::cBindAddress )
::skUdp := hb_inetDGramBind( ::nUdpPort, ::cBindAddress )
ENDIF
::thAccept := StartThread( Self, "Accept" )
::thAccept := xhb_StartThread( Self, "Accept" )
IF lStartUdp != NIL .and. lStartUdp
::thUdp := StartThread( Self, "UdpListen" )
::thUdp := xhb_StartThread( Self, "UdpListen" )
ELSE
::thUdp := NIL
ENDIF
@@ -1357,24 +1355,24 @@ METHOD Stop() CLASS tRPCService
LOCAL oElem
HB_MutexLock( ::mtxBusy )
IF .not. IsValidThread( ::thAccept )
IF hb_threadId( ::thAccept ) == 0
HB_MutexUnlock( ::mtxBusy )
RETURN .F.
ENDIF
InetClose( ::skServer )
hb_inetClose( ::skServer )
// closing the socket will make their infinite loops to terminate.
StopThread( ::thAccept)
JoinThread( ::thAccept )
IF IsValidThread( ::thUDP )
InetClose( ::skUdp )
IF hb_threadId( ::thUDP ) != 0
hb_inetClose( ::skUdp )
StopThread( ::thUdp)
JoinThread( ::thUdp )
ENDIF
FOR EACH oElem IN ::aServing
IF IsValidThread( oElem:thSelf )
KillThread( oElem:thSelf )
IF hb_threadId( oElem:thSelf ) != 0
hb_threadQuitRequest( oElem:thSelf )
JoinThread( oElem:thSelf )
ENDIF
NEXT
@@ -1393,9 +1391,9 @@ METHOD Accept() CLASS tRPCService
LOCAL skIn
DO WHILE .T.
skIn := InetAccept( ::skServer )
skIn := hb_inetAccept( ::skServer )
// todo: better sync
IF InetStatus( ::skServer ) < 0
IF hb_inetStatus( ::skServer ) < 0
EXIT
ENDIF
IF skIn != NIL
@@ -1421,8 +1419,8 @@ METHOD UDPListen( ) CLASS tRPCService
LOCAL nPacketLen
DO WHILE .T.
nPacketLen := InetDGramRecv( ::skUdp, @cData, 1000 )
IF InetStatus( ::skUdp ) < 0
nPacketLen := hb_inetDGramRecv( ::skUdp, @cData, 1000 )
IF hb_inetStatus( ::skUdp ) < 0
EXIT
ENDIF
::UDPParseRequest( cData, nPacketLen )
@@ -1433,8 +1431,8 @@ METHOD UDPParseRequest( cData, nPacketLen ) CLASS tRPCService
LOCAL cToSend
IF ::UDPInterpretRequest( cData, nPacketLen, @cToSend )
InetDGramSend( ::skUdp, ;
InetAddress( ::skUdp ), InetPort( ::skUdp ), cToSend )
hb_inetDGramSend( ::skUdp, ;
hb_inetAddress( ::skUdp ), hb_inetPort( ::skUdp ), cToSend )
RETURN .T.
ENDIF
RETURN .F.

178
harbour/contrib/xhb/trpccli.prg
View File

@@ -53,8 +53,6 @@
#include "hbclass.ch"
#include "xhb.ch"
#include "hbrpc.ch"
CLASS tRPCClient
@@ -118,13 +116,13 @@ CLASS tRPCClient
METHOD HasError() INLINE ::nErrorCode != 0 .or. ::TcpHasError() .or. ::UdpHasError()
METHOD GetErrorCode() INLINE ::nErrorCode
METHOD TcpHasError() INLINE IIF( Empty( ::skTCP ), .F., InetErrorCode( ::skTCP ) > 0 )
METHOD GetTcpErrorCode() INLINE IIF( Empty( ::skTCP ), 0, InetErrorCode( ::skTCP ) )
METHOD GetTcpErrorDesc() INLINE IIF( Empty( ::skTCP ), "", InetErrorDesc( ::skTCP ) )
METHOD TcpHasError() INLINE IIF( Empty( ::skTCP ), .F., hb_inetErrorCode( ::skTCP ) > 0 )
METHOD GetTcpErrorCode() INLINE IIF( Empty( ::skTCP ), 0, hb_inetErrorCode( ::skTCP ) )
METHOD GetTcpErrorDesc() INLINE IIF( Empty( ::skTCP ), "", hb_inetErrorDesc( ::skTCP ) )
METHOD UdpHasError() INLINE IIF( Empty( ::skUDP ), .F., InetErrorCode( ::skUDP ) > 0 )
METHOD UdpGetErrorCode() INLINE IIF( Empty( ::skUDP ), 0, InetErrorCode( ::skUDP ) )
METHOD UdpGetErrorDesc() INLINE IIF( Empty( ::skUDP ), "", InetErrorDesc( ::skUDP ) )
METHOD UdpHasError() INLINE IIF( Empty( ::skUDP ), .F., hb_inetErrorCode( ::skUDP ) > 0 )
METHOD UdpGetErrorCode() INLINE IIF( Empty( ::skUDP ), 0, hb_inetErrorCode( ::skUDP ) )
METHOD UdpGetErrorDesc() INLINE IIF( Empty( ::skUDP ), "", hb_inetErrorDesc( ::skUDP ) )
/* Used to retreive data from scans */
METHOD GetFunctionName( xId )
METHOD GetServerName( xId )
@@ -132,7 +130,7 @@ CLASS tRPCClient
HIDDEN:
// Automatic initialization of inet support
CLASSDATA lInit INIT InetInit()
CLASSDATA lInit INIT hb_inetInit()
DATA mtxBusy INIT HB_MutexCreate()
@@ -208,8 +206,8 @@ METHOD New( cNetwork, nTcpPort, nUdpPort ) CLASS tRPCClient
::nUdpPort := IIF( nUdpPort == NIL, 1139, nUdpPort )
::nTcpPort := IIF( nTcpPort == NIL, 1140, nTcpPort )
::skTcp := InetCreate()
::skUdp := InetDGram( .T. )
::skTcp := hb_inetCreate()
::skUdp := hb_inetDGram( .T. )
::lAsyncMode := .F.
::aServers := {}
::aFunctions := {}
@@ -225,12 +223,12 @@ METHOD Destroy() CLASS tRPCClient
HB_MutexLock( ::mtxBusy )
::Disconnect()
IF IsValidThread( ::thUdpAccept )
KillThread( ::thUdpAccept )
IF hb_threadId( ::thUdpAccept ) != 0
hb_threadQuitRequest( ::thUdpAccept )
::thUdpAccept := NIL
ENDIF
IF IsValidThread( ::thTcpAccept )
KillThread( ::thTcpAccept )
IF hb_threadId( ::thTcpAccept ) != 0
hb_threadQuitRequest( ::thTcpAccept )
::thTcpAccept := NIL
ENDIF
HB_MutexUnlock( ::mtxBusy )
@@ -257,7 +255,7 @@ METHOD ScanServers(cName) CLASS tRPCClient
::aServers = {}
HB_MutexUnlock( ::mtxBusy )
InetDGramSend( ::skUDP, ::cNetwork , ::nUdpPort, "XHBR00" + HB_Serialize( cName ) )
hb_inetDGramSend( ::skUDP, ::cNetwork , ::nUdpPort, "XHBR00" + HB_Serialize( cName ) )
::StartScan()
RETURN .F.
@@ -269,20 +267,20 @@ METHOD CheckServer( cRemote )
IF cRemote == NIL
cRemote := ::cNetwork
ENDIF
skRemote := InetConnect( cRemote, ::nTcpPort )
IF InetErrorCode( skRemote ) == 0
InetSetTimeout(skRemote, 10000)
InetSendAll( skRemote, cData )
skRemote := hb_inetConnect( cRemote, ::nTcpPort )
IF hb_inetErrorCode( skRemote ) == 0
hb_InetTimeout(skRemote, 10000)
hb_inetSendAll( skRemote, cData )
cData := space(256)
InetRecvAll( skRemote, @cData, 6+9 )
IF InetErrorCode( skRemote ) == 0
hb_inetRecvAll( skRemote, @cData, 6+9 )
IF hb_inetErrorCode( skRemote ) == 0
cData2 := Space(256)
nLen := HB_GetLen8( substr( cData, 8, 8 ) )
InetRecvAll( skRemote, @cData2, nLen )
IF InetErrorCode( skRemote ) == 0
hb_inetRecvAll( skRemote, @cData2, nLen )
IF hb_inetErrorCode( skRemote ) == 0
cData := Substr( cData + cData2, 7 )
cData2 := HB_Deserialize( cData )
AAdd(::aServers, {InetAddress( skRemote ), cData2} )
AAdd(::aServers, {hb_inetAddress( skRemote ), cData2} )
RETURN .T.
ENDIF
ENDIF
@@ -303,7 +301,7 @@ METHOD ScanFunctions(cFunc, cSerial ) CLASS tRPCClient
::aServers = {}
HB_MutexUnlock( ::mtxBusy )
InetDGramSend( ::skUDP, ::cNetwork, ::nUdpPort,;
hb_inetDGramSend( ::skUDP, ::cNetwork, ::nUdpPort,;
"XHBR01" + HB_Serialize( cFunc ) + HB_Serialize( cSerial ))
::StartScan()
@@ -323,7 +321,7 @@ METHOD StartScan()
// in async mode, just launch the listener
IF ::lAsyncMode
HB_MutexLock( ::mtxBusy )
::thUdpAccept := StartThread( Self, "UDPAccept" )
::thUdpAccept := xhb_StartThread( Self, "UDPAccept" )
HB_MutexUnlock( ::mtxBusy )
ELSE
::UDPAccept()
@@ -338,13 +336,13 @@ METHOD UDPAccept() CLASS tRPCClient
cData := Space( 1400 )
// set default socket timeout
IF ::nTimeout >= 0
InetSetTimeout( ::skUDP, ::nTimeout )
hb_inetTimeout( ::skUDP, ::nTimeout )
ELSE
InetClearTimeout( ::skUdp )
hb_inetClearTimeout( ::skUdp )
ENDIF
DO WHILE .T.
nDatalen := InetDGramRecv( ::skUDP, @cData, 1400 )
nDatalen := hb_inetDGramRecv( ::skUDP, @cData, 1400 )
IF nDataLen > 0 .and. ::UDPParse( cData, nDatalen )
EXIT
@@ -387,7 +385,7 @@ METHOD UDPParse( cData, nLen ) CLASS tRPCClient
cData := HB_Deserialize( cData, 512 )
// deserialization error checking
IF cData != NIL
aLoc := { InetAddress( ::skUDP ), cData }
aLoc := { hb_inetAddress( ::skUDP ), cData }
AAdd( ::aServers, aLoc )
RETURN ::OnScanServersProgress( aLoc )
ELSE
@@ -401,7 +399,7 @@ METHOD UDPParse( cData, nLen ) CLASS tRPCClient
cName := HB_DeserialNext( @cSer, 64 )
cFunc := HB_DeserialNext( @cSer, 64 )
IF cName != NIL .and. cFunc != NIL
aLoc := { InetAddress( ::skUDP ), cName, cFunc }
aLoc := { hb_inetAddress( ::skUDP ), cName, cFunc }
AAdd( ::aFunctions, aLoc )
RETURN ::OnScanFunctionsProgress( aLoc )
ELSE
@@ -415,8 +413,8 @@ RETURN .F.
METHOD StopScan() CLASS tRPCClient
HB_MutexLock( ::mtxBusy )
IF IsValidThread( ::thUDPAccept )
KillThread( ::thUDPAccept )
IF hb_threadId( ::thUDPAccept ) != 0
hb_threadQuitRequest( ::thUDPAccept )
::thUDPAccept := NIL
HB_MutexUnlock( ::mtxBusy )
::OnScanComplete()
@@ -429,23 +427,23 @@ RETURN .T.
METHOD Connect( cServer, cUserId, cPassword ) CLASS tRPCClient
LOCAL cAuth, cReply := Space(8)
InetConnect( cServer, ::nTcpPort, ::skTcp )
hb_inetConnect( cServer, ::nTcpPort, ::skTcp )
IF InetErrorCode( ::skTcp ) == 0
IF hb_inetErrorCode( ::skTcp ) == 0
::nStatus := RPC_STATUS_CONNECTED // Connected
IF ::bEncrypted
cAuth := ::BuildChallengePwd( cPassword )
cAuth := cUserId + ":" + cAuth
InetSendAll( ::skTcp, "XHBR93" + HB_CreateLen8( Len( cAuth ) ) + cAuth )
hb_inetSendAll( ::skTcp, "XHBR93" + HB_CreateLen8( Len( cAuth ) ) + cAuth )
ELSE
cAuth := cUserId + ":" + cPassword
InetSendAll( ::skTcp, "XHBR90" + HB_CreateLen8( Len( cAuth ) ) + cAuth )
hb_inetSendAll( ::skTcp, "XHBR90" + HB_CreateLen8( Len( cAuth ) ) + cAuth )
ENDIF
IF InetErrorCode( ::skTcp ) == 0
IF hb_inetErrorCode( ::skTcp ) == 0
IF .not. ::bEncrypted
InetRecvAll( ::skTcp, @cReply )
IF InetErrorCode( ::skTcp ) == 0 .and. cReply == "XHBR91OK"
hb_inetRecvAll( ::skTcp, @cReply )
IF hb_inetErrorCode( ::skTcp ) == 0 .and. cReply == "XHBR91OK"
::nStatus := RPC_STATUS_LOGGED // Logged in
RETURN .T.
ENDIF
@@ -486,7 +484,7 @@ METHOD ManageChallenge() CLASS tRPCClient
LOCAL cData, nChallenge
cCode := Space( 6 )
IF InetRecvAll( ::skTCP, @cCode ) != 6
IF hb_inetRecvAll( ::skTCP, @cCode ) != 6
RETURN .F.
ENDIF
@@ -495,26 +493,26 @@ METHOD ManageChallenge() CLASS tRPCClient
ENDIF
cLen := Space( 8 )
IF InetRecvAll( ::skTCP, @cLen ) != 8
IF hb_inetRecvAll( ::skTCP, @cLen ) != 8
RETURN .F.
ENDIF
nLen := HB_GetLen8( cLen )
cData := Space( nLen )
IF InetRecvAll( ::skTCP, @cData, nLen ) != nLen
IF hb_inetRecvAll( ::skTCP, @cData, nLen ) != nLen
RETURN .F.
ENDIF
cData := HB_Decrypt( cData, ::cCryptKey )
nChallenge := HB_Checksum( cData )
InetSendAll( ::skTCP, "XHBR95" + HB_CreateLen8( nChallenge ) )
//IF InetErrorCode( ::skTCP ) != 0
hb_inetSendAll( ::skTCP, "XHBR95" + HB_CreateLen8( nChallenge ) )
//IF hb_inetErrorCode( ::skTCP ) != 0
// RETURN .F.
//ENDIF
cCode := Space( 8 )
InetRecvAll( ::skTCP, @cCode )
IF InetErrorCode( ::skTCP ) != 0 .or. cCode != "XHBR91OK"
hb_inetRecvAll( ::skTCP, @cCode )
IF hb_inetErrorCode( ::skTCP ) != 0 .or. cCode != "XHBR91OK"
RETURN .F.
ENDIF
/* SUCCESS! */
@@ -528,8 +526,8 @@ METHOD Disconnect() CLASS tRPCClient
IF ::nStatus >= RPC_STATUS_LOGGED
HB_MutexLock( ::mtxBusy )
::nStatus := RPC_STATUS_NONE
InetSendAll( ::skTcp, "XHBR92" )
InetClose( ::skTcp )
hb_inetSendAll( ::skTcp, "XHBR92" )
hb_inetClose( ::skTcp )
HB_MutexUnlock( ::mtxBusy )
RETURN .T.
ENDIF
@@ -575,9 +573,9 @@ METHOD ClearTCPBuffer() CLASS tRPCClient
RETURN .F.
ENDIF
DO WHILE InetDataReady( ::skTCP ) > 0
// InetRecv reads only the available data
InetRecv( ::skTCP, @cDummy )
DO WHILE hb_inetDataReady( ::skTCP ) > 0
// hb_inetRecv reads only the available data
hb_inetRecv( ::skTCP, @cDummy )
ENDDO
RETURN .T.
@@ -598,7 +596,7 @@ METHOD Call( ... ) CLASS tRPCClient
RETURN NIL
ENDIF
oCalling := PValue( 1 )
oCalling := hb_PValue( 1 )
IF ValType( oCalling ) == "A"
cFunction := oCalling[1]
ADel( oCalling, 1 )
@@ -608,7 +606,7 @@ METHOD Call( ... ) CLASS tRPCClient
cFunction := oCalling
aParams := Array( Pcount() -1 )
FOR nCount := 2 TO Pcount()
aParams[nCount - 1] := PValue( nCount )
aParams[nCount - 1] := hb_PValue( nCount )
NEXT
ENDIF
@@ -618,7 +616,7 @@ METHOD Call( ... ) CLASS tRPCClient
// The real call
HB_MutexLock( ::mtxBusy )
// already active or not already connected
IF IsValidThread( ::thTcpAccept ) .or. ::skTCP == NIL .or. ::nStatus < RPC_STATUS_LOGGED
IF hb_threadId( ::thTcpAccept ) != 0 .or. ::skTCP == NIL .or. ::nStatus < RPC_STATUS_LOGGED
HB_MutexUnlock( ::mtxBusy )
RETURN NIL
ENDIF
@@ -634,7 +632,7 @@ METHOD Call( ... ) CLASS tRPCClient
// in async mode, just launch the listener
IF ::lAsyncMode
HB_MutexLock( ::mtxBusy )
::thTCPAccept := StartThread( Self, "TCPAccept" )
::thTCPAccept := xhb_StartThread( Self, "TCPAccept" )
HB_MutexUnlock( ::mtxBusy )
ELSE
::TCPAccept()
@@ -653,22 +651,22 @@ METHOD SetPeriodCallback( ... ) CLASS tRPCClient
ENDIF
HB_MutexLock( ::mtxBusy )
::nTimeout := PValue( 1 )
::nTimeLimit := PValue( 2 )
::nTimeout := hb_PValue( 1 )
::nTimeLimit := hb_PValue( 2 )
caCalling := PValue( 3 )
caCalling := hb_PValue( 3 )
IF ValType( caCalling ) != "A"
caCalling := Array( Pcount() -2 )
FOR nCount := 3 TO Pcount()
caCalling[nCount - 2] := PValue( nCount )
caCalling[nCount - 2] := hb_PValue( nCount )
NEXT
ENDIF
::caPerCall := caCalling
IF ::skTCP != NIL
InetSetTimeout( ::skTCP, ::nTimeout )
InetSetTimeLimit( ::skTCP, ::nTimeLimit )
InetSetPeriodCallback( ::skTCP, caCalling )
hb_inetTimeout( ::skTCP, ::nTimeout )
hb_InetTimeLimit( ::skTCP, ::nTimeLimit )
hb_inetSetPeriodCallback( ::skTCP, caCalling )
ENDIF
HB_MutexUnlock( ::mtxBusy )
@@ -684,9 +682,9 @@ METHOD ClearPeriodCallback() CLASS tRPCClient
::caPerCall := NIL
IF ::skTCP != NIL
InetClearTimeout( ::skTCP )
InetClearTimeLimit( ::skTCP )
InetClearPeriodCallback( ::skTCP )
hb_inetClearTimeout( ::skTCP )
hb_inetClearTimeLimit( ::skTCP )
hb_inetClearPeriodCallback( ::skTCP )
ENDIF
HB_MutexUnlock( ::mtxBusy )
@@ -697,7 +695,7 @@ METHOD SetTimeout( nTime ) CLASS tRPCClient
HB_MutexLock( ::mtxBusy )
::nTimeout := nTime
InetSetTimeout( ::skTCP, ::nTimeout )
hb_InetTimeout( ::skTCP, ::nTimeout )
HB_MutexUnlock( ::mtxBusy )
RETURN .T.
@@ -721,12 +719,12 @@ METHOD StopCall() CLASS tRPCClient
::ClearTcpBuffer()
// send cancelation request
InetSendAll( ::skTCP, "XHBR29" );
hb_inetSendAll( ::skTCP, "XHBR29" );
//Stops waiting for a result
HB_MutexLock( ::mtxBusy )
IF IsValidThread( ::thTCPAccept )
KillThread( ::thTCPAccept )
IF hb_threadId( ::thTCPAccept ) != 0
hb_threadQuitRequest( ::thTCPAccept )
::thTCPAccept := NIL
::nStatus := RPC_STATUS_LOGGED
HB_MutexUnlock( ::mtxBusy )
@@ -787,8 +785,8 @@ METHOD SendCall( cFunction, aParams ) CLASS tRPCClient
cType + ::Encrypt( cData)
ENDIF
InetSendAll( ::skTCP, cData )
RETURN ( InetErrorCode( ::skTCP ) == 0 )
hb_inetSendAll( ::skTCP, cData )
RETURN hb_inetErrorCode( ::skTCP ) == 0
METHOD TCPAccept() CLASS tRPCClient
@@ -811,7 +809,7 @@ METHOD TCPAccept() CLASS tRPCClient
DO WHILE .T.
IF InetRecvAll( ::skTCP, @cCode, 6 ) <= 0
IF hb_inetRecvAll( ::skTCP, @cCode, 6 ) <= 0
EXIT
ENDIF
@@ -835,9 +833,9 @@ METHOD TCPAccept() CLASS tRPCClient
::nStatus := RPC_STATUS_LOGGED
::thTcpAccept := NIL
IF ::caPerCall == NIL .and. InetErrorCode( ::skTCP ) != -1 .and.;
IF ::caPerCall == NIL .and. hb_inetErrorCode( ::skTCP ) != -1 .and.;
nTime - nTimeLimit < nTimeLimit - 5
IF InetErrorCode( ::skTCP ) != 0
IF hb_inetErrorCode( ::skTCP ) != 0
::nStatus := RPC_STATUS_ERROR
ENDIF
ENDIF
@@ -859,16 +857,16 @@ METHOD TCPParse( cCode ) CLASS tRPCClient
/* Warn error codes */
CASE cCode == "XHBR40"
cData := Space(2)
InetRecvAll( ::skTCP, @cData, 2 )
hb_inetRecvAll( ::skTCP, @cData, 2 )
::nErrorCode := Val( cData )
::OnFunctionFail( ::nErrorCode, "No description for now" )
/* We have a reply */
CASE cCode == "XHBR30"
IF InetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
nDataLen := HB_GetLen8( cDataLen )
cData := Space( nDataLen )
IF InetRecvAll( ::skTCP, @cData, nDataLen ) == nDataLen
IF hb_inetRecvAll( ::skTCP, @cData, nDataLen ) == nDataLen
::oResult := HB_Deserialize( ::Decrypt( cData ), nDataLen )
IF ::oResult != NIL
::OnFunctionReturn( ::oResult )
@@ -879,12 +877,12 @@ METHOD TCPParse( cCode ) CLASS tRPCClient
/* We have a reply */
CASE cCode == "XHBR31"
IF InetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen )
IF hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen )
nOrigLen = HB_GetLen8( cOrigLen )
IF InetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
nDataLen := HB_GetLen8( cDataLen )
cData := Space( nDataLen )
IF InetRecvAll( ::skTCP, @cData ) == nDataLen
IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen
cData := HB_Uncompress( nOrigLen, ::Decrypt( cData ) )
IF .not. Empty( cData )
::oResult := HB_Deserialize( cData, nDataLen )
@@ -898,7 +896,7 @@ METHOD TCPParse( cCode ) CLASS tRPCClient
/* We have a progress */
CASE cCode == "XHBR33"
IF InetRecvAll( ::skTCP, @cProgress, 10 ) == 10
IF hb_inetRecvAll( ::skTCP, @cProgress, 10 ) == 10
nProgress := HB_Deserialize( cProgress, 10 )
IF nProgress != NIL
lContinue := .T.
@@ -908,12 +906,12 @@ METHOD TCPParse( cCode ) CLASS tRPCClient
/* We have a progress with data*/
CASE cCode == "XHBR34"
IF InetRecvAll( ::skTCP, @cProgress ) == Len( cProgress )
IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress )
nProgress := HB_Deserialize( cProgress, Len( cProgress) )
IF nProgress != NIL .and. InetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
IF nProgress != NIL .and. hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
nDataLen := HB_GetLen8( cDataLen )
cData := Space( nDataLen )
IF InetRecvAll( ::skTCP, @cData ) == nDataLen
IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen
::oResult := HB_Deserialize(::Decrypt( cData), nDataLen )
IF ::oResult != NIL
lContinue := .T.
@@ -925,14 +923,14 @@ METHOD TCPParse( cCode ) CLASS tRPCClient
/* We have a progress with compressed data*/
CASE cCode == "XHBR35"
IF InetRecvAll( ::skTCP, @cProgress ) == Len( cProgress )
IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress )
nProgress := HB_Deserialize( cProgress, Len( cProgress ) )
IF nProgress != NIL .and. InetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen )
IF nProgress != NIL .and. hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen )
nOrigLen = HB_GetLen8( cOrigLen )
IF InetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen )
nDataLen := HB_GetLen8( cDataLen )
cData := Space( nDataLen )
IF InetRecvAll( ::skTCP, @cData ) == nDataLen
IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen
cData := HB_Uncompress( nOrigLen, cData )
IF .not. Empty( cData )
::oResult := HB_Deserialize( ::Decrypt( cData), nDataLen )