From 69e0fe3045916512019ee93b1b7c2f3065363186 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Fri, 5 Oct 2012 11:06:32 +0000 Subject: [PATCH] 2012-10-05 12:55 UTC+0200 Viktor Szakats (vszakats syenar.net) * contrib/hbct/tests/ctwtest.prg * contrib/hbwin/tests/testole.prg * contrib/xhb/cstruct.prg * contrib/xhb/dumpvar.prg * contrib/xhb/hblog.prg * contrib/xhb/htmutil.prg * contrib/xhb/thtm.prg * contrib/xhb/traceprg.prg * contrib/xhb/trpccli.prg * contrib/xhb/xhberr.prg * extras/gtwvw/tests/wvwtest9.prg * extras/hbvpdf/hbvpdf.ch * extras/hbvpdf/hbvpdf.prg * extras/httpsrv/session.prg * extras/httpsrv/uhttpd.prg * tests/gtkeys.prg * tests/tb1.prg * tests/wvtext.prg * use hb_keyCode(), hb_keyChar(), hb_ntos() (with __HARBOUR__) * some xhb lib sources hbformatted along the way * contrib/xhb/traceprg.prg * contrib/xhb/trpc.prg * hbformat, hand corrections * extras/hbvpdf/hbvpdf.hbp - extras/hbvpdf/hbvpdft.prg - extras/hbvpdf/tests/tstpdf.prg - deleted duplicated code that implements hbvpdf functionality in an OOP flavor. Please rework it in a way that it uses the underlying API and avoid copy/pasting complete source. --- harbour/ChangeLog | 45 + harbour/contrib/hbct/tests/ctwtest.prg | 20 +- harbour/contrib/hbwin/tests/testole.prg | 34 +- harbour/contrib/xhb/cstruct.prg | 4 +- harbour/contrib/xhb/dumpvar.prg | 8 +- harbour/contrib/xhb/hblog.prg | 360 +-- harbour/contrib/xhb/htmutil.prg | 2 +- harbour/contrib/xhb/thtm.prg | 10 +- harbour/contrib/xhb/traceprg.prg | 27 +- harbour/contrib/xhb/trpc.prg | 962 ++++---- harbour/contrib/xhb/trpccli.prg | 576 ++--- harbour/contrib/xhb/xhberr.prg | 18 +- harbour/contrib/xhb/xhbtedit.prg | 6 +- harbour/extras/gtwvw/tests/wvwtest9.prg | 29 +- harbour/extras/hbvpdf/hbvpdf.ch | 2 +- harbour/extras/hbvpdf/hbvpdf.hbp | 1 - harbour/extras/hbvpdf/hbvpdf.prg | 152 +- harbour/extras/hbvpdf/hbvpdft.prg | 2647 ----------------------- harbour/extras/hbvpdf/tests/tstpdf.prg | 185 -- harbour/extras/httpsrv/session.prg | 4 +- harbour/extras/httpsrv/uhttpd.prg | 28 +- harbour/tests/gtkeys.prg | 12 +- harbour/tests/tb1.prg | 5 +- harbour/tests/wvtext.prg | 12 +- 24 files changed, 1237 insertions(+), 3912 deletions(-) delete mode 100644 harbour/extras/hbvpdf/hbvpdft.prg delete mode 100644 harbour/extras/hbvpdf/tests/tstpdf.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e8adfdc166..f9cc0e777b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,51 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-05 12:55 UTC+0200 Viktor Szakats (vszakats syenar.net) + * contrib/hbct/tests/ctwtest.prg + * contrib/hbwin/tests/testole.prg + * contrib/xhb/cstruct.prg + * contrib/xhb/dumpvar.prg + * contrib/xhb/hblog.prg + * contrib/xhb/htmutil.prg + * contrib/xhb/thtm.prg + * contrib/xhb/traceprg.prg + * contrib/xhb/trpccli.prg + * contrib/xhb/xhberr.prg + * extras/gtwvw/tests/wvwtest9.prg + * extras/hbvpdf/hbvpdf.ch + * extras/hbvpdf/hbvpdf.prg + * extras/httpsrv/session.prg + * extras/httpsrv/uhttpd.prg + * tests/gtkeys.prg + * tests/tb1.prg + * tests/wvtext.prg + * use hb_keyCode(), hb_keyChar(), hb_ntos() (with __HARBOUR__) + * some xhb lib sources hbformatted along the way + + * contrib/xhb/traceprg.prg + * contrib/xhb/trpc.prg + * hbformat, hand corrections + + * extras/hbvpdf/hbvpdf.hbp + - extras/hbvpdf/hbvpdft.prg + - extras/hbvpdf/tests/tstpdf.prg + - deleted duplicated code that implements hbvpdf functionality + in an OOP flavor. Please rework it in a way that it uses + the underlying API and avoid copy/pasting complete source. + +2012-10-05 12:18 UTC+0200 Viktor Szakats (vszakats syenar.net) + * contrib/hbct/tests/ctwtest.prg + * contrib/hbwin/tests/testole.prg + * extras/gtwvw/tests/wvwtest9.prg + * tests/gtkeys.prg + * tests/tb1.prg + * tests/wvtext.prg + +2012-10-05 12:09 UTC+0200 Viktor Szakats (vszakats syenar.net) + * tests/gtkeys.prg + * use hb_keyCode() instead of Asc() with __HARBOUR__ + 2012-10-05 11:59 UTC+0200 Viktor Szakats (harbour syenar.net) * src/rtl/philes.c ! HB_FGETDATETIME(): make sure to set the referential diff --git a/harbour/contrib/hbct/tests/ctwtest.prg b/harbour/contrib/hbct/tests/ctwtest.prg index a850cc150e..c4b159a9f9 100644 --- a/harbour/contrib/hbct/tests/ctwtest.prg +++ b/harbour/contrib/hbct/tests/ctwtest.prg @@ -65,22 +65,22 @@ PROCEDURE Main() k := Inkey( 0, INKEY_ALL ) IF k == K_ESC EXIT - ELSEIF k >= Asc( "1" ) .AND. k <= Asc( "9" ) - wselect( aWin[ k - Asc( "0" ) ] ) - ELSEIF k == Asc( "0" ) + ELSEIF k >= hb_keyCode( "1" ) .AND. k <= hb_keyCode( "9" ) + wselect( aWin[ k - hb_keyCode( "0" ) ] ) + ELSEIF k == hb_keyCode( "0" ) wselect( 0 ) - ELSEIF k == Asc( "C" ) .OR. k == Asc( "c" ) + ELSEIF k == hb_keyCode( "C" ) .OR. k == hb_keyCode( "c" ) wclose() - ELSEIF k == Asc( "Q" ) .OR. k == Asc( "q" ) + ELSEIF k == hb_keyCode( "Q" ) .OR. k == hb_keyCode( "q" ) CLS - ELSEIF k == Asc( "B" ) .OR. k == Asc( "b" ) + ELSEIF k == hb_keyCode( "B" ) .OR. k == hb_keyCode( "b" ) IF lBoard wboard( 0, 0, MaxRow( .T. ) - 1, MaxCol( .T. ) ) ELSE wboard( 5, 5, 20, 75 ) ENDIF lBoard := !lBoard - ELSEIF k == Asc( "P" ) .OR. k == Asc( "P" ) + ELSEIF k == hb_keyCode( "P" ) .OR. k == hb_keyCode( "P" ) y := wfrow() x := wfcol() i := wselect() @@ -106,13 +106,13 @@ PROCEDURE Main() RETURN -STATIC PROC dspcord() +STATIC PROCEDURE dspcord() LOCAL mr := MRow(), mc := MCol(), r := wrow(), c := wcol(), w := wselect() wselect( 0 ) - @ MaxRow(), 0 SAY PadR( "WPOS(" + LTrim( Str( r ) ) + "," + LTrim( Str( c ) ) + ")" + ; - iif( MPresent(), "MPOS(" + LTrim( Str( mr ) ) + "," + LTrim( Str( mc ) ) + ")", "" ), MaxCol() + 1 ) + @ MaxRow(), 0 SAY PadR( "WPOS(" + hb_ntos( r ) + "," + hb_ntos( c ) + ")" + ; + iif( MPresent(), "MPOS(" + hb_ntos( mr ) + "," + hb_ntos( mc ) + ")", "" ), MaxCol() + 1 ) wselect( w ) RETURN diff --git a/harbour/contrib/hbwin/tests/testole.prg b/harbour/contrib/hbwin/tests/testole.prg index 1d214399d3..efad9f45df 100644 --- a/harbour/contrib/hbwin/tests/testole.prg +++ b/harbour/contrib/hbwin/tests/testole.prg @@ -20,6 +20,8 @@ PROCEDURE Main() LOCAL nOption + CLS + DO WHILE .T. ? "" ? "Select OLE test:" @@ -41,37 +43,37 @@ PROCEDURE Main() ? "> " nOption := Inkey( 0 ) - ?? Chr( nOption ) + ?? hb_keyChar( nOption ) - IF nOption == Asc( "1" ) + IF nOption == hb_keyCode( "1" ) Exm_MSExcel() - ELSEIF nOption == Asc( "2" ) + ELSEIF nOption == hb_keyCode( "2" ) Exm_MSWord() - ELSEIF nOption == Asc( "3" ) + ELSEIF nOption == hb_keyCode( "3" ) Exm_MSOutlook() - ELSEIF nOption == Asc( "4" ) + ELSEIF nOption == hb_keyCode( "4" ) Exm_MSOutlook2() - ELSEIF nOption == Asc( "5" ) + ELSEIF nOption == hb_keyCode( "5" ) Exm_IExplorer() - ELSEIF nOption == Asc( "6" ) + ELSEIF nOption == hb_keyCode( "6" ) Exm_OOCalc() - ELSEIF nOption == Asc( "7" ) + ELSEIF nOption == hb_keyCode( "7" ) Exm_OOWriter() - ELSEIF nOption == Asc( "8" ) + ELSEIF nOption == hb_keyCode( "8" ) Exm_OOOpen() - ELSEIF nOption == Asc( "9" ) + ELSEIF nOption == hb_keyCode( "9" ) Exm_CDO() - ELSEIF nOption == Asc( "a" ) + ELSEIF nOption == hb_keyCode( "a" ) Exm_ADODB() - ELSEIF nOption == Asc( "b" ) + ELSEIF nOption == hb_keyCode( "b" ) Exm_SOAP() - ELSEIF nOption == Asc( "c" ) + ELSEIF nOption == hb_keyCode( "c" ) Exm_PocketSOAP() - ELSEIF nOption == Asc( "d" ) + ELSEIF nOption == hb_keyCode( "d" ) Exm_IExplorer2() - ELSEIF nOption == Asc( "e" ) + ELSEIF nOption == hb_keyCode( "e" ) Exm_CreateShortcut() - ELSEIF nOption == Asc( "0" ) + ELSEIF nOption == hb_keyCode( "0" ) EXIT ENDIF ENDDO diff --git a/harbour/contrib/xhb/cstruct.prg b/harbour/contrib/xhb/cstruct.prg index 07a25df19e..f21127caaf 100644 --- a/harbour/contrib/xhb/cstruct.prg +++ b/harbour/contrib/xhb/cstruct.prg @@ -401,7 +401,7 @@ FUNCTION HB_CTypeArrayID( CType, nLen ) LOCAL Counter LOCAL nID LOCAL aCTypes, acMembers, cMember - LOCAL cArrayClassName := "C Array of [" + LTrim( Str( nLen ) ) + "] CType: " + Str( CType ) + LOCAL cArrayClassName := "C Array of [" + hb_ntos( nLen ) + "] CType: " + Str( CType ) nID := aScan( s_aArrayClasses, {| aArrayDefinitions | aArrayDefinitions[1] == CType .AND. aArrayDefinitions[2] == nLen } ) @@ -437,7 +437,7 @@ FUNCTION HB_CTypeArrayID( CType, nLen ) //ENDIF FOR Counter := 1 TO nLen - cMember := LTrim( Str( Counter ) ) + cMember := hb_ntos( Counter ) acMembers[Counter] := cMember __clsAddMsg( hClass, cMember, Counter, HB_OO_MSG_PROPERTY ) NEXT diff --git a/harbour/contrib/xhb/dumpvar.prg b/harbour/contrib/xhb/dumpvar.prg index d3e0aefc51..4c4b8ca8ed 100644 --- a/harbour/contrib/xhb/dumpvar.prg +++ b/harbour/contrib/xhb/dumpvar.prg @@ -142,7 +142,7 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion CASE cType == "A" IF nRecursionLevel == 1 - cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + hb_eol() + cString += Space( nIndent ) + "Type='A' -> { Array of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() ENDIF IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel cString += AsString( xVar ) @@ -152,7 +152,7 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion CASE cType == "H" IF nRecursionLevel == 1 - cString += Space( nIndent ) + "Type='H' -> { Hash of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + hb_eol() + cString += Space( nIndent ) + "Type='H' -> { Hash of " + hb_ntos( Len( xVar ) ) + " Items }" + hb_eol() ENDIF IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel cString += AsString( xVar ) @@ -214,8 +214,8 @@ STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecu IF HB_ISARRAY( aVar ) nEolLen := Len( hb_eol() ) - nChar := Len( LTrim( Str( Len( aVar ) ) ) ) // return number of chars to display that value - // i.e. if Len( aVar ) == 99, then nChar := 2 + nChar := Len( hb_ntos( Len( aVar ) ) ) // return number of chars to display that value + // i.e. if Len( aVar ) == 99, then nChar := 2 cString += Space( nIndent ) + "{" + hb_eol() FOR EACH xVal IN aVar cString += Space( nIndent ) + " ["+ LTrim( StrZero( xVal:__EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + hb_eol() diff --git a/harbour/contrib/xhb/hblog.prg b/harbour/contrib/xhb/hblog.prg index 2368f4da06..61d1b89cf8 100644 --- a/harbour/contrib/xhb/hblog.prg +++ b/harbour/contrib/xhb/hblog.prg @@ -68,129 +68,130 @@ STATIC s_StdLogger PROCEDURE HB_InitStandardLog( ... ) - LOCAL Param + LOCAL PARAM s_StdLogger := HB_Logger():New() - FOR EACH Param in HB_aParams() - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif + FOR EACH PARAM in hb_AParams() +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:AddChannel( Param ) - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif NEXT - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:SetStyle( HB_LOG_ST_DATE + HB_LOG_ST_ISODATE + HB_LOG_ST_TIME + HB_LOG_ST_LEVEL ) - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif -RETURN +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif + + RETURN PROCEDURE HB_OpenStandardLog() s_StdLogger:Open() -RETURN + RETURN PROCEDURE HB_StandardLogAdd( oChannel ) IF s_StdLogger != NIL - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:AddChannel( oChannel ) - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif ENDIF -RETURN + RETURN PROCEDURE HB_CloseStandardLog() - // If the logger is NIL also the mutex is NIL +// If the logger is NIL also the mutex is NIL IF s_StdLogger != NIL - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:Close() - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif ENDIF -RETURN - + RETURN PROCEDURE HB_SetStandardLogStyle( nStyle ) IF s_StdLogger != NIL - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:SetStyle( nStyle ) - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif ENDIF -RETURN + RETURN PROCEDURE HB_StandardLogName( cName ) - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:cProgName := cName - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif -RETURN + RETURN PROCEDURE HB_StandardLog( cMsg, nPrio ) IF s_StdLogger != NIL - #ifdef HB_THREAD_SUPPORT - HB_MutexLock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexLock( s_StdLogMutex ) +#endif s_StdLogger:Log( cMsg, nPrio ) - #ifdef HB_THREAD_SUPPORT - HB_MutexUnlock( s_StdLogMutex ) - #endif +#ifdef HB_THREAD_SUPPORT + hb_mutexUnlock( s_StdLogMutex ) +#endif ENDIF -RETURN + RETURN FUNCTION HB_BldLogMsg( ... ) LOCAL xVar LOCAL cMsg := "" - FOR EACH xVar IN HB_aParams() + FOR EACH xVar IN hb_AParams() IF HB_ISNUMERIC( xVar ) - cMsg += AllTrim( HB_CStr( xVar ) ) + cMsg += AllTrim( hb_CStr( xVar ) ) ELSEIF ! HB_ISSTRING( xVar ) - cMsg += HB_CStr( xVar ) + cMsg += hb_CStr( xVar ) ELSE cMsg += xVar ENDIF @@ -200,31 +201,32 @@ FUNCTION HB_BldLogMsg( ... ) ENDIF NEXT -RETURN cMsg + RETURN cMsg FUNCTION HB_LogDateStamp() LOCAL dToday := Date() -RETURN Str(Year( dToday ), 4 ) +"-"+ Padl( Month( dToday ) , 2, "0" ) + "-" + Padl( Day( dToday ), 2, "0" ) + RETURN Str( Year( dToday ), 4 ) + "-" + PadL( Month( dToday ) , 2, "0" ) + "-" + PadL( Day( dToday ), 2, "0" ) /********************************************** * Logger class ***********************************************/ CLASS HB_Logger + DATA cProgName DATA aLogToChannel INIT {} DATA nStyle INIT -1 DATA nDefaultPriority INIT HB_LOG_INFO METHOD New() - METHOD AddChannel( oChannel ) INLINE Aadd( ::aLogToChannel, oChannel ) + METHOD AddChannel( oChannel ) INLINE AAdd( ::aLogToChannel, oChannel ) METHOD SetStyle( nStyle ) INLINE ::nStyle := nStyle METHOD Open() - METHOD Close() + METHOD close() METHOD Log( cMessage, nPriority ) @@ -238,12 +240,14 @@ ENDCLASS */ METHOD New() CLASS HB_Logger + LOCAL nCount FOR nCount := 1 TO PCount() ::AddChannel( hb_PValue( nCount ) ) NEXT -RETURN Self + + RETURN Self /** * Open all the channels calling their ::Open() method @@ -254,36 +258,39 @@ METHOD PROCEDURE Open() CLASS HB_Logger LOCAL oChannel IF ::cProgName == NIL - HB_FnameSplit( hb_argv(0),,@::cProgName ) + hb_FNameSplit( hb_argv( 0 ), , @::cProgName ) ENDIF FOR EACH oChannel IN ::aLogToChannel oChannel:Open( ::cProgName ) NEXT -RETURN + RETURN /** * Close all the channels calling their ::Close() method */ -METHOD PROCEDURE Close() CLASS HB_Logger + +METHOD PROCEDURE close() CLASS HB_Logger LOCAL oChannel IF ::cProgName == NIL - HB_FnameSplit( hb_argv(0),,@::cProgName ) + hb_FNameSplit( hb_argv( 0 ), , @::cProgName ) ENDIF FOR EACH oChannel IN ::aLogToChannel oChannel:Close( ::cProgName ) NEXT -RETURN + RETURN /** * Send a log message to all the channels */ + METHOD PROCEDURE Log( cMessage, nPriority ) CLASS HB_Logger + LOCAL oChannel IF nPriority == NIL @@ -296,28 +303,29 @@ METHOD PROCEDURE Log( cMessage, nPriority ) CLASS HB_Logger oChannel:Log( ::nStyle, cMessage, ::cProgName, nPriority ) NEXT -RETURN + RETURN /********************************************** * Logger Channel class (mostly VIRTUAL) ***********************************************/ CLASS HB_LogChannel + DATA lOpened INIT .F. METHOD New( nLevel ) CONSTRUCTOR METHOD Open( cName ) VIRTUAL - METHOD Close( cName ) VIRTUAL + METHOD close( cName ) VIRTUAL METHOD Log( nStyle, cMessage, cName, nPriority ) METHOD SetActive( lAct ) INLINE ::lActive := lAct METHOD Format( nStyle, cMessage, cName, nPriority ) -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cName, nPriority ) VIRTUAL -HIDDEN: + HIDDEN: DATA nLevel DATA lActive INIT .T. @@ -327,6 +335,7 @@ ENDCLASS * Creates a new channel. nLeven can be nil ( and will log all ), * cName is the "program name" and must be given */ + METHOD New( nLevel ) CLASS HB_LogChannel IF nLevel == NIL @@ -335,7 +344,8 @@ METHOD New( nLevel ) CLASS HB_LogChannel ENDIF ::nLevel := nLevel -RETURN Self + + RETURN Self /** * Log the message: it send a request to the subclass "send" method @@ -344,66 +354,67 @@ RETURN Self METHOD PROCEDURE Log( nStyle, cMessage, cName, nPriority ) CLASS HB_LogChannel - IF nPriority <= ::nLevel .and. ::lActive + IF nPriority <= ::nLevel .AND. ::lActive ::Send( nStyle, cMessage, cName, nPriority ) ENDIF -RETURN + RETURN /** * This is an utility functions for subclasses, used to * have a standard formatting for the message. Subclasses * may or may not call it. */ + METHOD Format( nStyle, cMessage, cName, nPriority ) CLASS HB_LogChannel LOCAL cPrefix := "" - IF HB_BitAnd( nStyle, HB_LOG_ST_DATE ) > 0 - IF HB_BitAnd( nStyle, HB_LOG_ST_ISODATE ) > 0 + IF hb_bitAnd( nStyle, HB_LOG_ST_DATE ) > 0 + IF hb_bitAnd( nStyle, HB_LOG_ST_ISODATE ) > 0 cPrefix += HB_LogDateStamp() ELSE - cPrefix += DtoC( Date() ) + cPrefix += DToC( Date() ) ENDIF cPrefix += " " ENDIF - IF HB_BitAnd( nStyle, HB_LOG_ST_NAME ) > 0 + IF hb_bitAnd( nStyle, HB_LOG_ST_NAME ) > 0 cPrefix += cName + " " ENDIF - IF HB_BitAnd( nStyle, HB_LOG_ST_TIME ) > 0 + IF hb_bitAnd( nStyle, HB_LOG_ST_TIME ) > 0 cPrefix += Time() + " " ENDIF - IF HB_BitAnd( nStyle, HB_LOG_ST_LEVEL ) > 0 + IF hb_bitAnd( nStyle, HB_LOG_ST_LEVEL ) > 0 SWITCH nPriority - CASE HB_LOG_CRITICAL - cPrefix += "CRITICAL: " + CASE HB_LOG_CRITICAL + cPrefix += "CRITICAL: " EXIT - CASE HB_LOG_ERROR - cPrefix += "ERROR: " + CASE HB_LOG_ERROR + cPrefix += "ERROR: " EXIT - CASE HB_LOG_WARNING - cPrefix += "WARNING: " + CASE HB_LOG_WARNING + cPrefix += "WARNING: " EXIT - CASE HB_LOG_INFO - cPrefix += "INFO: " + CASE HB_LOG_INFO + cPrefix += "INFO: " EXIT - CASE HB_LOG_DEBUG - cPrefix += "DEBUG: " + CASE HB_LOG_DEBUG + cPrefix += "DEBUG: " EXIT - OTHERWISE - cPrefix += "DEBUG" + Alltrim( Str(nPriority - HB_LOG_DEBUG) )+ ": " - END + OTHERWISE + cPrefix += "DEBUG" + hb_ntos( nPriority - HB_LOG_DEBUG ) + ": " + ENDSWITCH ENDIF -RETURN cPrefix + cMessage + RETURN cPrefix + cMessage /********************************************** * Console channel @@ -413,20 +424,22 @@ CLASS HB_LogConsole FROM HB_LogChannel METHOD New( nLevel ) METHOD Open( cName ) - METHOD Close( cName ) + METHOD close( cName ) METHOD Out( ... ) METHOD LogOnVt( ldo ) INLINE ::lRealConsole := ldo -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cName, nPriority ) DATA lRealConsole INIT .T. ENDCLASS METHOD New( nLevel ) CLASS HB_LogConsole + ::Super:New( nLevel ) -RETURN Self + + RETURN Self METHOD Open( cName ) CLASS HB_LogConsole @@ -437,9 +450,9 @@ METHOD Open( cName ) CLASS HB_LogConsole ::Out( HB_LogDateStamp(), Time(), "--", cName, "start --" ) ::lOpened := .T. -RETURN .T. + RETURN .T. -METHOD Close( cName ) CLASS HB_LogConsole +METHOD close( cName ) CLASS HB_LogConsole IF ! ::lOpened RETURN .F. @@ -448,22 +461,24 @@ METHOD Close( cName ) CLASS HB_LogConsole ::Out( HB_LogDateStamp(), Time(), "--", cName, "end --" ) ::lOpened := .F. -RETURN .T. + RETURN .T. METHOD PROCEDURE Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogConsole ::Out( ::Format( nStyle, cMessage, cName, nPriority ) ) -RETURN + 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 xPar:__EnumIndex() < nLen - cMsg += " " - ENDIF + LOCAL nLen := Len( hb_AParams() ) + + FOR EACH xPar IN hb_AParams() + cMsg += hb_CStr( xPar ) + IF xPar:__EnumIndex() < nLen + cMsg += " " + ENDIF NEXT IF ::lRealConsole OutStd( cMsg, hb_eol() ) @@ -471,11 +486,12 @@ METHOD PROCEDURE Out( ... ) CLASS HB_LogConsole QOut( cMsg ) ENDIF -RETURN + RETURN /********************************************** * Console channel - to file ***********************************************/ + CLASS HB_LogFile FROM HB_LogChannel DATA cFileName @@ -485,14 +501,13 @@ CLASS HB_LogFile FROM HB_LogChannel METHOD New( nLevel, cFilename, nMaxSize, nBackup ) METHOD Open( cProgName ) - METHOD Close( cProgName ) + METHOD close( cProgName ) -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cProgName, nPriority ) ENDCLASS - METHOD New( nLevel, cFilename, nMaxSize, nBackup ) CLASS HB_LogFile ::Super:New( nLevel ) @@ -506,7 +521,7 @@ METHOD New( nLevel, cFilename, nMaxSize, nBackup ) CLASS HB_LogFile ::nBackup := nBackup ENDIF -RETURN Self + RETURN Self METHOD Open( cProgName ) CLASS HB_LogFile @@ -516,120 +531,121 @@ METHOD Open( cProgName ) CLASS HB_LogFile IF hb_FileExists( ::cFileName ) ::nFileHandle := FOpen( ::cFileName, FO_READWRITE ) - IF ::nFileHandle > 0 - Fseek( ::nFileHandle, 0 ,FS_END ) + IF ::nFileHandle != F_ERROR + FSeek( ::nFileHandle, 0, FS_END ) END ELSE ::nFileHandle := hb_FCreate( ::cFileName, FC_NORMAL, FO_READWRITE ) ENDIF - IF ::nFileHandle < 0 + IF ::nFileHandle == F_ERROR RETURN .F. ENDIF - Fwrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "--", cProgName, "start --", hb_eol() ) ) + FWrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "--", cProgName, "start --", hb_eol() ) ) - HB_Fcommit( ::nFileHandle ) + hb_FCommit( ::nFileHandle ) ::lOpened := .T. -RETURN .T. + RETURN .T. -METHOD Close( cProgName ) CLASS HB_LogFile +METHOD close( cProgName ) CLASS HB_LogFile IF ! ::lOpened RETURN .F. ENDIF - Fwrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "--", cProgName, "end --", hb_eol() ) ) + FWrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "--", cProgName, "end --", hb_eol() ) ) FClose( ::nFileHandle ) - ::nFileHandle := -1 + ::nFileHandle := F_ERROR ::lOpened := .F. -RETURN .T. + RETURN .T. METHOD Send( nStyle, cMessage, cProgName, nPriority ) CLASS HB_LogFile LOCAL nCount FWrite( ::nFileHandle, ::Format( nStyle, cMessage, cProgName, nPriority ) + hb_eol() ) - HB_FCommit( ::nFileHandle ); + hb_FCommit( ::nFileHandle ) // see file limit and eventually swap file. IF ::nFileLimit > 0 IF FSeek( ::nFileHandle, 0, FS_RELATIVE ) > ::nFileLimit * 1024 - Fwrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "LogFile: Closing file due to size limit breaking", hb_eol() ) ) + FWrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "LogFile: Closing file due to size limit breaking", hb_eol() ) ) FClose( ::nFileHandle ) IF ::nBackup > 1 - IF hb_FileExists( ::cFileName +"." + Padl( ::nBackup-1, 3,"0" ) ) - FErase( ::cFileName +"." + Padl( ::nBackup-1, 3,"0" ) ) + IF hb_FileExists( ::cFileName + "." + PadL( ::nBackup - 1, 3, "0" ) ) + FErase( ::cFileName + "." + PadL( ::nBackup - 1, 3, "0" ) ) ENDIF - FOR nCount := ::nBackup -1 TO 1 STEP -1 - FRename( ::cFileName +"." + Padl( nCount-1, 3,"0" ), ::cFileName + "." + Padl( nCount, 3,"0" ) ) + FOR nCount := ::nBackup - 1 TO 1 STEP -1 + FRename( ::cFileName + "." + PadL( nCount - 1, 3, "0" ), ::cFileName + "." + PadL( nCount, 3, "0" ) ) NEXT ENDIF IF FRename( ::cFileName, ::cFileName + ".000" ) == 0 ::nFileHandle := hb_FCreate( ::cFileName, FC_NORMAL, FO_READWRITE ) - Fwrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "LogFile: Reopening file due to size limit breaking", hb_eol() ) ) + FWrite( ::nFileHandle, HB_BldLogMsg( HB_LogDateStamp(), Time(), "LogFile: Reopening file due to size limit breaking", hb_eol() ) ) ENDIF ENDIF ENDIF -RETURN Ferror() == 0 + 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 } ; - } + { "PRIORITY", "N", 2, 0 } , ; + { "PROGNAME", "C", 30, 0 } , ; + { "MESSAGE" , "C", 250, 0 } , ; + { "DATE" , "D", 8, 0 } , ; + { "TIME" , "C", 8, 0 } ; + } METHOD New( nLevel, cDBFName, cIndexName, aStruct, cDriver ) METHOD Open( cProgName ) - METHOD Close( cProgName ) + METHOD close( cProgName ) -PROTECTED: + PROTECTED: METHOD Send( nStyle, cMessage, cProgName, nPriority ) ENDCLASS - METHOD New( nLevel, cDBFName, cIndexName, aStruct, cDriver ) CLASS HB_LogDbf + LOCAL cPath, cName, cExt, cDrive ::Super:New( nLevel ) IF HB_ISSTRING( cDBFName ) - HB_FnameSplit( cDBFName, @cPath, @cName, @cExt, @cDrive ) + hb_FNameSplit( cDBFName, @cPath, @cName, @cExt, @cDrive ) IF Empty( cExt ) cExt := "dbf" ENDIF ::cDBFName := iif( !Empty( cDrive ), cDrive + ":\", "" ) + ; - iif( !Empty( cPath ) , cPath + "\", "" ) + ; - cName + cExt + iif( !Empty( cPath ) , cPath + "\", "" ) + ; + cName + cExt //__OutDebug( "::cDBFName", ::cDBFName ) ENDIF IF HB_ISSTRING( cIndexName ) - HB_FnameSplit( cIndexName, @cPath, @cName, @cExt, @cDrive ) + hb_FNameSplit( cIndexName, @cPath, @cName, @cExt, @cDrive ) IF Empty( cExt ) cExt := "cdx" ENDIF ::cIndexName := iif( !Empty( cDrive ), cDrive + ":\", "" ) + ; - iif( !Empty( cPath ) , cPath + "\", "" ) + ; - cName + cExt + iif( !Empty( cPath ) , cPath + "\", "" ) + ; + cName + cExt //__OutDebug( "::cCDXName", ::cCDXName ) ENDIF @@ -641,7 +657,7 @@ METHOD New( nLevel, cDBFName, cIndexName, aStruct, cDriver ) CLASS HB_LogDbf ::cDriver := cDriver ENDIF -RETURN Self + RETURN Self METHOD Open( cProgName ) CLASS HB_LogDbf @@ -651,19 +667,19 @@ METHOD Open( cProgName ) CLASS HB_LogDbf 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) + 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) + 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) +// __OutDebug( "::cDriver, ::cDBFName", ::cDriver, ::cDBFName ) + dbUseArea( .T. , ::cDriver, ::cDBFName, "LogDbf", .T. ) + SET INDEX TO ( ::cIndexName ) LogDbf->( dbAppend() ) LogDbf->priority := HB_LOG_INFO @@ -675,9 +691,9 @@ METHOD Open( cProgName ) CLASS HB_LogDbf ::lOpened := .T. -RETURN .T. + RETURN .T. -METHOD Close( cProgName ) CLASS HB_LogDbf +METHOD close( cProgName ) CLASS HB_LogDbf IF ! ::lOpened RETURN .F. @@ -693,7 +709,7 @@ METHOD Close( cProgName ) CLASS HB_LogDbf ::lOpened := .F. -RETURN .T. + RETURN .T. METHOD Send( nStyle, cMessage, cProgName, nPriority ) CLASS HB_LogDbf @@ -705,8 +721,9 @@ METHOD Send( nStyle, cMessage, cProgName, nPriority ) CLASS HB_LogDbf LogDbf->message := cMessage LogDbf->( dbCommit() ) - (nStyle) -RETURN .T. + HB_SYMBOL_UNUSED( nStyle ) + + RETURN .T. /********************************************** @@ -720,9 +737,9 @@ CLASS HB_LogSyslog FROM HB_LogChannel METHOD New( nLevel, nId ) METHOD Open( cName ) - METHOD Close( cName ) + METHOD close( cName ) -PROTECTED: + PROTECTED: METHOD Send( nType, cMessage, cName, nPriority ) ENDCLASS @@ -732,7 +749,7 @@ METHOD New( nLevel, nId ) CLASS HB_LogSyslog ::Super:New( nLevel ) ::nId := nId -RETURN SELF + RETURN SELF METHOD Open( cName ) CLASS HB_LogSyslog @@ -745,9 +762,9 @@ METHOD Open( cName ) CLASS HB_LogSyslog RETURN .T. ENDIF -RETURN .F. + RETURN .F. -METHOD Close( cName ) CLASS HB_LogSyslog +METHOD close( cName ) CLASS HB_LogSyslog IF ! ::lOpened RETURN .F. @@ -758,26 +775,29 @@ METHOD Close( cName ) CLASS HB_LogSyslog RETURN .T. ENDIF -RETURN .F. + RETURN .F. METHOD Send( nType, cMessage, cName, nPriority ) CLASS HB_LogSyslog HB_SYMBOL_UNUSED( nType ) // Syslog does not need timestamp, nor priority -RETURN HB_SyslogMessage( ::Format( HB_LOG_ST_LEVEL, cMessage, cName, nPriority ), nPriority, ::nId ) + + RETURN HB_SyslogMessage( ::Format( HB_LOG_ST_LEVEL, cMessage, cName, nPriority ), nPriority, ::nId ) /********************************************** * Debug channel ***********************************************/ + CLASS HB_LogDebug FROM HB_LogChannel + DATA nMaxLevel METHOD New( nLevel, nMaxLevel ) // Nothing to do in this version METHOD Open() INLINE .T. - METHOD Close() INLINE .T. -PROTECTED: + METHOD close() INLINE .T. + PROTECTED: METHOD Send( nStyle, cMessage, cName, nPriority ) ENDCLASS @@ -787,7 +807,7 @@ METHOD New( nLevel, nMaxLevel ) CLASS HB_LogDebug ::Super:New( nLevel ) ::nMaxLevel := nMaxLevel -RETURN Self + RETURN Self METHOD PROCEDURE Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogDebug @@ -799,4 +819,4 @@ METHOD PROCEDURE Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogDebug HB_OutDebug( ::Format( nStyle, cMessage, cName, nPriority ) ) -RETURN + RETURN diff --git a/harbour/contrib/xhb/htmutil.prg b/harbour/contrib/xhb/htmutil.prg index 88fcb06c80..69d46c7ec7 100644 --- a/harbour/contrib/xhb/htmutil.prg +++ b/harbour/contrib/xhb/htmutil.prg @@ -111,7 +111,7 @@ FUNCTION PutCounter( oHtm, nNumber, cDir, nDigits, nWidth, bgColor, nBorder ) DEFAULT nNumber TO 0 DEFAULT cDir TO "/images/counters/" DEFAULT nWidth TO 50 - DEFAULT nDigits TO Len( Alltrim( Str( nNumber ) ) ) + DEFAULT nDigits TO Len( hb_ntos( nNumber ) ) DEFAULT nBorder TO 1 DEFAULT BGCOLOR TO "black" diff --git a/harbour/contrib/xhb/thtm.prg b/harbour/contrib/xhb/thtm.prg index 1ef73f09b4..d28470e343 100644 --- a/harbour/contrib/xhb/thtm.prg +++ b/harbour/contrib/xhb/thtm.prg @@ -542,7 +542,7 @@ METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor, lSet ) CLASS THtml ENDIF IF nSize != NIL - cStr += ' SIZE="' + LTrim( Str( nSize ) ) + '"' + cStr += ' SIZE="' + hb_ntos( nSize ) + '"' IF lSet ::fontSize := nSize @@ -608,7 +608,7 @@ METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor, lSet, lPut ) CLA IF lPut IF nSize != NIL - cStr += ' SIZE="' + LTrim( Str( nSize ) ) + '"' + cStr += ' SIZE="' + hb_ntos( nSize ) + '"' IF lSet ::fontSize := nSize @@ -674,7 +674,7 @@ METHOD DefineFont( cFont, cType, nSize, cColor, lSet ) CLASS THtml ENDIF IF nSize != NIL - cStr += ' SIZE="' + LTrim( Str( nSize ) ) + '"' + cStr += ' SIZE="' + hb_ntos( nSize ) + '"' IF lSet ::fontSize := nSize @@ -2288,7 +2288,7 @@ FUNCTION HtmlPadR( cStr, n ) RETURN cRet -//---------------------------------------------------------------------------- +// FUNCTION ANY2STR( xVal ) @@ -2302,7 +2302,7 @@ FUNCTION HTMLANY2STR( xVal ) xRet := iif( Empty( xVal ), ".", xVal ) ELSEIF HB_ISNUMERIC( xVal ) - xRet := AllTrim( Str( xVal ) ) + xRet := hb_ntos( xVal ) ELSEIF HB_ISOBJECT( xVal ) xRet := "<" + xVal:CLASSNAME() + ">" diff --git a/harbour/contrib/xhb/traceprg.prg b/harbour/contrib/xhb/traceprg.prg index 9d2fe8adfb..c1c71cbe43 100644 --- a/harbour/contrib/xhb/traceprg.prg +++ b/harbour/contrib/xhb/traceprg.prg @@ -56,13 +56,14 @@ #define HB_SET_TRACESTACK_CURRENT 1 #define HB_SET_TRACESTACK_ALL 2 -#xtranslate Write( ) => FWrite( FileHandle, ) //;HB_OutDebug( ) +#xtranslate Write( ) => FWrite( FileHandle, ) STATIC s_lSET_TRACE := .T. STATIC s_cSET_TRACEFILE := "trace.log" STATIC s_nSET_TRACESTACK := HB_SET_TRACESTACK_ALL FUNCTION xhb_setTrace( xTrace ) + LOCAL lTrace := s_lSET_TRACE IF HB_ISLOGICAL( xTrace ) @@ -78,6 +79,7 @@ FUNCTION xhb_setTrace( xTrace ) RETURN lTrace FUNCTION xhb_setTraceFile( xFile, lAppend ) + LOCAL cTraceFile := s_cSET_TRACEFILE IF HB_ISSTRING( xFile ) @@ -90,6 +92,7 @@ FUNCTION xhb_setTraceFile( xFile, lAppend ) RETURN cTraceFile FUNCTION xhb_setTraceStack( xLevel ) + LOCAL nTraceLevel := s_nSET_TRACESTACK IF HB_ISSTRING( xLevel ) @@ -116,12 +119,12 @@ FUNCTION TraceLog( ... ) LOCAL cFile, FileHandle, nLevel, ProcName, xParam #ifdef __XHARBOUR__ - IF ! SET( _SET_TRACE ) + IF ! Set( _SET_TRACE ) RETURN .T. ENDIF - cFile := SET( _SET_TRACEFILE ) - nLevel := SET( _SET_TRACESTACK ) + cFile := Set( _SET_TRACEFILE ) + nLevel := Set( _SET_TRACESTACK ) #else IF !s_lSET_TRACE RETURN .T. @@ -144,21 +147,21 @@ FUNCTION TraceLog( ... ) FSeek( FileHandle, 0, FS_END ) IF nLevel > 0 - Write( '[' + ProcFile(1) + "->" + ProcName( 1 ) + '] (' + LTrim( Str( Procline(1) ) ) + ')' ) + Write( "[" + ProcFile( 1 ) + "->" + ProcName( 1 ) + "] (" + hb_ntos( ProcLine( 1 ) ) + ")" ) ENDIF - IF nLevel > 1 .AND. ! ( ProcName( 2 ) == '' ) - Write( ' Called from: ' + hb_eol() ) + IF nLevel > 1 .AND. ! ( ProcName( 2 ) == "" ) + Write( " Called from: " + hb_eol() ) nLevel := 1 - DO WHILE ! ( ( ProcName := ProcName( ++nLevel ) ) == '' ) - Write( space(30) + ProcFile( nLevel ) + "->" + ProcName + '(' + LTrim( Str( Procline( nLevel ) ) ) + ')' + hb_eol() ) + DO WHILE ! ( ( ProcName := ProcName( ++nLevel ) ) == "" ) + Write( Space( 30 ) + ProcFile( nLevel ) + "->" + ProcName + "(" + hb_ntos( ProcLine( nLevel ) ) + ")" + hb_eol() ) ENDDO ELSE Write( hb_eol() ) ENDIF - FOR EACH xParam IN HB_aParams() - Write( 'Type: ' + ValType( xParam ) + ' >>>' + hb_CStr( xParam ) + '<<<' + hb_eol() ) + FOR EACH xParam IN hb_AParams() + Write( "Type: " + ValType( xParam ) + " >>>" + hb_CStr( xParam ) + "<<<" + hb_eol() ) NEXT Write( hb_eol() ) @@ -167,7 +170,7 @@ FUNCTION TraceLog( ... ) RETURN .T. -//--------------------------------------------------------------// +// STATIC FUNCTION cWithPath( cFilename ) /* Ensure cFilename contains path. If it doesn't, add current directory to the front of it */ diff --git a/harbour/contrib/xhb/trpc.prg b/harbour/contrib/xhb/trpc.prg index ee39871db1..f67535830c 100644 --- a/harbour/contrib/xhb/trpc.prg +++ b/harbour/contrib/xhb/trpc.prg @@ -204,6 +204,7 @@ *************************************/ CLASS tRPCFunction + DATA cName DATA aParameters DATA cReturn @@ -215,23 +216,24 @@ CLASS tRPCFunction DATA aCall - CLASSDATA cPattern INIT HB_RegexComp( "^C:[0-9]{1,6}$|^A$|^O$|^D$|^N$|^NI$") + CLASSDATA cPattern INIT hb_regexComp( "^C:[0-9]{1,6}$|^A$|^O$|^D$|^N$|^NI$" ) METHOD New( cFname, cSerial, nAuthLevel, oExec, oMeth ) CONSTRUCTOR METHOD SetCallable( oExec, oMeth ) METHOD CheckTypes( aParams ) METHOD CheckParam( cParam ) METHOD Describe() - METHOD Run( aParams, oClient ) + METHOD RUN( aParams, oClient ) + ENDCLASS - METHOD New( cFname, cSerial, nAuthLevel, oExec, oMeth ) CLASS tRPCFunction + LOCAL cParam LOCAL aParams, aFuncDef - // Analyze the function definition - aFuncDef := HB_Regex( "^([a-zA-Z0-9_-]+)\(([^)]*)\) *(-->)? *(.*)$", cFname ) +// Analyze the function definition + aFuncDef := hb_regex( "^([a-zA-Z0-9_-]+)\(([^)]*)\) *(-->)? *(.*)$", cFname ) IF Empty( aFuncDef ) Alert( "Invalid function defintion" ) ErrorLevel( 1 ) @@ -242,12 +244,12 @@ METHOD New( cFname, cSerial, nAuthLevel, oExec, oMeth ) CLASS tRPCFunction cParam := aFuncDef[3] ::cReturn := iif( Len( aFuncDef ) == 4, aFuncDef[4], aFuncDef[5] ) - // analyze parameter list +// analyze parameter list IF Len( Trim( cParam ) ) > 0 aParams := hb_ATokens( cParam, "," ) ::aParameters := {} FOR EACH cParam IN aParams - cParam := AllTrim( Upper(cParam) ) + cParam := AllTrim( Upper( cParam ) ) ::CheckParam( cParam ) AAdd( ::aParameters, cParam ) NEXT @@ -255,17 +257,17 @@ METHOD New( cFname, cSerial, nAuthLevel, oExec, oMeth ) CLASS tRPCFunction ::aParameters := {} ENDIF - // Analyze function definition return +// Analyze function definition return ::CheckParam( ::cReturn ) - // Analyze function serial number - IF ! HB_RegexMatch( "[0-9]{8}\..", cSerial ) +// Analyze function serial number + IF ! hb_regexMatch( "[0-9]{8}\..", cSerial ) Alert( "Serial value not valid" ) ErrorLevel( 1 ) QUIT ENDIF - // analyze function authorization level +// analyze function authorization level IF nAuthLevel < 1 Alert( "Authorization level must be at least 1" ) ErrorLevel( 1 ) @@ -275,16 +277,16 @@ METHOD New( cFname, cSerial, nAuthLevel, oExec, oMeth ) CLASS tRPCFunction ::cSerial := cSerial ::nAuthLevel := nAuthLevel - // Set now Executable object if given +// Set now Executable object if given IF oExec != NIL ::SetCallable( oExec, oMeth ) ENDIF -RETURN Self - + RETURN Self METHOD SetCallable( oExec, oMeth ) CLASS tRPCFunction - // If the callable is an object, we need to store the method + +// If the callable is an object, we need to store the method IF HB_ISOBJECT( oExec ) ::aCall := Array( Len( ::aParameters ) + 3 ) ::aCall[2] := oMeth @@ -294,9 +296,10 @@ METHOD SetCallable( oExec, oMeth ) CLASS tRPCFunction ::aCall[1] := oExec -RETURN .T. + RETURN .T. + +METHOD RUN( aParams, oClient ) CLASS tRPCFunction -METHOD Run( aParams, oClient ) CLASS tRPCFunction LOCAL nStart, nCount, xRet IF ! ::CheckTypes( aParams ) @@ -312,19 +315,21 @@ METHOD Run( aParams, oClient ) CLASS tRPCFunction ::aCall[ nStart ] := oClient - xRet := HB_ExecFromArray( ::aCall ) -RETURN xRet + xRet := hb_ExecFromArray( ::aCall ) + RETURN xRet METHOD CheckParam( cParam ) CLASS tRPCFunction - IF ! HB_RegexMatch( ::cPattern, cParam ) - Alert("tRPCFunction:CheckParam() wrong parameter specification: " + cParam ) + + IF ! hb_regexMatch( ::cPattern, cParam ) + Alert( "tRPCFunction:CheckParam() wrong parameter specification: " + cParam ) QUIT ENDIF -RETURN .T. + RETURN .T. METHOD CheckTypes( aParams ) CLASS tRPCFunction + LOCAL oElem, i := 0 IF ! HB_ISARRAY( aParams ) @@ -341,15 +346,16 @@ METHOD CheckTypes( aParams ) CLASS tRPCFunction RETURN .F. ENDIF NEXT -RETURN .T. + RETURN .T. METHOD Describe() CLASS tRPCFunction + LOCAL cRet := ::cName + "(" LOCAL nCount IF Len( ::aParameters ) > 0 - FOR nCount := 1 TO Len( ::aParameters ) -1 + FOR nCount := 1 TO Len( ::aParameters ) - 1 cRet += ::aParameters[nCount] + "," NEXT cRet += ::aParameters[ -1 ] @@ -357,7 +363,7 @@ METHOD Describe() CLASS tRPCFunction cRet += ")-->" + ::cReturn -RETURN cRet+"/" + ::cSerial + RETURN cRet + "/" + ::cSerial /*********************************************************** @@ -365,6 +371,7 @@ RETURN cRet+"/" + ::cSerial ************************************************************/ CLASS tRPCServeCon + /* back reference to the parent to get callback blocks */ DATA oServer @@ -388,14 +395,14 @@ CLASS tRPCServeCon /* Managing async */ METHOD Start() METHOD Stop() - METHOD Run() + METHOD RUN() /* Utilty */ METHOD SendProgress( nProgress, oData ) METHOD IsCanceled() INLINE ::lCanceled METHOD GetStatus() INLINE ::nStatus -HIDDEN: + HIDDEN: /* Current status */ DATA nStatus INIT RPCS_STATUS_NONE /* Is this connection encrypted? */ @@ -421,74 +428,76 @@ HIDDEN: METHOD FunctionRunner( cFuncName, oFunc, nMode, aParams, aDesc ) METHOD SendResult( oRet, cFuncName ) - METHOD Encrypt(cDataIn) - METHOD Decrypt(cDataIn) + METHOD Encrypt( cDataIn ) + METHOD Decrypt( cDataIn ) ENDCLASS - METHOD New( oParent, skIn ) CLASS tRPCServeCon + ::oServer := oParent ::skRemote := skIn - ::mtxBusy := HB_MutexCreate() + ::mtxBusy := hb_mutexCreate() ::bEncrypted := .F. ::nAuthLevel := 0 - ::nChallengeCRC := -1 -RETURN Self + ::nChallengeCRC := - 1 + RETURN Self METHOD Destroy() CLASS tRPCServeCon - HB_MutexLock( ::mtxBusy ) - // Eventually wait for the function to terminate + + hb_mutexLock( ::mtxBusy ) +// Eventually wait for the function to terminate IF ::thFunction != NIL ::lCanceled := .T. - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) hb_threadJoin( ::thFunction ) - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ENDIF ::skRemote := NIL - HB_MutexUnlock( ::mtxBusy ) -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD Start() CLASS tRPCServeCon + LOCAL lRet := .F. - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) IF ::thSelf == NIL ::thSelf := StartThread( Self, "RUN" ) lRet := .T. ENDIF - HB_MutexUnlock( ::mtxBusy ) - -RETURN lRet + hb_mutexUnlock( ::mtxBusy ) + RETURN lRet METHOD Stop() CLASS tRPCServeCon + LOCAL lRet := .F. - HB_MutexLock( ::mtxBusy ) - IF hb_threadId( ::thSelf ) != 0 + hb_mutexLock( ::mtxBusy ) + IF hb_threadID( ::thSelf ) != 0 hb_threadQuitRequest( ::thSelf ) lRet := .T. - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) hb_threadJoin( ::thSelf ) ::thSelf := NIL ELSE - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ENDIF -RETURN lRet + RETURN lRet +METHOD RUN() CLASS tRPCServeCon -METHOD Run() CLASS tRPCServeCon LOCAL cCode := Space( 6 ) LOCAL lBreak := .F. LOCAL aData LOCAL nSafeStatus - DO WHILE hb_inetErrorCode( ::skRemote ) == 0 .and. ! lBreak + DO WHILE hb_inetErrorCode( ::skRemote ) == 0 .AND. ! lBreak /* Get the request code */ hb_inetRecvAll( ::skRemote, @cCode, 6 ) @@ -496,196 +505,197 @@ METHOD Run() CLASS tRPCServeCon EXIT ENDIF - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) nSafeStatus := ::nStatus - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) DO CASE /* Check for TCP server scan */ - CASE cCode == "XHBR00" - hb_inetSendAll( ::skRemote, ; - "XHBR10"+ HB_Serialize( ::oServer:cServerName ) ) + CASE cCode == "XHBR00" + hb_inetSendAll( ::skRemote, ; + "XHBR10" + hb_Serialize( ::oServer:cServerName ) ) /* Read autorization request */ - CASE cCode == "XHBR90" - IF nSafeStatus == RPCS_STATUS_NONE - lBreak := ! ::RecvAuth( .F. ) - IF ! lBreak - nSafeStatus := RPCS_STATUS_LOGGED - ENDIF - ELSE - nSafeStatus := RPCS_STATUS_ERROR + CASE cCode == "XHBR90" + IF nSafeStatus == RPCS_STATUS_NONE + lBreak := ! ::RecvAuth( .F. ) + IF ! lBreak + nSafeStatus := RPCS_STATUS_LOGGED ENDIF + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Read encrypted autorization request */ - CASE cCode == "XHBR93" - IF nSafeStatus == RPCS_STATUS_NONE - lBreak := ! ::RecvAuth( .T. ) - IF ! lBreak - nSafeStatus := RPCS_STATUS_CHALLENGE - ENDIF - ELSE - nSafeStatus := RPCS_STATUS_ERROR + CASE cCode == "XHBR93" + IF nSafeStatus == RPCS_STATUS_NONE + lBreak := ! ::RecvAuth( .T. ) + IF ! lBreak + nSafeStatus := RPCS_STATUS_CHALLENGE ENDIF + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Challeng reply */ - CASE cCode == "XHBR95" - IF nSafeStatus == RPCS_STATUS_CHALLENGE - lBreak := ! ::RecvChallenge( ) - IF ! lBreak - nSafeStatus := RPCS_STATUS_LOGGED - ENDIF - ELSE - nSafeStatus := RPCS_STATUS_ERROR + CASE cCode == "XHBR95" + IF nSafeStatus == RPCS_STATUS_CHALLENGE + lBreak := ! ::RecvChallenge( ) + IF ! lBreak + nSafeStatus := RPCS_STATUS_LOGGED ENDIF + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Close connection */ - CASE cCode == "XHBR92" - ::oServer:OnClientLogout( Self ) - lBreak := .T. + CASE cCode == "XHBR92" + ::oServer:OnClientLogout( Self ) + lBreak := .T. /* Execute function */ - CASE cCode == "XHBR20" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .F., .F. ) - IF aData != NIL - lBreak := ! ::FuncCall( aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR20" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .F. , .F. ) + IF aData != NIL + lBreak := ! ::FuncCall( aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Execute function */ - CASE cCode == "XHBR21" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .T., .F. ) - IF aData != NIL - lBreak := ! ::FuncCall( aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR21" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .T. , .F. ) + IF aData != NIL + lBreak := ! ::FuncCall( aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Loop function */ - CASE cCode == "XHBR22" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .F., .T. ) - IF aData != NIL - lBreak := ! ::FuncLoopCall( aData[1], aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR22" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .F. , .T. ) + IF aData != NIL + lBreak := ! ::FuncLoopCall( aData[1], aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Loop function - compressed */ - CASE cCode == "XHBR23" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .T., .T. ) - IF aData != NIL - lBreak := ! ::FuncLoopCall( aData[1], aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR23" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .T. , .T. ) + IF aData != NIL + lBreak := ! ::FuncLoopCall( aData[1], aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Foreach function */ - CASE cCode == "XHBR24" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .F., .T. ) - IF aData != NIL - lBreak := ! ::FuncForeachCall( aData[1], aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR24" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .F. , .T. ) + IF aData != NIL + lBreak := ! ::FuncForeachCall( aData[1], aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Foreach function - compressed*/ - CASE cCode == "XHBR25" - IF nSafeStatus == RPCS_STATUS_LOGGED - aData := ::RecvFunction( .T., .T. ) - IF aData != NIL - lBreak := ! ::FuncForeachCall( aData[1], aData[2] ) - ELSE - lBreak := .T. - ENDIF - ELSEIF nSafeStatus == RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_BUSY + CASE cCode == "XHBR25" + IF nSafeStatus == RPCS_STATUS_LOGGED + aData := ::RecvFunction( .T. , .T. ) + IF aData != NIL + lBreak := ! ::FuncForeachCall( aData[1], aData[2] ) ELSE - nSafeStatus := RPCS_STATUS_ERROR + lBreak := .T. ENDIF + ELSEIF nSafeStatus == RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_BUSY + ELSE + nSafeStatus := RPCS_STATUS_ERROR + ENDIF /* Function execution cancelation request */ - CASE cCode == "XHBR29" + CASE cCode == "XHBR29" /* Note: even if the function is already terminated in the meanwhile, and the -real- status is not RUNNING anymore, there is no problem here. The cancelation request will be reset at next function call, and the caller must ignore any pending data before the "cancel" call */ - IF nSafeStatus != RPCS_STATUS_RUNNING - nSafeStatus := RPCS_STATUS_ERROR - ELSE - HB_MutexLock( ::mtxBusy ) - ::lCanceled := .T. - HB_MutexUnlock( ::mtxBusy ) - hb_inetSendAll( ::skRemote, "XHBR34") - ENDIF + IF nSafeStatus != RPCS_STATUS_RUNNING + nSafeStatus := RPCS_STATUS_ERROR + ELSE + hb_mutexLock( ::mtxBusy ) + ::lCanceled := .T. + hb_mutexUnlock( ::mtxBusy ) + hb_inetSendAll( ::skRemote, "XHBR34" ) + ENDIF - OTHERWISE - lBreak := .T. + OTHERWISE + lBreak := .T. ENDCASE /* Analisys of the nSafeStatus code */ DO CASE - CASE nSafeStatus == RPCS_STATUS_BUSY - hb_inetSendAll( ::skRemote, "XHBR4011" ) + CASE nSafeStatus == RPCS_STATUS_BUSY + hb_inetSendAll( ::skRemote, "XHBR4011" ) - CASE nSafeStatus == RPCS_STATUS_ERROR - hb_inetSendAll( ::skRemote, "XHBR4020" ) + CASE nSafeStatus == RPCS_STATUS_ERROR + hb_inetSendAll( ::skRemote, "XHBR4020" ) /* Update real status only if not in error case */ - OTHERWISE + OTHERWISE /* The running status is set (in this thread) indipendently by the function launcher, if everything is fine */ - HB_MutexLock( ::mtxBusy ) - IF ::nStatus != RPCS_STATUS_RUNNING - ::nStatus := nSafeStatus - ENDIF - HB_MutexUnlock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) + IF ::nStatus != RPCS_STATUS_RUNNING + ::nStatus := nSafeStatus + ENDIF + hb_mutexUnlock( ::mtxBusy ) ENDCASE ENDDO - // signaling termination of this thread +// signaling termination of this thread ::oServer:Terminating( Self ) - // Destroy resources just before termination +// Destroy resources just before termination ::Destroy() -RETURN .T. + RETURN .T. METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon - LOCAL cLength := Space(8), nLen, nPos + + LOCAL cLength := Space( 8 ), nLen, nPos LOCAL cUserID, cPassword LOCAL cReadIn @@ -695,7 +705,7 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon nLen := HB_GetLen8( cLength ) - IF (lEncrypt .and. nLen > 128 ) .or. ( ! lEncrypt .and. nLen > 37 ) + IF ( lEncrypt .AND. nLen > 128 ) .OR. ( ! lEncrypt .AND. nLen > 37 ) RETURN .F. ENDIF @@ -709,8 +719,8 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon RETURN .F. ENDIF - cUserID := Substr(cReadin, 1, nPos-1 ) - cPassword := Substr( cReadin, nPos+1 ) + cUserID := SubStr( cReadin, 1, nPos - 1 ) + cPassword := SubStr( cReadin, nPos + 1 ) IF ! lEncrypt ::nAuthLevel := ::oServer:Authorize( cUserid, cPassword ) @@ -728,10 +738,10 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon RETURN .T. ENDIF -RETURN ::LaunchChallenge( cUserid, cPassword ) - + RETURN ::LaunchChallenge( cUserid, cPassword ) METHOD LaunchChallenge( cUserid, cPassword ) CLASS tRPCServeCon + LOCAL cChallenge, nCount ::cCryptKey := ::oServer:AuthorizeChallenge( cUserid, cPassword ) @@ -785,11 +795,11 @@ METHOD RecvChallenge() CLASS tRPCServeCon ::bEncrypted := .T. ::oServer:OnClientLogin( Self ) -RETURN .T. - + RETURN .T. METHOD RecvFunction( bComp, bMode ) CLASS tRPCServeCon - LOCAL cLength := Space(8), nLen, nComp + + LOCAL cLength := Space( 8 ), nLen, nComp LOCAL cMode := " " LOCAL cData @@ -837,10 +847,10 @@ METHOD RecvFunction( bComp, bMode ) CLASS tRPCServeCon cData := HB_Uncompress( nLen, cData ) ENDIF -RETURN { cMode, cData } - + RETURN { cMode, cData } METHOD FuncCall( cData ) CLASS tRPCServeCon + LOCAL cSer, cFuncName, aParams /* Deserialize all elements */ @@ -856,10 +866,11 @@ METHOD FuncCall( cData ) CLASS tRPCServeCon ENDIF ::oServer:OnClientRequest( Self, 20, { cFuncName, aParams } ) -RETURN ::LaunchFunction( cFuncName, aParams, 0 ) + RETURN ::LaunchFunction( cFuncName, aParams, 0 ) METHOD FuncLoopCall( cMode, cData ) CLASS tRPCServeCon + LOCAL nBegin, nEnd, nStep LOCAL cSer LOCAL cFuncName, aParams @@ -880,10 +891,11 @@ METHOD FuncLoopCall( cMode, cData ) CLASS tRPCServeCon ENDIF ::oServer:OnClientRequest( Self, 22, { cFuncName, aParams, cMode, nBegin, nEnd, nStep } ) -RETURN ::LaunchFunction( cFuncName, aParams, 1, { cMode, nBegin, nEnd, nStep } ) + RETURN ::LaunchFunction( cFuncName, aParams, 1, { cMode, nBegin, nEnd, nStep } ) METHOD FuncForeachCall( cMode, cData ) CLASS tRPCServeCon + LOCAL cSer LOCAL cFuncName, aParams LOCAL aItems @@ -903,22 +915,23 @@ METHOD FuncForeachCall( cMode, cData ) CLASS tRPCServeCon ENDIF ::oServer:OnClientRequest( Self, 24, { cFuncName, aParams, aItems } ) -RETURN ::LaunchFunction( cFuncName, aParams, 2, { cMode, aItems } ) + RETURN ::LaunchFunction( cFuncName, aParams, 2, { cMode, aItems } ) METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon + LOCAL oFunc - //Check for function existance +//Check for function existance oFunc := ::oServer:Find( cFuncName ) - IF Empty(oFunc) + IF Empty( oFunc ) // signal error ::oServer:OnFunctionError( Self, cFuncName, 00 ) hb_inetSendAll( ::skRemote, "XHBR4000" ) RETURN .T. ENDIF - // check for level +// check for level IF oFunc:nAuthLevel > ::nAuthLevel // signal error ::oServer:OnFunctionError( Self, cFuncName, 01 ) @@ -926,177 +939,178 @@ METHOD LaunchFunction( cFuncName, aParams, nMode, aDesc ) CLASS tRPCServeCon RETURN .T. ENDIF - //check for parameters - IF aParams == NIL .or. ! oFunc:CheckTypes( aParams ) +//check for parameters + IF aParams == NIL .OR. ! oFunc:CheckTypes( aParams ) // signal error - ::oServer:OnFunctionError( Self, cFuncName,02 ) + ::oServer:OnFunctionError( Self, cFuncName, 02 ) hb_inetSendAll( ::skRemote, "XHBR4002" ) RETURN .T. ENDIF - HB_MutexLock( ::mtxBusy ) - // allow progress indicator by default + hb_mutexLock( ::mtxBusy ) +// allow progress indicator by default ::lAllowProgress := .T. - // setting the cancel indicator as false +// setting the cancel indicator as false ::lCanceled := .F. - // Set the running status +// Set the running status ::nStatus := RPCS_STATUS_RUNNING ::thFunction := StartThread( Self, "FunctionRunner", ; cFuncName, oFunc, nMode, aParams, aDesc ) - HB_MutexUnlock( ::mtxBusy ) - -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD FunctionRunner( cFuncName, oFunc, nMode, aParams, aDesc ) CLASS tRPCServeCon + LOCAL nCount LOCAL oRet, oElem, aRet LOCAL aSubst, nSubstPos - //? "TH:", ::thFunction +//? "TH:", ::thFunction DO CASE - CASE nMode == 0 // just run the function - oRet := oFunc:Run( aParams, Self ) - // Notice: SendResult checks for lCanceled before really sending + CASE nMode == 0 // just run the function + oRet := oFunc:Run( aParams, Self ) + // Notice: SendResult checks for lCanceled before really sending - CASE nMode == 1 // run in loop - aSubst := AClone( aParams ) - nSubstPos := AScan( aParams, {| x | HB_ISSTRING( x ) .and. x == "$."} ) + CASE nMode == 1 // run in loop + aSubst := AClone( aParams ) + nSubstPos := AScan( aParams, {| x | HB_ISSTRING( x ) .AND. x == "$." } ) - SWITCH aDesc[1] - CASE 'A' // all results - FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := nCount - ENDIF - oRet := oFunc:Run( aSubst, Self ) - ::SendResult( oRet, cFuncName ) - NEXT - oRet := "Done" - EXIT + SWITCH aDesc[ 1 ] + CASE 'A' // all results + FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := nCount + ENDIF + oRet := oFunc:Run( aSubst, Self ) + ::SendResult( oRet, cFuncName ) + NEXT + oRet := "Done" + EXIT - CASE 'C' // Vector of all results - aRet := {} - ::lAllowProgress := .F. - FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := nCount - ENDIF - oRet := oFunc:Run( aSubst, Self ) - IF oRet == NIL - ::SendResult( NIL, cFuncName ) - EXIT - ENDIF - AAdd( aRet, oRet ) - NEXT - IF oRet != NIL - oRet := aRet - ENDIF - EXIT + CASE 'C' // Vector of all results + aRet := {} + ::lAllowProgress := .F. + FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := nCount + ENDIF + oRet := oFunc:Run( aSubst, Self ) + IF oRet == NIL + ::SendResult( NIL, cFuncName ) + EXIT + ENDIF + AAdd( aRet, oRet ) + NEXT + IF oRet != NIL + oRet := aRet + ENDIF + EXIT - CASE 'E' // Just send confirmation at end - ::lAllowProgress := .F. - FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := nCount - ENDIF - oRet := oFunc:Run( aSubst, Self ) - IF oRet == NIL - ::SendResult( NIL, cFuncName ) - EXIT - ENDIF - NEXT - IF oRet != NIL - oRet := "Done" - ENDIF - EXIT - END + CASE 'E' // Just send confirmation at end + ::lAllowProgress := .F. + FOR nCount := aDesc[ 2 ] TO aDesc[ 3 ] STEP aDesc[ 4 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := nCount + ENDIF + oRet := oFunc:Run( aSubst, Self ) + IF oRet == NIL + ::SendResult( NIL, cFuncName ) + EXIT + ENDIF + NEXT + IF oRet != NIL + oRet := "Done" + ENDIF + EXIT + ENDSWITCH - CASE nMode == 2 // Run in a foreach loop - aSubst := AClone( aParams ) - nSubstPos := AScan( aParams, {| x | HB_ISSTRING( x ) .and. x == "$."} ) + CASE nMode == 2 // Run in a foreach loop + aSubst := AClone( aParams ) + nSubstPos := AScan( aParams, {| x | HB_ISSTRING( x ) .AND. x == "$." } ) - SWITCH aDesc[1] - CASE 'A' // all results - FOR EACH oElem IN aDesc[ 2 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := oElem - ENDIF - oRet := oFunc:Run( aSubst, Self ) - ::SendResult( oRet, cFuncName ) - NEXT - oRet := "Done" - EXIT + SWITCH aDesc[ 1 ] + CASE 'A' // all results + FOR EACH oElem IN aDesc[ 2 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := oElem + ENDIF + oRet := oFunc:Run( aSubst, Self ) + ::SendResult( oRet, cFuncName ) + NEXT + oRet := "Done" + EXIT - CASE 'C' // Vector of all results - aRet := {} - ::lAllowProgress := .F. - FOR EACH oElem IN aDesc[ 2 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := oElem - ENDIF - oRet := oFunc:Run( aSubst, Self ) - IF oRet == NIL - ::SendResult( NIL, cFuncName ) - EXIT - ENDIF - AAdd( aRet, oRet ) - NEXT - IF oRet != NIL - oRet := aRet - ENDIF - EXIT + CASE 'C' // Vector of all results + aRet := {} + ::lAllowProgress := .F. + FOR EACH oElem IN aDesc[ 2 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := oElem + ENDIF + oRet := oFunc:Run( aSubst, Self ) + IF oRet == NIL + ::SendResult( NIL, cFuncName ) + EXIT + ENDIF + AAdd( aRet, oRet ) + NEXT + IF oRet != NIL + oRet := aRet + ENDIF + EXIT - CASE 'E' // Just send confirmation at end - ::lAllowProgress := .F. - FOR EACH oElem IN aDesc[ 2 ] - IF nSubstPos > 0 - aSubst[ nSubstPos ] := oElem - ENDIF - oRet := oFunc:Run( aSubst, Self ) - IF oRet == NIL - EXIT - ENDIF - NEXT - EXIT - END + CASE 'E' // Just send confirmation at end + ::lAllowProgress := .F. + FOR EACH oElem IN aDesc[ 2 ] + IF nSubstPos > 0 + aSubst[ nSubstPos ] := oElem + ENDIF + oRet := oFunc:Run( aSubst, Self ) + IF oRet == NIL + EXIT + ENDIF + NEXT + EXIT + ENDSWITCH ENDCASE - // Now we can signal that execution terminated - HB_MutexLock( ::mtxBusy ) +// Now we can signal that execution terminated + hb_mutexLock( ::mtxBusy ) ::nStatus := RPCS_STATUS_LOGGED - HB_MutexUnlock( ::mtxBusy ) - // The execution of the function terminates BEFORE the sending of - // the last data or the confirmation data, even if the thread - // has still something to do. + hb_mutexUnlock( ::mtxBusy ) +// The execution of the function terminates BEFORE the sending of +// the last data or the confirmation data, even if the thread +// has still something to do. ::SendResult( oRet, cFuncName ) - //Signal that the thread is no longer alive - // Should not be needed! +//Signal that the thread is no longer alive +// Should not be needed! /*HB_MutexLock( ::mtxBusy ) ::thFunction := -1 HB_MutexUnlock( ::mtxBusy )*/ -RETURN .T. + RETURN .T. METHOD SendResult( oRet, cFuncName ) + LOCAL cData, cOrigLen, cCompLen - // Ignore requests to send result if function is canceled - HB_MutexLock( ::mtxBusy ) +// Ignore requests to send result if function is canceled + hb_mutexLock( ::mtxBusy ) IF ::lCanceled - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ::oServer:OnFunctionCanceled( Self, cFuncName ) RETURN .T. //as if it were done ENDIF - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) IF oRet == NIL ::oServer:OnFunctionError( Self, cFuncName, 10 ) hb_inetSendAll( ::skRemote, "XHBR4010" ) ELSE - cData := HB_Serialize( oRet ) + cData := hb_Serialize( oRet ) cOrigLen := HB_CreateLen8( Len( cData ) ) ::oServer:OnFunctionReturn( Self, cData ) // should we compress it ? @@ -1114,36 +1128,36 @@ METHOD SendResult( oRet, cFuncName ) RETURN .F. ENDIF -RETURN .T. - + RETURN .T. METHOD SendProgress( nProgress, oData ) CLASS tRPCServeCon + LOCAL cOrigLen, cCompLen, lRet := .T. LOCAL cData - //Ignore if told so - HB_MutexLock( ::mtxBusy ) - IF ! ::lAllowProgress .or. ::lCanceled - HB_MutexUnlock( ::mtxBusy ) +//Ignore if told so + hb_mutexLock( ::mtxBusy ) + IF ! ::lAllowProgress .OR. ::lCanceled + hb_mutexUnlock( ::mtxBusy ) RETURN .T. ENDIF - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ::oServer:OnFunctionProgress( Self, nProgress, oData ) IF Empty( oData ) - hb_inetSendAll( ::skRemote, "XHBR33" + HB_Serialize( nProgress ) ) + hb_inetSendAll( ::skRemote, "XHBR33" + hb_Serialize( nProgress ) ) ELSE - cData := HB_Serialize( oData ) + cData := hb_Serialize( oData ) cOrigLen := HB_CreateLen8( Len( cData ) ) // do we should compress it ? IF Len( cData ) > 512 cData := HB_Compress( cData ) cCompLen := HB_CreateLen8( Len( cData ) ) - hb_inetSendAll(::skRemote, "XHBR35" + HB_Serialize( nProgress ) +; - cOrigLen + cCompLen + ::Encrypt( cData ) ) + hb_inetSendAll( ::skRemote, "XHBR35" + hb_Serialize( nProgress ) + ; + cOrigLen + cCompLen + ::Encrypt( cData ) ) ELSE - hb_inetSendAll( ::skRemote, "XHBR34" + HB_Serialize( nProgress ) +; - cOrigLen + ::Encrypt( cData ) ) + hb_inetSendAll( ::skRemote, "XHBR34" + hb_Serialize( nProgress ) + ; + cOrigLen + ::Encrypt( cData ) ) ENDIF ENDIF @@ -1151,27 +1165,30 @@ METHOD SendProgress( nProgress, oData ) CLASS tRPCServeCon lRet := .F. ENDIF -RETURN lRet + RETURN lRet +METHOD Encrypt( cDataIn ) CLASS tRPCServeCon -METHOD Encrypt(cDataIn) CLASS tRPCServeCon IF ::bEncrypted RETURN HB_Crypt( cDataIn, ::cCryptKey ) ENDIF -RETURN cDataIn + RETURN cDataIn + +METHOD Decrypt( cDataIn ) CLASS tRPCServeCon -METHOD Decrypt(cDataIn) CLASS tRPCServeCon IF ::bEncrypted RETURN HB_Decrypt( cDataIn, ::cCryptKey ) ENDIF -RETURN cDataIn + + RETURN cDataIn /************************************ * RPC SERVICE *************************************/ CLASS tRPCService + DATA cServerName INIT "RPCGenericServer" DATA aFunctions CLASSDATA lInit INIT hb_inetInit() @@ -1182,7 +1199,7 @@ CLASS tRPCService DATA thAccept INIT 0 DATA thUdp INIT 0 DATA aServing INIT {} - DATA mtxBusy INIT HB_MutexCreate() + DATA mtxBusy INIT hb_mutexCreate() DATA skUdp DATA skServer @@ -1209,7 +1226,7 @@ CLASS tRPCService /* Function management */ METHOD Add( xFunction, cVersion, nLevel, oExec, oMethod ) - METHOD Run( cName, aParams ) + METHOD RUN( cName, aParams ) METHOD Describe( cName ) METHOD Find( cName ) METHOD Remove( cName ) @@ -1221,7 +1238,7 @@ CLASS tRPCService METHOD Terminating( oConnection ) /* Tcp services */ - METHOD Accept() + METHOD ACCEPT() /* UDP services */ METHOD UdpListen() @@ -1249,13 +1266,14 @@ CLASS tRPCService ENDCLASS +METHOD New() CLASS tRPCService -METHOD New() class tRPCService ::aFunctions := {} -RETURN Self + RETURN Self METHOD Add( xFunction, cVersion, nLevel, oExec, oMethod ) + LOCAL nElem, lRet := .F. LOCAL oFunction @@ -1265,69 +1283,71 @@ METHOD Add( xFunction, cVersion, nLevel, oExec, oMethod ) oFunction := xFunction ENDIF - HB_MutexLock( ::mtxBusy ) - nElem := AScan( ::aFunctions, {| x | oFunction:cName == x:cName}) + hb_mutexLock( ::mtxBusy ) + nElem := AScan( ::aFunctions, {| x | oFunction:cName == x:cName } ) IF nElem == 0 - Aadd( ::aFunctions , oFunction ) + AAdd( ::aFunctions , oFunction ) lRet := .T. ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN lRet + hb_mutexUnlock( ::mtxBusy ) + RETURN lRet + +METHOD Find( cName ) CLASS tRPCService -METHOD Find( cName ) class tRPCService LOCAL nElem LOCAL oRet := NIL - HB_MutexLock( ::mtxBusy ) - nElem := AScan( ::aFunctions, {| x | upper(cName) == upper(x:cName)}) + hb_mutexLock( ::mtxBusy ) + nElem := AScan( ::aFunctions, {| x | Upper( cName ) == Upper( x:cName ) } ) IF nElem != 0 oRet := ::aFunctions[ nElem ] ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN oRet + hb_mutexUnlock( ::mtxBusy ) + RETURN oRet + +METHOD Remove( cName ) CLASS tRPCService -METHOD Remove( cName ) class tRPCService LOCAL nElem LOCAL lRet := .F. - HB_MutexLock( ::mtxBusy ) - nElem := AScan( ::aFunctions, {| x | cName == x:cName}) + hb_mutexLock( ::mtxBusy ) + nElem := AScan( ::aFunctions, {| x | cName == x:cName } ) IF nElem != 0 ADel( ::aFunctions, nElem ) ASize( ::aFunctions, Len( ::aFunctions ) - 1 ) lRet := .T. ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN lRet + hb_mutexUnlock( ::mtxBusy ) + RETURN lRet + +METHOD RUN( cName, aParams ) CLASS tRPCService -METHOD Run( cName, aParams ) class tRPCService LOCAL oFunc := ::Find( cName ) LOCAL oRet := NIL - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) IF ! Empty( oFunc ) oRet := oFunc:Run( aParams ) ENDIF - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) -RETURN oRet + RETURN oRet +METHOD Describe( cName ) CLASS tRPCService -METHOD Describe( cName ) class tRPCService LOCAL oFunc := ::Find( cName ) LOCAL cRet := NIL - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) IF ! Empty( oFunc ) cRet := oFunc:Describe() ENDIF - HB_MutexUnlock( ::mtxBusy ) - -RETURN cRet + hb_mutexUnlock( ::mtxBusy ) + RETURN cRet METHOD Start( lStartUdp ) CLASS tRPCService @@ -1341,100 +1361,106 @@ METHOD Start( lStartUdp ) CLASS tRPCService ::thAccept := StartThread( Self, "Accept" ) - IF lStartUdp != NIL .and. lStartUdp + IF lStartUdp != NIL .AND. lStartUdp ::thUdp := StartThread( Self, "UdpListen" ) ELSE ::thUdp := NIL ENDIF -RETURN .T. - + RETURN .T. METHOD Stop() CLASS tRPCService + LOCAL oElem - HB_MutexLock( ::mtxBusy ) - IF hb_threadId( ::thAccept ) == 0 - HB_MutexUnlock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) + IF hb_threadID( ::thAccept ) == 0 + hb_mutexUnlock( ::mtxBusy ) RETURN .F. ENDIF hb_inetClose( ::skServer ) - // closing the socket will make their infinite loops to terminate. +// closing the socket will make their infinite loops to terminate. hb_threadQuitRequest( ::thAccept ) hb_threadJoin( ::thAccept ) - IF hb_threadId( ::thUDP ) != 0 + IF hb_threadID( ::thUDP ) != 0 hb_inetClose( ::skUdp ) hb_threadQuitRequest( ::thUdp ) hb_threadJoin( ::thUdp ) ENDIF FOR EACH oElem IN ::aServing - IF hb_threadId( oElem:thSelf ) != 0 + IF hb_threadID( oElem:thSelf ) != 0 hb_threadQuitRequest( oElem:thSelf ) hb_threadJoin( oElem:thSelf ) ENDIF NEXT ASize( ::aServing, 0 ) - // now destroy all the allocated resources +// now destroy all the allocated resources ::skServer := NIL ::skUdp := NIL - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) -RETURN .T. + RETURN .T. +METHOD ACCEPT() CLASS tRPCService -METHOD Accept() CLASS tRPCService LOCAL skIn DO WHILE .T. skIn := hb_inetAccept( ::skServer ) // todo: better sync - IF hb_inetStatus( ::skServer ) < 0 + IF hb_inetstatus( ::skServer ) < 0 EXIT ENDIF IF skIn != NIL ::StartService( skIn ) ENDIF ENDDO -RETURN .T. + RETURN .T. METHOD StartService( skIn ) CLASS tRPCService + LOCAL oService - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) oService := tRpcServeCon():New( Self, skIn ) AAdd( ::aServing, oService ) oService:Start() - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ::OnClientConnect( oService ) -RETURN .T. + + RETURN .T. METHOD UDPListen( ) CLASS tRPCService + LOCAL cData := Space( 1000 ) LOCAL nPacketLen DO WHILE .T. nPacketLen := hb_inetDGramRecv( ::skUdp, @cData, 1000 ) - IF hb_inetStatus( ::skUdp ) < 0 + IF hb_inetstatus( ::skUdp ) < 0 EXIT ENDIF ::UDPParseRequest( cData, nPacketLen ) ENDDO -RETURN .T. + + RETURN .T. METHOD UDPParseRequest( cData, nPacketLen ) CLASS tRPCService + LOCAL cToSend IF ::UDPInterpretRequest( cData, nPacketLen, @cToSend ) - hb_inetDGramSend( ::skUdp, ; + hb_inetDGramSend( ::skUdp, ; hb_inetAddress( ::skUdp ), hb_inetPort( ::skUdp ), cToSend ) - RETURN .T. + RETURN .T. ENDIF -RETURN .F. + + RETURN .F. METHOD UDPInterpretRequest( cData, nPacketLen, cRes ) CLASS tRPCService LOCAL cCode, cMatch, cNumber, cSerial @@ -1447,76 +1473,75 @@ METHOD UDPInterpretRequest( cData, nPacketLen, cRes ) CLASS tRPCService cCode := Substr( cData, 1, 6 ) DO CASE - - /* XHRB00 - server scan */ - CASE cCode == "XHBR00" - IF ! ::OnServerScan() - RETURN .F. - ENDIF - IF nPacketLen > 6 - cMatch := HB_Deserialize( Substr( cData, 7 ) ) - IF HB_RegexMatch( cMatch, ::cServerName ) - cRes := "XHBR10"+ HB_Serialize( ::cServerName ) - ENDIF - ELSE - cRes := "XHBR10"+ HB_Serialize( ::cServerName ) - ENDIF - RETURN .T. - - /* XRB01 - Function scan */ - CASE cCode == "XHBR01" - IF ! ::OnFunctionScan() - RETURN .F. - ENDIF - /* minimal length to be valid */ - IF nPacketLen > 24 - cSerial := HB_DeserialBegin( Substr( cData, 7 ) ) - cMatch := HB_DeserialNext( @cSerial ) - cNumber := NIL - IF ! Empty ( cMatch ) - cMatch := HB_RegexComp( cMatch ) - cNumber := HB_DeserialNext( @cSerial ) - ELSE - cMatch := HB_RegexComp( ".*" ) - ENDIF - - IF Empty( cNumber ) - cNumber := "00000000.0" - ENDIF - - FOR EACH oFunc IN ::aFunctions - IF HB_RegexMatch( cMatch, oFunc:cName ) .and. cNumber <= oFunc:cSerial - cRes := "XHBR11" + HB_Serialize(::cServerName ) + ; - HB_Serialize( ofunc:Describe()) - RETURN .T. - ENDIF - NEXT - ENDIF - - /* If we don't have the function, we cannot reply */ + /* XHRB00 - server scan */ + CASE cCode == "XHBR00" + IF ! ::OnServerScan() RETURN .F. + ENDIF + IF nPacketLen > 6 + cMatch := hb_Deserialize( Substr( cData, 7 ) ) + IF hb_regexMatch( cMatch, ::cServerName ) + cRes := "XHBR10" + hb_Serialize( ::cServerName ) + ENDIF + ELSE + cRes := "XHBR10" + hb_Serialize( ::cServerName ) + ENDIF + RETURN .T. + + /* XRB01 - Function scan */ + CASE cCode == "XHBR01" + IF ! ::OnFunctionScan() + RETURN .F. + ENDIF + /* minimal length to be valid */ + IF nPacketLen > 24 + cSerial := hb_DeserialBegin( Substr( cData, 7 ) ) + cMatch := hb_DeserialNext( @cSerial ) + cNumber := NIL + IF ! Empty( cMatch ) + cMatch := hb_regexComp( cMatch ) + cNumber := hb_DeserialNext( @cSerial ) + ELSE + cMatch := hb_regexComp( ".*" ) + ENDIF + + IF Empty( cNumber ) + cNumber := "00000000.0" + ENDIF + + FOR EACH oFunc IN ::aFunctions + IF hb_regexMatch( cMatch, oFunc:cName ) .AND. cNumber <= oFunc:cSerial + cRes := "XHBR11" + hb_Serialize( ::cServerName ) + hb_Serialize( ofunc:Describe() ) + RETURN .T. + ENDIF + NEXT + ENDIF + + /* If we don't have the function, we cannot reply */ + RETURN .F. ENDCASE - /* Ignore malfored requests. */ -RETURN .F. - + /* Ignore malformed requests. */ + RETURN .F. METHOD Terminating( oConnection ) CLASS tRPCService + LOCAL nToken ::OnClientTerminate( oConnection ) - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) nToken := AScan( ::aServing, {| x | x == oConnection } ) IF nToken > 0 ADel( ::aServing, nToken ) - ASize( ::aServing, Len( ::aServing ) -1 ) + ASize( ::aServing, Len( ::aServing ) - 1 ) ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD AuthorizeChallenge( cUserId, cData ) CLASS tRPCService + LOCAL cKey, nPos, cMarker := "PASSWORD:" cKey := ::GetEncryption( cUserId ) @@ -1530,96 +1555,125 @@ METHOD AuthorizeChallenge( cUserId, cData ) CLASS tRPCService RETURN NIL ENDIF - cData := Substr( cData, nPos + Len( cMarker ) ) + cData := SubStr( cData, nPos + Len( cMarker ) ) nPos := At( ":", cData ) IF nPos == 0 RETURN NIL ENDIF - cData := Substr( cData, 1, nPos - 1 ) + cData := SubStr( cData, 1, nPos - 1 ) IF ::Authorize( cUserId, cData ) > 0 RETURN cKey ENDIF -RETURN NIL -/* Default authorization will ALWAYS return 1 if a bAuthorize block is not provided */ -/* IF cPassword is NIL, must return the level of the given userid */ + RETURN NIL + + /* Default authorization will ALWAYS return 1 if a bAuthorize block is not provided */ + /* IF cPassword is NIL, must return the level of the given userid */ + METHOD Authorize( cUserid, cPassword ) CLASS tRPCService + IF ::bAuthorize != NIL RETURN Eval( ::bAuthorize, cUserid, cPassword ) ENDIF -RETURN 1 -/* By default, do not provide an encryption key for any user */ + RETURN 1 + + /* By default, do not provide an encryption key for any user */ + METHOD GetEncryption( cUserId ) CLASS tRPCService + IF ::bGetEncryption != NIL RETURN Eval( ::bGetEncryption, cUserId ) ENDIF -RETURN NIL + + RETURN NIL METHOD OnFunctionScan() CLASS tRPCService + IF ::bOnFunctionScan != NIL RETURN Eval( ::bOnFunctionScan, Self ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnServerScan() CLASS tRPCService + IF ::bOnServerScan != NIL RETURN Eval( ::bOnServerScan, Self ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnClientConnect( oClient ) CLASS tRPCService + IF ::bOnClientConnect != NIL RETURN Eval( ::bOnClientConnect, oClient ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnClientLogin( oClient ) CLASS tRPCService + IF ::bOnClientLogin != NIL Eval( ::bOnClientLogin, oClient ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnClientRequest( oClient, nRequest, cData ) CLASS tRPCService + IF ::bOnClientRequest != NIL RETURN Eval( ::bOnClientRequest, oClient, nRequest, cData ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionProgress( oClient, nProgress, aData ) CLASS tRPCService + IF ::bOnFunctionProgress != NIL RETURN Eval( ::bOnFunctionProgress, oClient, nProgress, aData ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionError( oClient, cFunction, nError ) CLASS tRPCService + IF ::bOnFunctionError != NIL RETURN Eval( ::bOnFunctionError, oClient, cFunction, nError ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionReturn( oClient, aData ) CLASS tRPCService + IF ::bOnFunctionReturn != NIL RETURN Eval( ::bOnFunctionReturn, oClient, aData ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionCanceled( oClient, cFuncName ) CLASS tRPCService + IF ::bOnFunctionCanceled != NIL RETURN Eval( ::bOnFunctionCanceled, oClient, cFuncName ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnClientLogout( oClient ) CLASS tRPCService + IF ::bOnClientLogout != NIL RETURN Eval( ::bOnClientLogout, oClient ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnClientTerminate( oClient ) CLASS tRPCService + IF ::bOnClientTerminate != NIL RETURN Eval( ::bOnClientTerminate, oClient ) ENDIF -RETURN .T. + + RETURN .T. diff --git a/harbour/contrib/xhb/trpccli.prg b/harbour/contrib/xhb/trpccli.prg index 48d24dbb80..c532bd2730 100644 --- a/harbour/contrib/xhb/trpccli.prg +++ b/harbour/contrib/xhb/trpccli.prg @@ -113,14 +113,14 @@ CLASS tRPCClient METHOD FoundServers() INLINE Len( ::aServers ) != 0 METHOD FoundFunctions() INLINE Len( ::aFunctions ) != 0 - METHOD HasError() INLINE ::nErrorCode != 0 .or. ::TcpHasError() .or. ::UdpHasError() + METHOD HasError() INLINE ::nErrorCode != 0 .OR. ::TcpHasError() .OR. ::UdpHasError() METHOD GetErrorCode() INLINE ::nErrorCode - METHOD TcpHasError() INLINE iif( Empty( ::skTCP ), .F., hb_inetErrorCode( ::skTCP ) > 0 ) + 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., hb_inetErrorCode( ::skUDP ) > 0 ) + 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 */ @@ -128,11 +128,11 @@ CLASS tRPCClient METHOD GetServerName( xId ) METHOD GetServerAddress( xId ) -HIDDEN: + HIDDEN: // Automatic initialization of inet support CLASSDATA lInit INIT hb_inetInit() - DATA mtxBusy INIT HB_MutexCreate() + DATA mtxBusy INIT hb_mutexCreate() DATA nStatus // This RPC protocol breaking error code @@ -184,7 +184,7 @@ HIDDEN: METHOD clearTCPBuffer() /* internal network send call */ - METHOD SendCall(cFunction,aParams ) + METHOD SendCall( cFunction, aParams ) /* event handlers */ METHOD OnScanComplete() @@ -197,8 +197,8 @@ HIDDEN: ENDCLASS - METHOD New( cNetwork, nTcpPort, nUdpPort ) CLASS tRPCClient + ::nStatus := RPC_STATUS_NONE // not connected ::nErrorCode := 0 // no RPC error ::cServer := NIL // no server @@ -215,52 +215,55 @@ METHOD New( cNetwork, nTcpPort, nUdpPort ) CLASS tRPCClient ::bEncrypted := .F. ::nLoopMode := RPC_LOOP_NONE -RETURN Self + RETURN Self METHOD Destroy() CLASS tRPCClient - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::Disconnect() - IF hb_threadId( ::thUdpAccept ) != 0 + IF hb_threadID( ::thUdpAccept ) != 0 hb_threadQuitRequest( ::thUdpAccept ) ::thUdpAccept := NIL ENDIF - IF hb_threadId( ::thTcpAccept ) != 0 + IF hb_threadID( ::thTcpAccept ) != 0 hb_threadQuitRequest( ::thTcpAccept ) ::thTcpAccept := NIL ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD SetEncryption( cKey ) + IF ! Empty( cKey ) ::bEncrypted := .T. ::cCryptKey := cKey ELSE ::bEncrypted := .F. ENDIF -RETURN .T. + RETURN .T. + +METHOD ScanServers( cName ) CLASS tRPCClient -METHOD ScanServers(cName) CLASS tRPCClient // do not allow asynchronous mode without timeout - IF ! ::lAsyncMode .and. ( ::nTimeout == NIL .or. ::nTimeOut <= 0 ) + IF ! ::lAsyncMode .AND. ( ::nTimeout == NIL .OR. ::nTimeOut <= 0 ) RETURN .F. ENDIF - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::aServers := {} - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) - hb_inetDGramSend( ::skUDP, ::cNetwork , ::nUdpPort, "XHBR00" + HB_Serialize( cName ) ) + hb_inetDGramSend( ::skUDP, ::cNetwork , ::nUdpPort, "XHBR00" + hb_Serialize( cName ) ) ::StartScan() -RETURN .F. + RETURN .F. METHOD CheckServer( cRemote ) + LOCAL cData, skRemote, nLen, cData2 cData := "XHBR00" @@ -269,46 +272,48 @@ METHOD CheckServer( cRemote ) ENDIF skRemote := hb_inetConnect( cRemote, ::nTcpPort ) IF hb_inetErrorCode( skRemote ) == 0 - hb_InetTimeout(skRemote, 10000) + hb_inetTimeout( skRemote, 10000 ) hb_inetSendAll( skRemote, cData ) - cData := space(256) - hb_inetRecvAll( skRemote, @cData, 6+9 ) + cData := Space( 256 ) + hb_inetRecvAll( skRemote, @cData, 6 + 9 ) IF hb_inetErrorCode( skRemote ) == 0 - cData2 := Space(256) - nLen := HB_GetLen8( substr( cData, 8, 8 ) ) + cData2 := Space( 256 ) + nLen := HB_GetLen8( SubStr( cData, 8, 8 ) ) hb_inetRecvAll( skRemote, @cData2, nLen ) IF hb_inetErrorCode( skRemote ) == 0 - cData := Substr( cData + cData2, 7 ) - cData2 := HB_Deserialize( cData ) - AAdd(::aServers, {hb_inetAddress( skRemote ), cData2} ) + cData := SubStr( cData + cData2, 7 ) + cData2 := hb_Deserialize( cData ) + AAdd( ::aServers, { hb_inetAddress( skRemote ), cData2 } ) RETURN .T. ENDIF ENDIF ENDIF -RETURN .F. + + RETURN .F. METHOD ScanFunctions( cFunc, cSerial ) CLASS tRPCClient + // do not allow asynchronous mode without timeout - IF ! ::lAsyncMode .and. ( ::nTimeOut == NIL .or. ::nTimeOut <= 0 ) + IF ! ::lAsyncMode .AND. ( ::nTimeOut == NIL .OR. ::nTimeOut <= 0 ) RETURN .F. ENDIF IF cSerial == NIL cSerial := "00000000.0" ENDIF - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::aFunctions := {} ::aServers := {} - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) - hb_inetDGramSend( ::skUDP, ::cNetwork, ::nUdpPort,; - "XHBR01" + HB_Serialize( cFunc ) + HB_Serialize( cSerial )) + hb_inetDGramSend( ::skUDP, ::cNetwork, ::nUdpPort, ; + "XHBR01" + hb_Serialize( cFunc ) + hb_Serialize( cSerial ) ) ::StartScan() -RETURN .F. - + RETURN .F. METHOD StartScan() + // We don't accept sync call without timeout IF ::lAsyncMode @@ -316,21 +321,21 @@ METHOD StartScan() ::StopScan() ENDIF - ::nUDPTimeBegin := INT( Seconds() * 1000 ) + ::nUDPTimeBegin := Int( Seconds() * 1000 ) // in async mode, just launch the listener IF ::lAsyncMode - HB_MutexLock( ::mtxBusy ) - ::thUdpAccept := StartThread( Self, "UDPAccept" ) - HB_MutexUnlock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) + ::thUdpAccept := StartThread( Self, "UDPAccept" ) + hb_mutexUnlock( ::mtxBusy ) ELSE ::UDPAccept() ENDIF -RETURN .T. - + RETURN .T. METHOD UDPAccept() CLASS tRPCClient + LOCAL nTime, nDatalen, cData cData := Space( 1400 ) @@ -344,7 +349,7 @@ METHOD UDPAccept() CLASS tRPCClient DO WHILE .T. nDatalen := hb_inetDGramRecv( ::skUDP, @cData, 1400 ) - IF nDataLen > 0 .and. ::UDPParse( cData, nDatalen ) + IF nDataLen > 0 .AND. ::UDPParse( cData, nDatalen ) EXIT ENDIF @@ -361,14 +366,14 @@ METHOD UDPAccept() CLASS tRPCClient ::OnScanComplete() // signal that this thread is no longer active - HB_MutexLock( ::mtxBusy ) - ::thUdpAccept := NIL - HB_MutexUnlock( ::mtxBusy ) - -RETURN .T. + hb_mutexLock( ::mtxBusy ) + ::thUdpAccept := NIL + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD UDPParse( cData, nLen ) CLASS tRPCClient + LOCAL cCode, cSer, cFunc, cName LOCAL aLoc @@ -376,56 +381,57 @@ METHOD UDPParse( cData, nLen ) CLASS tRPCClient RETURN .F. ENDIF - cCode := Substr( cData, 1, 6 ) + cCode := SubStr( cData, 1, 6 ) DO CASE /* XHRB00 - server scan */ - CASE cCode == "XHBR10" - cData := Substr( cData, 7 ) - cData := HB_Deserialize( cData, 512 ) - // deserialization error checking - IF cData != NIL - aLoc := { hb_inetAddress( ::skUDP ), cData } - AAdd( ::aServers, aLoc ) - RETURN ::OnScanServersProgress( aLoc ) - ELSE - RETURN .F. - ENDIF + CASE cCode == "XHBR10" + cData := SubStr( cData, 7 ) + cData := hb_Deserialize( cData, 512 ) + // deserialization error checking + IF cData != NIL + aLoc := { hb_inetAddress( ::skUDP ), cData } + AAdd( ::aServers, aLoc ) + RETURN ::OnScanServersProgress( aLoc ) + ELSE + RETURN .F. + ENDIF - CASE cCode == "XHBR11" - cData := Substr( cData, 7 ) - cSer := HB_DeserialBegin( cData ) - cName := HB_DeserialNext( @cSer, 64 ) - cFunc := HB_DeserialNext( @cSer, 64 ) - IF cName != NIL .and. cFunc != NIL - aLoc := { hb_inetAddress( ::skUDP ), cName, cFunc } - AAdd( ::aFunctions, aLoc ) - RETURN ::OnScanFunctionsProgress( aLoc ) - ELSE - RETURN .F. - ENDIF + CASE cCode == "XHBR11" + cData := SubStr( cData, 7 ) + cSer := HB_DeserialBegin( cData ) + cName := HB_DeserialNext( @cSer, 64 ) + cFunc := HB_DeserialNext( @cSer, 64 ) + IF cName != NIL .AND. cFunc != NIL + aLoc := { hb_inetAddress( ::skUDP ), cName, cFunc } + AAdd( ::aFunctions, aLoc ) + RETURN ::OnScanFunctionsProgress( aLoc ) + ELSE + RETURN .F. + ENDIF ENDCASE -RETURN .F. - + RETURN .F. METHOD StopScan() CLASS tRPCClient - HB_MutexLock( ::mtxBusy ) - IF hb_threadId( ::thUDPAccept ) != 0 + + hb_mutexLock( ::mtxBusy ) + IF hb_threadID( ::thUDPAccept ) != 0 hb_threadQuitRequest( ::thUDPAccept ) ::thUDPAccept := NIL - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ::OnScanComplete() ELSE - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ENDIF -RETURN .T. + RETURN .T. METHOD Connect( cServer, cUserId, cPassword ) CLASS tRPCClient - LOCAL cAuth, cReply := Space(8) + + LOCAL cAuth, cReply := Space( 8 ) hb_inetConnect( cServer, ::nTcpPort, ::skTcp ) @@ -443,7 +449,7 @@ METHOD Connect( cServer, cUserId, cPassword ) CLASS tRPCClient IF hb_inetErrorCode( ::skTcp ) == 0 IF ! ::bEncrypted hb_inetRecvAll( ::skTcp, @cReply ) - IF hb_inetErrorCode( ::skTcp ) == 0 .and. cReply == "XHBR91OK" + IF hb_inetErrorCode( ::skTcp ) == 0 .AND. cReply == "XHBR91OK" ::nStatus := RPC_STATUS_LOGGED // Logged in RETURN .T. ENDIF @@ -456,30 +462,32 @@ METHOD Connect( cServer, cUserId, cPassword ) CLASS tRPCClient ::skTcp := NIL ::nStatus := RPC_STATUS_NONE -RETURN .F. + RETURN .F. METHOD BuildChallengePwd( cPassword ) CLASS tRPCClient + LOCAL nLen, nCount, cRet - nLen := 10 + INT( HB_Random( 1, 60 ) ) + nLen := 10 + Int( hb_Random( 1, 60 ) ) cRet := "" FOR nCount := 1 TO nLen - cRet += Chr( Int( HB_Random( 2, 254 ) ) ) + cRet += Chr( Int( hb_Random( 2, 254 ) ) ) NEXT cRet += "PASSWORD:" + cPassword + ":" DO WHILE Len( cRet ) < 100 - cRet += Chr( Int( HB_Random( 2, 254 ) ) ) + cRet += Chr( Int( hb_Random( 2, 254 ) ) ) ENDDO cRet := ::Encrypt( cRet ) -RETURN cRet + RETURN cRet METHOD ManageChallenge() CLASS tRPCClient + LOCAL cCode, cLen, nLen LOCAL cData, nChallenge @@ -506,9 +514,9 @@ METHOD ManageChallenge() CLASS tRPCClient cData := HB_Decrypt( cData, ::cCryptKey ) nChallenge := HB_Checksum( cData ) hb_inetSendAll( ::skTCP, "XHBR95" + HB_CreateLen8( nChallenge ) ) - //IF hb_inetErrorCode( ::skTCP ) != 0 - // RETURN .F. - //ENDIF +// IF hb_inetErrorCode( ::skTCP ) != 0 +// RETURN .F. +// ENDIF cCode := Space( 8 ) hb_inetRecvAll( ::skTCP, @cCode ) @@ -518,23 +526,20 @@ METHOD ManageChallenge() CLASS tRPCClient /* SUCCESS! */ ::nStatus := RPC_STATUS_LOGGED -RETURN .T. - + RETURN .T. METHOD Disconnect() CLASS tRPCClient IF ::nStatus >= RPC_STATUS_LOGGED - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::nStatus := RPC_STATUS_NONE hb_inetSendAll( ::skTcp, "XHBR92" ) hb_inetClose( ::skTcp ) - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) RETURN .T. ENDIF -RETURN .F. - - + RETURN .F. METHOD SetLoopMode( nMethod, xData, nEnd, nStep ) CLASS tRPCClient @@ -564,12 +569,13 @@ METHOD SetLoopMode( nMethod, xData, nEnd, nStep ) CLASS tRPCClient ::nLoopMode := nMethod -RETURN .T. + RETURN .T. METHOD ClearTCPBuffer() CLASS tRPCClient + LOCAL cDummy := Space( 512 ) - IF ::skTCP == NIL .or. ::nStatus < RPC_STATUS_LOGGED + IF ::skTCP == NIL .OR. ::nStatus < RPC_STATUS_LOGGED RETURN .F. ENDIF @@ -577,36 +583,37 @@ METHOD ClearTCPBuffer() CLASS tRPCClient // hb_inetRecv reads only the available data hb_inetRecv( ::skTCP, @cDummy ) ENDDO -RETURN .T. + RETURN .T. METHOD Call( ... ) CLASS tRPCClient + LOCAL oCalling LOCAL cFunction, aParams LOCAL nCount - IF Pcount() == 0 + IF PCount() == 0 RETURN NIL ENDIF ::oResult := NIL // do not allow asynchronous mode without timeout - IF ! ::lAsyncMode .and. ( ::nTimeOut == NIL .or. ::nTimeOut <= 0 ) + IF ! ::lAsyncMode .AND. ( ::nTimeOut == NIL .OR. ::nTimeOut <= 0 ) RETURN NIL ENDIF oCalling := hb_PValue( 1 ) IF HB_ISARRAY( oCalling ) - cFunction := oCalling[1] + cFunction := oCalling[ 1 ] ADel( oCalling, 1 ) - ASize( oCalling, Len( oCalling ) -1 ) + ASize( oCalling, Len( oCalling ) - 1 ) aParams := oCalling ELSE cFunction := oCalling - aParams := Array( Pcount() -1 ) - FOR nCount := 2 TO Pcount() - aParams[nCount - 1] := hb_PValue( nCount ) + aParams := Array( PCount() - 1 ) + FOR nCount := 2 TO PCount() + aParams[ nCount - 1 ] := hb_PValue( nCount ) NEXT ENDIF @@ -614,13 +621,13 @@ METHOD Call( ... ) CLASS tRPCClient ::ClearTcpBuffer() // The real call - HB_MutexLock( ::mtxBusy ) - // already active or not already connected - IF hb_threadId( ::thTcpAccept ) != 0 .or. ::skTCP == NIL .or. ::nStatus < RPC_STATUS_LOGGED - HB_MutexUnlock( ::mtxBusy ) - RETURN NIL - ENDIF - HB_MutexUnlock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) + // already active or not already connected + IF hb_threadID( ::thTcpAccept ) != 0 .OR. ::skTCP == NIL .OR. ::nStatus < RPC_STATUS_LOGGED + hb_mutexUnlock( ::mtxBusy ) + RETURN NIL + ENDIF + hb_mutexUnlock( ::mtxBusy ) ::nStatus := RPC_STATUS_WAITING // waiting for a reply @@ -630,34 +637,34 @@ METHOD Call( ... ) CLASS tRPCClient ENDIF // in async mode, just launch the listener - IF ::lAsyncMode - HB_MutexLock( ::mtxBusy ) - ::thTCPAccept := StartThread( Self, "TCPAccept" ) - HB_MutexUnlock( ::mtxBusy ) - ELSE - ::TCPAccept() - ENDIF - -RETURN ::oResult + IF ::lAsyncMode + hb_mutexLock( ::mtxBusy ) + ::thTCPAccept := StartThread( Self, "TCPAccept" ) + hb_mutexUnlock( ::mtxBusy ) + ELSE + ::TCPAccept() + ENDIF + RETURN ::oResult METHOD SetPeriodCallback( ... ) CLASS tRPCClient + LOCAL caCalling LOCAL nCount - IF Pcount() < 3 + IF PCount() < 3 //TODO set an error RETURN .F. ENDIF - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::nTimeout := hb_PValue( 1 ) ::nTimeLimit := hb_PValue( 2 ) caCalling := hb_PValue( 3 ) IF ! HB_ISARRAY( caCalling ) - caCalling := Array( Pcount() -2 ) - FOR nCount := 3 TO Pcount() + caCalling := Array( PCount() - 2 ) + FOR nCount := 3 TO PCount() caCalling[nCount - 2] := hb_PValue( nCount ) NEXT ENDIF @@ -669,13 +676,13 @@ METHOD SetPeriodCallback( ... ) CLASS tRPCClient hb_inetPeriodCallback( ::skTCP, caCalling ) ENDIF - HB_MutexUnlock( ::mtxBusy ) - -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD ClearPeriodCallback() CLASS tRPCClient - HB_MutexLock( ::mtxBusy ) + + hb_mutexLock( ::mtxBusy ) ::nTimeout := -1 ::nTimeLimit := -1 @@ -687,27 +694,30 @@ METHOD ClearPeriodCallback() CLASS tRPCClient hb_inetClearPeriodCallback( ::skTCP ) ENDIF - HB_MutexUnlock( ::mtxBusy ) -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD SetTimeout( nTime ) CLASS tRPCClient - HB_MutexLock( ::mtxBusy ) + + hb_mutexLock( ::mtxBusy ) ::nTimeout := nTime - hb_InetTimeout( ::skTCP, ::nTimeout ) + hb_inetTimeout( ::skTCP, ::nTimeout ) - HB_MutexUnlock( ::mtxBusy ) -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD GetTimeout() - LOCAL nRet - HB_MutexLock( ::mtxBusy ) - nRet := ::nTimeout - HB_MutexUnlock( ::mtxBusy ) -RETURN nRet + LOCAL nRet + + hb_mutexLock( ::mtxBusy ) + nRet := ::nTimeout + hb_mutexUnlock( ::mtxBusy ) + + RETURN nRet METHOD StopCall() CLASS tRPCClient @@ -721,90 +731,91 @@ METHOD StopCall() CLASS tRPCClient // send cancelation request hb_inetSendAll( ::skTCP, "XHBR29" ); - //Stops waiting for a result - HB_MutexLock( ::mtxBusy ) - IF hb_threadId( ::thTCPAccept ) != 0 + //Stops waiting for a result + hb_mutexLock( ::mtxBusy ) + IF hb_threadID( ::thTCPAccept ) != 0 hb_threadQuitRequest( ::thTCPAccept ) ::thTCPAccept := NIL ::nStatus := RPC_STATUS_LOGGED - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ::OnFunctionReturn( NIL ) ELSE - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) ENDIF -RETURN .T. - + RETURN .T. METHOD SendCall( cFunction, aParams ) CLASS tRPCClient + LOCAL cData := "", nLen LOCAL nReq, cType SWITCH ::nLoopMode - CASE RPC_LOOP_NONE - nReq := 0 - cType := "" + CASE RPC_LOOP_NONE + nReq := 0 + cType := "" EXIT - CASE RPC_LOOP_ALLDATA - nReq := 2 - cType := "A" + CASE RPC_LOOP_ALLDATA + nReq := 2 + cType := "A" EXIT - CASE RPC_LOOP_SUMMARY - nReq := 2 - cType := "C" + CASE RPC_LOOP_SUMMARY + nReq := 2 + cType := "C" EXIT - CASE RPC_LOOP_CONFIRMATION - nReq := 2 - cType := "E" + CASE RPC_LOOP_CONFIRMATION + nReq := 2 + cType := "E" EXIT - END + ENDSWITCH - IF ::aLoopData == NIL .and. ::nLoopMode > RPC_LOOP_NONE - cData := HB_Serialize( ::nLoopStart ) + HB_Serialize( ::nLoopEnd ) +; - HB_Serialize( ::nLoopStep ) + IF ::aLoopData == NIL .AND. ::nLoopMode > RPC_LOOP_NONE + cData := hb_Serialize( ::nLoopStart ) + hb_Serialize( ::nLoopEnd ) + ; + hb_Serialize( ::nLoopStep ) ENDIF - cData += HB_Serialize( cFunction ) + HB_Serialize( aParams ) + cData += hb_Serialize( cFunction ) + hb_Serialize( aParams ) IF ::aLoopData != NIL - cData += HB_Serialize( ::aLoopData ) + cData += hb_Serialize( ::aLoopData ) nReq += 2 ENDIF nLen := Len( cData ) IF nLen > 512 cData := HB_Compress( cData ) - cData := "XHBR2" + AllTrim( Str( nReq + 1 ) ) + ; - HB_CreateLen8( nLen ) + HB_CreateLen8( Len( cData ) ) +; - cType + ::Encrypt( cData ) + cData := "XHBR2" + hb_ntos( nReq + 1 ) + ; + HB_CreateLen8( nLen ) + HB_CreateLen8( Len( cData ) ) + ; + cType + ::Encrypt( cData ) ELSE - cData := "XHBR2" + AllTrim( Str( nReq ) ) + HB_CreateLen8( nLen ) +; - cType + ::Encrypt( cData) + cData := "XHBR2" + hb_ntos( nReq ) + HB_CreateLen8( nLen ) + ; + cType + ::Encrypt( cData ) ENDIF hb_inetSendAll( ::skTCP, cData ) -RETURN hb_inetErrorCode( ::skTCP ) == 0 + RETURN hb_inetErrorCode( ::skTCP ) == 0 METHOD TCPAccept() CLASS tRPCClient + LOCAL nTime := 0 LOCAL cCode LOCAL nTimeLimit // TcpAccept can also be called standalone, without the // support of call(). So, we must set the waiting state. - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) ::nErrorCode := 0 ::nStatus := RPC_STATUS_WAITING - HB_MutexUnlock( ::mtxBusy ) + hb_mutexUnlock( ::mtxBusy ) - cCode := Space(6) - ::nTCPTimeBegin := INT( Seconds() * 1000 ) + cCode := Space( 6 ) + ::nTCPTimeBegin := Int( Seconds() * 1000 ) nTimeLimit := Max( ::nTimeout, ::nTimeLimit ) @@ -827,25 +838,25 @@ METHOD TCPAccept() CLASS tRPCClient ENDIF ENDDO - HB_MutexLock( ::mtxBusy ) + hb_mutexLock( ::mtxBusy ) // NOT waiting anymore ::nStatus := RPC_STATUS_LOGGED ::thTcpAccept := NIL - IF ::caPerCall == NIL .and. hb_inetErrorCode( ::skTCP ) != -1 .and.; - nTime - nTimeLimit < nTimeLimit - 5 + IF ::caPerCall == NIL .AND. hb_inetErrorCode( ::skTCP ) != -1 .AND. ; + nTime - nTimeLimit < nTimeLimit - 5 IF hb_inetErrorCode( ::skTCP ) != 0 ::nStatus := RPC_STATUS_ERROR ENDIF ENDIF - HB_MutexUnlock( ::mtxBusy ) - -RETURN .T. + hb_mutexUnlock( ::mtxBusy ) + RETURN .T. METHOD TCPParse( cCode ) CLASS tRPCClient + LOCAL nDataLen, cData, nOrigLen LOCAL cDataLen := Space( 8 ), cOrigLen := Space( 8 ) LOCAL cProgress := Space( 10 ), nProgress @@ -855,167 +866,172 @@ METHOD TCPParse( cCode ) CLASS tRPCClient DO CASE /* Warn error codes */ - CASE cCode == "XHBR40" - cData := Space(2) - hb_inetRecvAll( ::skTCP, @cData, 2 ) - ::nErrorCode := Val( cData ) - ::OnFunctionFail( ::nErrorCode, "No description for now" ) + CASE cCode == "XHBR40" + cData := Space( 2 ) + hb_inetRecvAll( ::skTCP, @cData, 2 ) + ::nErrorCode := Val( cData ) + ::OnFunctionFail( ::nErrorCode, "No description for now" ) /* We have a reply */ - CASE cCode == "XHBR30" + CASE cCode == "XHBR30" + IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) + nDataLen := HB_GetLen8( cDataLen ) + cData := Space( nDataLen ) + IF hb_inetRecvAll( ::skTCP, @cData, nDataLen ) == nDataLen + ::oResult := hb_Deserialize( ::Decrypt( cData ), nDataLen ) + IF ::oResult != NIL + ::OnFunctionReturn( ::oResult ) + ENDIF + // todo: rise an error if ::oResult is nil + ENDIF + ENDIF + + /* We have a reply */ + CASE cCode == "XHBR31" + IF hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen ) + nOrigLen := HB_GetLen8( cOrigLen ) IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) nDataLen := HB_GetLen8( cDataLen ) cData := Space( nDataLen ) - IF hb_inetRecvAll( ::skTCP, @cData, nDataLen ) == nDataLen - ::oResult := HB_Deserialize( ::Decrypt( cData ), nDataLen ) - IF ::oResult != NIL - ::OnFunctionReturn( ::oResult ) + IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen + cData := HB_Uncompress( nOrigLen, ::Decrypt( cData ) ) + IF ! Empty( cData ) + ::oResult := hb_Deserialize( cData, nDataLen ) + IF ::oResult != NIL + ::OnFunctionReturn( ::oResult ) + ENDIF ENDIF - // todo: rise an error if ::oResult is nil ENDIF ENDIF + ENDIF - /* We have a reply */ - CASE cCode == "XHBR31" - IF hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen ) + /* We have a progress */ + CASE cCode == "XHBR33" + IF hb_inetRecvAll( ::skTCP, @cProgress, 10 ) == 10 + nProgress := hb_Deserialize( cProgress, 10 ) + IF nProgress != NIL + lContinue := .T. + ::OnFunctionProgress( nProgress ) + ENDIF + ENDIF + + /* We have a progress with data*/ + CASE cCode == "XHBR34" + IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress ) + nProgress := hb_Deserialize( cProgress, Len( cProgress ) ) + IF nProgress != NIL .AND. hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) + nDataLen := HB_GetLen8( cDataLen ) + cData := Space( nDataLen ) + IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen + ::oResult := hb_Deserialize( ::Decrypt( cData ), nDataLen ) + IF ::oResult != NIL + lContinue := .T. + ::OnFunctionProgress( nProgress, ::oResult ) + ENDIF + ENDIF + ENDIF + ENDIF + + /* We have a progress with compressed data*/ + CASE cCode == "XHBR35" + IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress ) + nProgress := hb_Deserialize( cProgress, Len( cProgress ) ) + IF nProgress != NIL .AND. hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen ) nOrigLen := HB_GetLen8( cOrigLen ) IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) nDataLen := HB_GetLen8( cDataLen ) cData := Space( nDataLen ) IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen - cData := HB_Uncompress( nOrigLen, ::Decrypt( cData ) ) + cData := HB_Uncompress( nOrigLen, cData ) IF ! Empty( cData ) - ::oResult := HB_Deserialize( cData, nDataLen ) + ::oResult := hb_Deserialize( ::Decrypt( cData ), nDataLen ) IF ::oResult != NIL - ::OnFunctionReturn( ::oResult ) - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF - - /* We have a progress */ - CASE cCode == "XHBR33" - IF hb_inetRecvAll( ::skTCP, @cProgress, 10 ) == 10 - nProgress := HB_Deserialize( cProgress, 10 ) - IF nProgress != NIL - lContinue := .T. - ::OnFunctionProgress( nProgress ) - ENDIF - ENDIF - - /* We have a progress with data*/ - CASE cCode == "XHBR34" - IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress ) - nProgress := HB_Deserialize( cProgress, Len( cProgress) ) - IF nProgress != NIL .and. hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) - nDataLen := HB_GetLen8( cDataLen ) - cData := Space( nDataLen ) - IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen - ::oResult := HB_Deserialize(::Decrypt( cData), nDataLen ) - IF ::oResult != NIL - lContinue := .T. - ::OnFunctionProgress( nProgress, ::oResult ) - ENDIF - ENDIF - ENDIF - ENDIF - - /* We have a progress with compressed data*/ - CASE cCode == "XHBR35" - IF hb_inetRecvAll( ::skTCP, @cProgress ) == Len( cProgress ) - nProgress := HB_Deserialize( cProgress, Len( cProgress ) ) - IF nProgress != NIL .and. hb_inetRecvAll( ::skTCP, @cOrigLen ) == Len( cOrigLen ) - nOrigLen := HB_GetLen8( cOrigLen ) - IF hb_inetRecvAll( ::skTCP, @cDataLen ) == Len( cDataLen ) - nDataLen := HB_GetLen8( cDataLen ) - cData := Space( nDataLen ) - IF hb_inetRecvAll( ::skTCP, @cData ) == nDataLen - cData := HB_Uncompress( nOrigLen, cData ) - IF ! Empty( cData ) - ::oResult := HB_Deserialize( ::Decrypt( cData), nDataLen ) - IF ::oResult != NIL - lContinue := .T. - ::OnFunctionProgress( nProgress, ::oResult ) - ENDIF + lContinue := .T. + ::OnFunctionProgress( nProgress, ::oResult ) ENDIF ENDIF ENDIF ENDIF ENDIF + ENDIF ENDCASE -RETURN lContinue + RETURN lContinue /*********************************** * Utility functions ************************************/ + METHOD GetFunctionName( xId ) CLASS tRpcClient + LOCAL cData, nPos IF HB_ISARRAY( xID ) - cData := xId[3] + cData := xId[ 3 ] ELSEIF Len( ::aFunctions ) > 0 - cData := ::aFunctions[xId][3] + cData := ::aFunctions[ xId ][ 3 ] ELSE cData := "" ENDIF - IF ! Empty(cData) + IF ! Empty( cData ) nPos := At( "(", cData ) - cData := Substr( cData, 1, nPos-1 ) + cData := SubStr( cData, 1, nPos - 1 ) ENDIF -RETURN cData - + RETURN cData METHOD GetServerName( xId ) CLASS tRpcClient + LOCAL cData IF HB_ISARRAY( xID ) - cData := xId[2] + cData := xId[ 2 ] ELSE IF Len( ::aFunctions ) > 0 - cData := ::aFunctions[xId][2] + cData := ::aFunctions[ xId ][ 2 ] ELSEIF Len( ::aServers ) > 0 - cData := ::aServers[xId][2] + cData := ::aServers[ xId ][ 2 ] ELSE cData := "" ENDIF ENDIF -RETURN cData + RETURN cData METHOD GetServerAddress( xId ) CLASS tRpcClient + LOCAL cData IF HB_ISARRAY( xID ) - cData := xId[1] + cData := xId[ 1 ] ELSE IF ! Empty( ::aFunctions ) - cData := ::aFunctions[xId][1] + cData := ::aFunctions[ xId ][ 1 ] ELSEIF ! Empty( ::aServers ) - cData := ::aServers[xId][1] + cData := ::aServers[ xId ][ 1 ] ELSE cData := "" ENDIF ENDIF -RETURN cData + RETURN cData +METHOD Encrypt( cDataIn ) CLASS tRPCClient -METHOD Encrypt(cDataIn) CLASS tRPCClient IF ::bEncrypted RETURN HB_Crypt( cDataIn, ::cCryptKey ) ENDIF -RETURN cDataIn + RETURN cDataIn + +METHOD Decrypt( cDataIn ) CLASS tRPCClient -METHOD Decrypt(cDataIn) CLASS tRPCClient IF ::bEncrypted RETURN HB_Decrypt( cDataIn, ::cCryptKey ) ENDIF -RETURN cDataIn + + RETURN cDataIn /*********************************** @@ -1023,37 +1039,49 @@ RETURN cDataIn ************************************/ METHOD OnScanComplete() CLASS tRPCClient + IF ::bOnScanComplete != NIL RETURN Eval( ::bOnScanComplete ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnScanServersProgress( aLoc ) CLASS tRPCClient + IF ::bOnScanServersProgress != NIL RETURN Eval( ::bOnScanServersProgress, aLoc ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnScanFunctionsProgress( aLoc ) CLASS tRPCClient + IF ::bOnScanFunctionsProgress != NIL RETURN Eval( ::bOnScanFunctionsProgress, aLoc ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionFail( nReason, cReason ) CLASS tRPCClient + IF ::bOnFunctionFail != NIL RETURN Eval( ::bOnFunctionFail, nReason, cReason ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionReturn( oReturn ) CLASS tRPCClient + IF ::bOnFunctionReturn != NIL RETURN Eval( ::bOnFunctionReturn, oReturn ) ENDIF -RETURN .T. + + RETURN .T. METHOD OnFunctionProgress( nProgress, oData ) CLASS tRPCClient + IF ::bOnFunctionProgress != NIL RETURN Eval( ::bOnFunctionProgress, nProgress, oData ) ENDIF -RETURN .T. + + RETURN .T. diff --git a/harbour/contrib/xhb/xhberr.prg b/harbour/contrib/xhb/xhberr.prg index e146c51b65..86c3cb8737 100644 --- a/harbour/contrib/xhb/xhberr.prg +++ b/harbour/contrib/xhb/xhberr.prg @@ -125,7 +125,7 @@ STATIC FUNCTION xhb_DefError( oError ) IF ProcName( n ) == ProcName() n := 3 TraceLog( "Error system failure!", err_ProcName( oError, n ), err_ProcLine( oError, n ), err_ModuleName( oError, n ), oError:description ) - Alert( "Error system failure!;Please correct error handler:;" + err_ProcName( oError, n ) + "(" + LTrim( Str( err_ProcLine( oError, n ) ) ) + ") in module: " + err_ModuleName( oError, n ) ) + Alert( "Error system failure!;Please correct error handler:;" + err_ProcName( oError, n ) + "(" + hb_ntos( err_ProcLine( oError, n ) ) + ") in module: " + err_ModuleName( oError, n ) ) ErrorLevel( 1 ) QUIT ENDIF @@ -165,7 +165,7 @@ STATIC FUNCTION xhb_DefError( oError ) cMessage := ErrorMessage( oError ) IF !Empty( oError:osCode ) - cDOSError := "(DOS Error " + LTrim( Str( oError:osCode ) ) + ")" + cDOSError := "(DOS Error " + hb_ntos( oError:osCode ) + ")" ENDIF @@ -215,9 +215,9 @@ STATIC FUNCTION xhb_DefError( oError ) ENDIF ELSE IF Empty( oError:osCode ) - Alert( cMessage + ";" + err_ProcName( oError, 3 ) + "(" + LTrim( Str( err_ProcLine( oError, 3 ) ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) + Alert( cMessage + ";" + err_ProcName( oError, 3 ) + "(" + hb_ntos( err_ProcLine( oError, 3 ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) ELSE - Alert( cMessage + ";" + cDOSError + ";" + err_ProcName( oError, 3 ) + "(" + LTrim( Str( err_ProcLine( oError, 3 ) ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) + Alert( cMessage + ";" + cDOSError + ";" + err_ProcName( oError, 3 ) + "(" + hb_ntos( err_ProcLine( oError, 3 ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) ENDIF ENDIF @@ -230,11 +230,11 @@ STATIC FUNCTION xhb_DefError( oError ) ? cMessage ? - ? "Error at ...:", ProcName() + "(" + LTrim( Str( ProcLine() ) ) + ") in Module:", ProcFile() + ? "Error at ...:", ProcName() + "(" + hb_ntos( ProcLine() ) + ") in Module:", ProcFile() n := 2 WHILE ! Empty( ProcName( ++n ) ) ? "Called from :", ProcName( n ) + ; - "(" + LTrim( Str( ProcLine( n ) ) ) + ") in Module:", ProcFile( n ) + "(" + hb_ntos( ProcLine( n ) ) + ") in Module:", ProcFile( n ) ENDDO // For some strange reason, the DOS prompt gets written on the first line @@ -266,7 +266,7 @@ STATIC FUNCTION ErrorMessage( oError ) // add subsystem's error code if available IF HB_ISNUMERIC( oError:subCode ) - cMessage += "/" + LTrim( Str( oError:subCode ) ) + cMessage += "/" + hb_ntos( oError:subCode ) ELSE cMessage += "/???" ENDIF @@ -588,7 +588,7 @@ STATIC FUNCTION LogError( oerr ) cTemp += " TYPE " + Type( cVarName ) cTemp += " " + iif( Type( cVarName ) == "C", '"' + &cVarName + '"', strvalue( &cVarName ) ) nBytes := 0 - Switch ValType( cVarName ) + SWITCH ValType( cVarName ) CASE "C" nBytes += ( nLenTemp := Len( &cVarName ) ) EXIT @@ -601,7 +601,7 @@ STATIC FUNCTION LogError( oerr ) CASE "D" nBytes += ( nLenTemp := 9 ) EXIT - End + ENDSWITCH FWrite( nFhandle, " " + Transform( nLenTemp, "999999" ) + "bytes -> " ) FWriteLine( nHandle, " " + cTemp ) ENDDO diff --git a/harbour/contrib/xhb/xhbtedit.prg b/harbour/contrib/xhb/xhbtedit.prg index da1cbb608a..513a45e760 100644 --- a/harbour/contrib/xhb/xhbtedit.prg +++ b/harbour/contrib/xhb/xhbtedit.prg @@ -675,7 +675,7 @@ METHOD MoveCursor( nKey ) CLASS XHBEditor OTHERWISE RETURN .F. - endswitch + ENDSWITCH RETURN .T. @@ -1385,7 +1385,7 @@ METHOD K_Mouse( nKey ) CLASS XHBEditor LOCAL nRow, nCol, nJump - Switch nKey + SWITCH nKey CASE K_LBUTTONUP nRow := MRow() @@ -1407,7 +1407,7 @@ METHOD K_Mouse( nKey ) CLASS XHBEditor ::ClrTextSelection() ::Down() EXIT - end + ENDSWITCH RETURN Self diff --git a/harbour/extras/gtwvw/tests/wvwtest9.prg b/harbour/extras/gtwvw/tests/wvwtest9.prg index ba9eb08a19..aa3050b2af 100644 --- a/harbour/extras/gtwvw/tests/wvwtest9.prg +++ b/harbour/extras/gtwvw/tests/wvwtest9.prg @@ -285,21 +285,22 @@ PROCEDURE Main() @ MaxRow(), 0 SAY "This is line " + hb_ntos( MaxRow() ) DO WHILE !( ( ch := Inkey(0 ) ) == K_ESC ) - /* experiment with different paintrefresh interval: - do case - case ch==asc("<") - wvw_setPaintRefresh( INT(wvw_setPaintRefresh() / 2) ) - alert(wvw_setPaintRefresh()) - case ch==asc(">") - wvw_setPaintRefresh( INT(wvw_setPaintRefresh() * 2) ) - alert(wvw_setPaintRefresh()) - case ch==asc("0") + // experiment with different paintrefresh interval: + #if 0 + DO CASE + CASE ch == hb_keyCode( "<" ) + wvw_setPaintRefresh( Int( wvw_setPaintRefresh() / 2 ) ) + Alert( wvw_setPaintRefresh() ) + CASE ch == hb_keyCode( ">" ) + wvw_setPaintRefresh( Int( wvw_setPaintRefresh() * 2 ) ) + Alert( wvw_setPaintRefresh() ) + CASE ch == hb_keyCode( "0" ) wvw_setPaintRefresh( 0 ) - alert(wvw_setPaintRefresh()) - otherwise - * do nothing. inkey() has been handled by nAfterInket() - endcase - */ + Alert( wvw_setPaintRefresh() ) + OTHERWISE + // do nothing. inkey() has been handled by nAfterInket() + ENDCASE + #endif ENDDO lboxmessage( "Thanks for trying this program." + hb_eol() + ; diff --git a/harbour/extras/hbvpdf/hbvpdf.ch b/harbour/extras/hbvpdf/hbvpdf.ch index 75194ebe10..463a61cc33 100644 --- a/harbour/extras/hbvpdf/hbvpdf.ch +++ b/harbour/extras/hbvpdf/hbvpdf.ch @@ -5,7 +5,7 @@ #include "fileio.ch" #include "common.ch" -#define CRLF chr(13)+chr(10) +#define CRLF ( Chr( 13 ) + Chr( 10 ) ) #define NORMAL 0 #define BOLD 1 diff --git a/harbour/extras/hbvpdf/hbvpdf.hbp b/harbour/extras/hbvpdf/hbvpdf.hbp index 2ba8a55e16..315e44f0b3 100644 --- a/harbour/extras/hbvpdf/hbvpdf.hbp +++ b/harbour/extras/hbvpdf/hbvpdf.hbp @@ -12,5 +12,4 @@ -instfile=inc:hbvpdf.ch hbvpdf.prg -hbvpdft.prg hbvpsup.prg diff --git a/harbour/extras/hbvpdf/hbvpdf.prg b/harbour/extras/hbvpdf/hbvpdf.prg index e7522b4525..6ccda16f3f 100644 --- a/harbour/extras/hbvpdf/hbvpdf.prg +++ b/harbour/extras/hbvpdf/hbvpdf.prg @@ -43,7 +43,7 @@ DEFAULT cId to "" ENDIF IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( pdfPageNumber())) + substr( cString, nAt + 12 ) + cString := left( cString, nAt - 1 ) + hb_ntos( pdfPageNumber() ) + substr( cString, nAt + 12 ) ENDIF lReverse := .F. @@ -85,10 +85,10 @@ DEFAULT cId to "" _nFont := ascan( t_aReport[ FONTS ], {| arr | arr[ 1 ] == t_aReport[ FONTNAME ]} ) IF !( t_aReport[ FONTNAME ] == t_aReport[ FONTNAMEPREV ] ) t_aReport[ FONTNAMEPREV ] := t_aReport[ FONTNAME ] - t_aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + ltrim(str( _nFont )) + " " + ltrim(transform( t_aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" + t_aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + hb_ntos( _nFont ) + " " + ltrim(transform( t_aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" ELSEIF t_aReport[ FONTSIZE ] != t_aReport[ FONTSIZEPREV ] t_aReport[ FONTSIZEPREV ] := t_aReport[ FONTSIZE ] - t_aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + ltrim(str( _nFont )) + " " + ltrim(transform( t_aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" + t_aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + hb_ntos( _nFont ) + " " + ltrim(transform( t_aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" ELSE t_aReport[ PAGEBUFFER ] += CRLF + "BT " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" ENDIF @@ -281,20 +281,20 @@ DEFAULT cColor to "" IF nShade > 0 // version 0.02 - t_aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + ltrim(str(pdfM2X( y1 ))) + " " + ltrim(str(pdfM2Y( x1 ))) + " " + ltrim(str(pdfM2X( y2 - y1 ))) + " -" + ltrim(str(pdfM2X( x2 - x1 ))) + " re f 0 g" + t_aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + hb_ntos( pdfM2X( y1 ) ) + " " + hb_ntos( pdfM2Y( x1 ) ) + " " + hb_ntos( pdfM2X( y2 - y1 ) ) + " -" + hb_ntos( pdfM2X( x2 - x1 ) ) + " re f 0 g" ENDIF IF nBorder > 0 - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(pdfM2X( y1 ))) + " " + ltrim(str(pdfM2Y( x1 ))) + " " + ltrim(str(pdfM2X( y2 - y1 ))) + " -" + ltrim(str(pdfM2X( nBorder ))) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(pdfM2X( y2 - nBorder ))) + " " + ltrim(str(pdfM2Y( x1 ))) + " " + ltrim(str(pdfM2X( nBorder ))) + " -" + ltrim(str(pdfM2X( x2 - x1 ))) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(pdfM2X( y1 ))) + " " + ltrim(str(pdfM2Y( x2 - nBorder ))) + " " + ltrim(str(pdfM2X( y2 - y1 ))) + " -" + ltrim(str(pdfM2X( nBorder ))) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(pdfM2X( y1 ))) + " " + ltrim(str(pdfM2Y( x1 ))) + " " + ltrim(str(pdfM2X( nBorder ))) + " -" + ltrim(str(pdfM2X( x2 - x1 ))) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos( pdfM2X( y1 ) ) + " " + hb_ntos(pdfM2Y( x1 )) + " " + hb_ntos(pdfM2X( y2 - y1 )) + " -" + hb_ntos(pdfM2X( nBorder )) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos(pdfM2X( y2 - nBorder )) + " " + hb_ntos(pdfM2Y( x1 )) + " " + hb_ntos(pdfM2X( nBorder )) + " -" + hb_ntos(pdfM2X( x2 - x1 )) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos(pdfM2X( y1 )) + " " + hb_ntos(pdfM2Y( x2 - nBorder )) + " " + hb_ntos(pdfM2X( y2 - y1 )) + " -" + hb_ntos(pdfM2X( nBorder )) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos(pdfM2X( y1 )) + " " + hb_ntos(pdfM2Y( x1 )) + " " + hb_ntos(pdfM2X( nBorder )) + " -" + hb_ntos(pdfM2X( x2 - x1 )) + " re f" ENDIF ELSEIF cUnits == "D"// "Dots" //x1, y1, x2, y2 - nTop, nLeft, nBottom, nRight IF nShade > 0 // version 0.02 - t_aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + ltrim(str( y1 )) + " " + ltrim(str( t_aReport[ PAGEY ] - x1 )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( x2 - x1 )) + " re f 0 g" + t_aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + hb_ntos( y1 ) + " " + hb_ntos( t_aReport[ PAGEY ] - x1 ) + " " + hb_ntos( y2 - y1 ) + " -" + hb_ntos( x2 - x1 ) + " re f 0 g" ENDIF IF nBorder > 0 @@ -305,10 +305,10 @@ DEFAULT cColor to "" +-----+ 3 */ - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( t_aReport[ PAGEY ] - x1 )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( nBorder )) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y2 - nBorder )) + " " + ltrim(str( t_aReport[ PAGEY ] - x1 )) + " " + ltrim(str( nBorder )) + " -" + ltrim(str( x2 - x1 )) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( t_aReport[ PAGEY ] - x2 + nBorder )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( nBorder )) + " re f" - t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( t_aReport[ PAGEY ] - x1 )) + " " + ltrim(str( nBorder )) + " -" + ltrim(str( x2 - x1 )) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos( y1 ) + " " + hb_ntos( t_aReport[ PAGEY ] - x1 ) + " " + hb_ntos( y2 - y1 ) + " -" + hb_ntos( nBorder ) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos( y2 - nBorder ) + " " + hb_ntos( t_aReport[ PAGEY ] - x1 ) + " " + hb_ntos( nBorder ) + " -" + hb_ntos( x2 - x1 ) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos( y1 ) + " " + hb_ntos( t_aReport[ PAGEY ] - x2 + nBorder ) + " " + hb_ntos( y2 - y1 ) + " -" + hb_ntos( nBorder ) + " re f" + t_aReport[ PAGEBUFFER ] += CRLF + "0 g " + hb_ntos( y1 ) + " " + hb_ntos( t_aReport[ PAGEY ] - x1 ) + " " + hb_ntos( nBorder ) + " -" + hb_ntos( x2 - x1 ) + " re f" ENDIF ENDIF @@ -332,11 +332,11 @@ DEFAULT cBoxColor to chr(255) + chr(255) + chr(255) Chr_RGB( substr( cBoxColor, 2, 1 )) + " " + ; Chr_RGB( substr( cBoxColor, 3, 1 )) + ; " rg" + ; - CRLF + ltrim(str( nBorderWidth )) + " w" + ; - CRLF + ltrim( str ( nLeft + nBorderWidth / 2 )) + " " + ; - CRLF + ltrim( str ( t_aReport[ PAGEY ] - nBottom + nBorderWidth / 2)) + " " + ; - CRLF + ltrim( str ( nRight - nLeft - nBorderWidth )) + ; - CRLF + ltrim( str ( nBottom - nTop - nBorderWidth )) + " " + ; + CRLF + hb_ntos( nBorderWidth ) + " w" + ; + CRLF + hb_ntos( nLeft + nBorderWidth / 2 ) + " " + ; + CRLF + hb_ntos( t_aReport[ PAGEY ] - nBottom + nBorderWidth / 2 ) + " " + ; + CRLF + hb_ntos( nRight - nLeft - nBorderWidth ) + ; + CRLF + hb_ntos( nBottom - nTop - nBorderWidth ) + " " + ; " re" + ; CRLF + "B" return nil @@ -355,7 +355,7 @@ DEFAULT nCol to iif( cUnits == "R", t_aReport[ REPORTWIDTH ] / 2, t_aReport[ PAG ENDIF IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( pdfPageNumber())) + substr( cString, nAt + 12 ) + cString := left( cString, nAt - 1 ) + hb_ntos( pdfPageNumber() ) + substr( cString, nAt + 12 ) ENDIF nLen := pdfLen( cString ) / 2 @@ -392,11 +392,11 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen cTemp := ; "1 0 obj"+CRLF+; "<<"+CRLF+; - "/Type /Pages /Count " + ltrim(str(t_aReport[ REPORTPAGE ])) + CRLF +; + "/Type /Pages /Count " + hb_ntos( t_aReport[ REPORTPAGE ] ) + CRLF +; "/Kids [" for nI := 1 to t_aReport[ REPORTPAGE ] - cTemp += " " + ltrim(str( t_aReport[ PAGES ][ nI ] )) + " 0 R" + cTemp += " " + hb_ntos( t_aReport[ PAGES ][ nI ] ) + " 0 R" next cTemp += " ]" + CRLF + ; @@ -409,7 +409,7 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen // info ++t_aReport[ REPORTOBJ ] aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) - cTemp := ltrim(str( t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; + cTemp := hb_ntos( t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + ; "<<" + CRLF + ; "/Producer ()" + CRLF + ; "/Title ()" + CRLF + ; @@ -426,8 +426,8 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen // root ++t_aReport[ REPORTOBJ ] aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) - cTemp := ltrim(str( t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - "<< /Type /Catalog /Pages 1 0 R /Outlines " + ltrim(str( t_aReport[ REPORTOBJ ] + 1 )) + " 0 R" + iif( ( nBookLen := len( t_aReport[ BOOKMARK ] )) > 0, " /PageMode /UseOutlines", "") + " >>" + CRLF + "endobj" + CRLF + cTemp := hb_ntos( t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + ; + "<< /Type /Catalog /Pages 1 0 R /Outlines " + hb_ntos( t_aReport[ REPORTOBJ ] + 1 ) + " 0 R" + iif( ( nBookLen := len( t_aReport[ BOOKMARK ] )) > 0, " /PageMode /UseOutlines", "") + " >>" + CRLF + "endobj" + CRLF t_aReport[ DOCLEN ] += len( cTemp ) fwrite( t_aReport[ HANDLE ], cTemp ) @@ -457,7 +457,7 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen nLast += t_aReport[ REPORTOBJ ] - cTemp := ltrim(str( t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + "<< /Type /Outlines /Count " + ltrim(str( nCount )) + " /First " + ltrim(str( nFirst )) + " 0 R /Last " + ltrim(str( nLast )) + " 0 R >>" + CRLF + "endobj" //+ CRLF + cTemp := hb_ntos( t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + "<< /Type /Outlines /Count " + hb_ntos( nCount ) + " /First " + hb_ntos( nFirst ) + " 0 R /Last " + hb_ntos( nLast ) + " 0 R >>" + CRLF + "endobj" //+ CRLF aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) t_aReport[ DOCLEN ] += len( cTemp ) fwrite( t_aReport[ HANDLE ], cTemp ) @@ -465,16 +465,16 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen ++t_aReport[ REPORTOBJ ] nRecno := 1 FOR nI := 1 to nBookLen - cTemp := CRLF + ltrim(str( t_aReport[ REPORTOBJ ] + nI - 1 )) + " 0 obj" + CRLF + ; + cTemp := CRLF + hb_ntos( t_aReport[ REPORTOBJ ] + nI - 1 ) + " 0 obj" + CRLF + ; "<<" + CRLF + ; - "/Parent " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPARENT ])) + " 0 R" + CRLF + ; - "/Dest [" + ltrim(str( t_aReport[ PAGES ][ t_aReport[ BOOKMARK ][ nRecno ][ BOOKPAGE ] ] )) + " 0 R /XYZ 0 " + ltrim( str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOORD ])) + " 0]" + CRLF + ; + "/Parent " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPARENT ]) + " 0 R" + CRLF + ; + "/Dest [" + hb_ntos( t_aReport[ PAGES ][ t_aReport[ BOOKMARK ][ nRecno ][ BOOKPAGE ] ] ) + " 0 R /XYZ 0 " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOORD ] ) + " 0]" + CRLF + ; "/Title (" + alltrim( t_aReport[ BOOKMARK ][ nRecno ][ BOOKTITLE ]) + ")" + CRLF + ; - iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ] > 0, "/Prev " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ])) + " 0 R" + CRLF, "") + ; - iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ] > 0, "/Next " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ])) + " 0 R" + CRLF, "") + ; - iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ] > 0, "/First " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ])) + " 0 R" + CRLF, "") + ; - iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ] > 0, "/Last " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ])) + " 0 R" + CRLF, "") + ; - iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ] != 0, "/Count " + ltrim(str( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ])) + CRLF, "") + ; + iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ] > 0, "/Prev " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ]) + " 0 R" + CRLF, "") + ; + iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ] > 0, "/Next " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ]) + " 0 R" + CRLF, "") + ; + iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ] > 0, "/First " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ]) + " 0 R" + CRLF, "") + ; + iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ] > 0, "/Last " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ]) + " 0 R" + CRLF, "") + ; + iif( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ] != 0, "/Count " + hb_ntos( t_aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ]) + CRLF, "") + ; ">>" + CRLF + "endobj" + CRLF aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] + 2 ) @@ -486,7 +486,7 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen t_aReport[ REPORTOBJ ] += nBookLen - 1 ELSE - cTemp := ltrim(str( t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + "<< /Type /Outlines /Count 0 >>" + CRLF + "endobj" + CRLF + cTemp := hb_ntos( t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + "<< /Type /Outlines /Count 0 >>" + CRLF + "endobj" + CRLF aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) t_aReport[ DOCLEN ] += len( cTemp ) fwrite( t_aReport[ HANDLE ], cTemp ) @@ -498,16 +498,16 @@ local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen ++t_aReport[ REPORTOBJ ] cTemp += "xref" + CRLF + ; - "0 " + ltrim(str( t_aReport[ REPORTOBJ ] )) + CRLF +; + "0 " + hb_ntos( t_aReport[ REPORTOBJ ] ) + CRLF +; padl( t_aReport[ REFS ][ 1 ], 10, "0") + " 65535 f" + CRLF for nI := 2 to len( t_aReport[ REFS ] ) cTemp += padl( t_aReport[ REFS ][ nI ], 10, "0") + " 00000 n" + CRLF next - cTemp += "trailer << /Size " + ltrim(str( t_aReport[ REPORTOBJ ] )) + " /Root " + ltrim(str( nObj1 - 1 )) + " 0 R /Info " + ltrim(str( nObj1 - 2 )) + " 0 R >>" + CRLF + ; + cTemp += "trailer << /Size " + hb_ntos( t_aReport[ REPORTOBJ ] ) + " /Root " + hb_ntos( nObj1 - 1 ) + " 0 R /Info " + hb_ntos( nObj1 - 2 ) + " 0 R >>" + CRLF + ; "startxref" + CRLF + ; - ltrim(str( t_aReport[ DOCLEN ] )) + CRLF + ; + hb_ntos( t_aReport[ DOCLEN ] ) + CRLF + ; "%%EOF" + CRLF fwrite( t_aReport[ HANDLE ], cTemp ) /* @@ -531,13 +531,13 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle aadd( t_aReport[ PAGES ], t_aReport[ REPORTOBJ ] + 1 ) cTemp := ; - ltrim(str( ++t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; + hb_ntos( ++t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + ; "<<" + CRLF + ; "/Type /Page /Parent 1 0 R" + CRLF + ; - "/Resources " + ltrim(str( ++t_aReport[ REPORTOBJ ] )) + " 0 R" + CRLF + ; + "/Resources " + hb_ntos( ++t_aReport[ REPORTOBJ ] ) + " 0 R" + CRLF + ; "/MediaBox [ 0 0 " + ltrim(transform( t_aReport[ PAGEX ], "9999.99")) + " " + ; ltrim(transform(t_aReport[ PAGEY ], "9999.99")) + " ]" + CRLF + ; - "/Contents " + ltrim(str( ++t_aReport[ REPORTOBJ ] )) + " 0 R" + CRLF + ; + "/Contents " + hb_ntos( ++t_aReport[ REPORTOBJ ] ) + " 0 R" + CRLF + ; ">>" + CRLF + ; "endobj" + CRLF @@ -546,7 +546,7 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) cTemp := ; - ltrim(str(t_aReport[ REPORTOBJ ] - 1)) + " 0 obj" + CRLF + ; + hb_ntos( t_aReport[ REPORTOBJ ] - 1 ) + " 0 obj" + CRLF + ; "<<"+CRLF+; "/ColorSpace << /DeviceRGB /DeviceGray >>" + CRLF + ; //version 0.01 "/ProcSet [ /PDF /Text /ImageB /ImageC ]" @@ -558,7 +558,7 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle for nI := 1 to len( t_aReport[ PAGEFONTS ] ) nFont := ascan( t_aReport[ FONTS ], {| arr | arr[ 1 ] == t_aReport[ PAGEFONTS ][ nI ] } ) - cTemp += CRLF + "/Fo" + ltrim(str( nFont )) + " " + ltrim(str( t_aReport[ FONTS ][ nFont ][ 2 ])) + " 0 R" + cTemp += CRLF + "/Fo" + hb_ntos( nFont ) + " " + hb_ntos( t_aReport[ FONTS ][ nFont ][ 2 ]) + " 0 R" next cTemp += CRLF + ">>" @@ -572,7 +572,7 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle aadd( t_aReport[ IMAGES ], { t_aReport[ PAGEIMAGES ][ nI ][ 1 ], ++t_aReport[ NEXTOBJ ], pdfImageInfo( t_aReport[ PAGEIMAGES ][ nI ][ 1 ] ) } ) nImage := len( t_aReport[ IMAGES ] ) ENDIF - cTemp += CRLF + "/Image" + ltrim(str( nImage )) + " " + ltrim(str( t_aReport[ IMAGES ][ nImage ][ 2 ])) + " 0 R" + cTemp += CRLF + "/Image" + hb_ntos( nImage ) + " " + hb_ntos( t_aReport[ IMAGES ][ nImage ][ 2 ]) + " 0 R" next cTemp += CRLF + ">>" ENDIF @@ -583,8 +583,8 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle fwrite( t_aReport[ HANDLE ], cTemp ) aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) - cTemp := ltrim(str( t_aReport[ REPORTOBJ ] )) + " 0 obj << /Length " + ; - ltrim(str( t_aReport[ REPORTOBJ ] + 1 )) + " 0 R >>" + CRLF +; + cTemp := hb_ntos( t_aReport[ REPORTOBJ ] ) + " 0 obj << /Length " + ; + hb_ntos( t_aReport[ REPORTOBJ ] + 1 ) + " 0 R >>" + CRLF +; "stream" t_aReport[ DOCLEN ] += len( cTemp ) @@ -595,13 +595,13 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle for nI := 1 to len( t_aReport[ PAGEIMAGES ] ) cTemp += CRLF + "q" nImage := ascan( t_aReport[ IMAGES ], {| arr | arr[ 1 ] == t_aReport[ PAGEIMAGES ][ nI ][ 1 ] } ) - cTemp += CRLF + ltrim(str( iif( t_aReport[ PAGEIMAGES ][ nI ][ 5 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_WIDTH ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_XRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 5 ]))) + ; + cTemp += CRLF + hb_ntos( iif( t_aReport[ PAGEIMAGES ][ nI ][ 5 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_WIDTH ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_XRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 5 ])) + ; " 0 0 " + ; - ltrim(str( iif( t_aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 4 ]))) + ; - " " + ltrim(str( t_aReport[ PAGEIMAGES ][ nI ][ 3 ] )) + ; - " " + ltrim(str( t_aReport[ PAGEY ] - t_aReport[ PAGEIMAGES ][ nI ][ 2 ] - ; - iif( t_aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 4 ]))) + " cm" - cTemp += CRLF + "/Image" + ltrim(str( nImage )) + " Do" + hb_ntos( iif( t_aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 4 ])) + ; + " " + hb_ntos( t_aReport[ PAGEIMAGES ][ nI ][ 3 ] ) + ; + " " + hb_ntos( t_aReport[ PAGEY ] - t_aReport[ PAGEIMAGES ][ nI ][ 2 ] - ; + iif( t_aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, pdfM2X( t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / t_aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), t_aReport[ PAGEIMAGES ][ nI ][ 4 ])) + " cm" + cTemp += CRLF + "/Image" + hb_ntos( nImage ) + " Do" cTemp += CRLF + "Q" next t_aReport[ PAGEBUFFER ] := cTemp + t_aReport[ PAGEBUFFER ] @@ -617,8 +617,8 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) - cTemp := ltrim(str( ++t_aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - ltrim(str(len( t_aReport[ PAGEBUFFER ] ))) + CRLF + ; + cTemp := hb_ntos( ++t_aReport[ REPORTOBJ ] ) + " 0 obj" + CRLF + ; + hb_ntos( len( t_aReport[ PAGEBUFFER ] )) + CRLF + ; "endobj" + CRLF t_aReport[ DOCLEN ] += len( cTemp ) @@ -630,11 +630,11 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle aadd( t_aReport[ REFS ], t_aReport[ DOCLEN ] ) cTemp := ; - ltrim(str( t_aReport[ FONTS ][ nI ][ 2 ] )) + " 0 obj" + CRLF + ; + hb_ntos( t_aReport[ FONTS ][ nI ][ 2 ] ) + " 0 obj" + CRLF + ; "<<" + CRLF + ; "/Type /Font" + CRLF + ; "/Subtype /Type1" + CRLF + ; - "/Name /Fo" + ltrim(str( nI )) + CRLF + ; + "/Name /Fo" + hb_ntos( nI ) + CRLF + ; "/BaseFont /" + t_aReport[ TYPE1 ][ t_aReport[ FONTS ][ nI ][ 1 ] ] + CRLF + ; "/Encoding /WinAnsiEncoding" + CRLF + ; ">>" + CRLF + ; @@ -653,17 +653,17 @@ local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle // "/Filter /CCITTFaxDecode" for B&W only ? cTemp := ; - ltrim(str( t_aReport[ IMAGES ][ nI ][ 2 ] )) + " 0 obj" + CRLF + ; + hb_ntos( t_aReport[ IMAGES ][ nI ][ 2 ] ) + " 0 obj" + CRLF + ; "<<" + CRLF + ; "/Type /XObject" + CRLF + ; "/Subtype /Image" + CRLF + ; - "/Name /Image" + ltrim(str(nI)) + CRLF + ; + "/Name /Image" + hb_ntos(nI) + CRLF + ; "/Filter [" + iif( at( ".jpg", lower( t_aReport[ IMAGES ][ nI ][ 1 ]) ) > 0, " /DCTDecode", "" ) + " ]" + CRLF + ; - "/Width " + ltrim(str( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_WIDTH ] )) + CRLF + ; - "/Height " + ltrim(str( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_HEIGHT ] )) + CRLF + ; - "/BitsPerComponent " + ltrim(str( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_BITS ] )) + CRLF + ; + "/Width " + hb_ntos( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_WIDTH ] ) + CRLF + ; + "/Height " + hb_ntos( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_HEIGHT ] ) + CRLF + ; + "/BitsPerComponent " + hb_ntos( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_BITS ] ) + CRLF + ; "/ColorSpace /" + iif( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_SPACE ] == 1, "DeviceGray", "DeviceRGB") + CRLF + ; - "/Length " + ltrim(str( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ])) + CRLF + ; + "/Length " + hb_ntos( t_aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ]) + CRLF + ; ">>" + CRLF + ; "stream" + CRLF @@ -1057,7 +1057,7 @@ DEFAULT lExact to .F. ENDIF IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( pdfPageNumber())) + substr( cString, nAt + 12 ) + cString := left( cString, nAt - 1 ) + hb_ntos( pdfPageNumber()) + substr( cString, nAt + 12 ) ENDIF nLen := pdfLen( cString ) @@ -1104,7 +1104,7 @@ return nil ========================= */ function pdfSetLPI(_nLpi) /* ========================= */ -local cLpi := alltrim(str(_nLpi)) +local cLpi := hb_ntos(_nLpi) DEFAULT _nLpi to 6 cLpi := iif(cLpi$"1;2;3;4;6;8;12;16;24;48",cLpi,"6") @@ -1415,7 +1415,7 @@ local nId, nI, nLen, nIdLen ENDIF next ++nId - cId += ltrim(str(nId)) + cId += hb_ntos(nId) ENDIF aadd( t_aReport[ HEADER ], { .T., cFunction, cId } ) ++nLen @@ -1783,7 +1783,7 @@ local nWidth := 0, nHeight := 0, nBits := 0, nFrom := 0, nLength := 0, xRes := 0 nIFD := bin2l( cIFDNext ) fseek( nHandle, nIFD ) - //?'*** IFD ' + ltrim(str( ++nPages )) + //?'*** IFD ' + hb_ntos( ++nPages ) fread( nHandle, @c2, 2 ) nFields := bin2i( c2 ) @@ -2236,11 +2236,11 @@ local nWidth := 0, nHeight := 0, nBits := 0, nFrom := 0, nLength := 0, xRes := 0 endcase /* ??padr( cTag, 30 ) - ??' type ' + padr(aType[ nFieldType ], 10) + ' count ' + ltrim(str(nCount)) + ' <' + ??' type ' + padr(aType[ nFieldType ], 10) + ' count ' + hb_ntos(nCount) + ' <' do case case nFieldType == BYTE for nI := 1 to nCount - ??' ' + ltrim(str(asc( substr( cValues, nI, 1 )))) + ??' ' + hb_ntos(asc( substr( cValues, nI, 1 ))) next case nFieldType == ASCII ??' ' @@ -2249,19 +2249,19 @@ local nWidth := 0, nHeight := 0, nBits := 0, nFrom := 0, nLength := 0, xRes := 0 next case nFieldType == SHORT for nI := 1 to nCount - ??' ' + ltrim(str(bin2w(substr( cValues, ( nI - 1 ) * 2 + 1, 2 )))) + ??' ' + hb_ntos(bin2w(substr( cValues, ( nI - 1 ) * 2 + 1, 2 ))) next case nFieldType == LONG for nI := 1 to nCount - ??' ' + ltrim(str(bin2l(substr( cValues, ( nI - 1 ) * 4 + 1, 4 )))) + ??' ' + hb_ntos(bin2l(substr( cValues, ( nI - 1 ) * 4 + 1, 4 ))) next case nFieldType == RATIONAL for nI := 1 to nCount - ??' ' + ltrim(str(bin2l(substr( cValues, ( nI - 1 ) * 8 + 1, 4 )))) + '/' + ltrim(str(bin2l(substr( cValues, nI + 4, 4 )))) + ??' ' + hb_ntos(bin2l(substr( cValues, ( nI - 1 ) * 8 + 1, 4 ))) + '/' + hb_ntos(bin2l(substr( cValues, nI + 4, 4 ))) next case nFieldType == SBYTE for nI := 1 to nCount - ??' ' + ltrim(str(asc( substr( cValues, nI, 1 )))) + ??' ' + hb_ntos(asc( substr( cValues, nI, 1 ))) next case nFieldType == UNDEFINED for nI := 1 to nCount @@ -2269,20 +2269,20 @@ local nWidth := 0, nHeight := 0, nBits := 0, nFrom := 0, nLength := 0, xRes := 0 next case nFieldType == SSHORT for nI := 1 to nCount - ??' ' + ltrim(str(bin2i(substr( cValues, ( nI - 1 ) * 2 + 1, 2 )))) + ??' ' + hb_ntos(bin2i(substr( cValues, ( nI - 1 ) * 2 + 1, 2 ))) next case nFieldType == SLONG for nI := 1 to nCount - ??' ' + ltrim(str(bin2l(substr( cValues, ( nI - 1 ) * 4 + 1, 4 )))) + ??' ' + hb_ntos(bin2l(substr( cValues, ( nI - 1 ) * 4 + 1, 4 ))) next case nFieldType == SRATIONAL for nI := 1 to nCount - ??' ' + ltrim(str(bin2l(substr( cValues, ( nI - 1 ) * 8 + 1, 4 )))) + '/' + ltrim(str(bin2l(substr( cValues, nI + 4, 4 )))) + ??' ' + hb_ntos(bin2l(substr( cValues, ( nI - 1 ) * 8 + 1, 4 ))) + '/' + hb_ntos(bin2l(substr( cValues, nI + 4, 4 ))) next case nFieldType == FLOAT case nFieldType == DOUBLE for nI := 1 to nCount - ??' ' + ltrim(str(ctof(substr( cValues, ( nI - 1 ) * 8 + 1, 8 )))) + ??' ' + hb_ntos(ctof(substr( cValues, ( nI - 1 ) * 8 + 1, 8 ))) next endcase @@ -2448,7 +2448,7 @@ local cData := valtype(xData) if HB_ISSTRING(xData) cData += i2bin(len(xData))+xData elseif HB_ISNUMERIC(xData) - cData += i2bin(len(alltrim(str(xData))) )+alltrim(str(xData)) + cData += i2bin(len(alhb_ntos(xData)) )+hb_ntos(str(xData)) elseif HB_ISDATE(xData) cData += i2bin(8)+dtos(xData) elseif HB_ISLOGICAL(xData) diff --git a/harbour/extras/hbvpdf/hbvpdft.prg b/harbour/extras/hbvpdf/hbvpdft.prg deleted file mode 100644 index 6c9861061d..0000000000 --- a/harbour/extras/hbvpdf/hbvpdft.prg +++ /dev/null @@ -1,2647 +0,0 @@ -/* - * $Id$ - */ - -//--- -// -// Program Cl_Pdf.prg -// -// Original : Victor K. . http://www.ihaveparts.com -// -// Class Code : Pritpal Bedi . http://www.vouchcac.com -// -//--- - -#ifndef __HARBOUR__ - #ifndef __XPP__ - #define __CLP__ - #endif -#endif - -#ifdef __HARBOUR__ - #include "hbclass.ch" -#endif - -#ifdef __XPP__ // Xbase++ - #command CREATE CLASS [ FROM ] => CLASS [ FROM ] - #command MESSAGE METHOD => METHOD IS - #command CLASS MESSAGE METHOD => CLASS METHOD IS -#endif - -#ifdef __CLP__ // Clipper - #include "class(y).ch" -#endif - -#define LEFTEQUAL( l, r ) ( Left( l, Len( r ) ) == r ) - -//--- - -#include "hbvpdf.ch" - -//--- - -CREATE CLASS tPdf - -#ifndef __HARBOUR__ -EXPORT: -#endif - -VAR aReport - -#ifndef __HARBOUR__ -EXPORT: -#endif - -#ifdef __HARBOUR__ -METHOD Init( cFile, nLen, lOptimize ) CONSTRUCTOR -#else -METHOD Init -#endif - -METHOD AtSay -METHOD Normal -METHOD Bold -METHOD Italic -METHOD UnderLine -METHOD BoldItalic -METHOD BookAdd -METHOD BookClose -METHOD BookOpen -METHOD Box -METHOD Box1 -METHOD Center -METHOD Close -METHOD Image -METHOD Length -METHOD NewLine -METHOD NewPage -METHOD PageSize -METHOD PageOrient -METHOD PageNumber -METHOD Reverse -METHOD RJust -METHOD SetFont -METHOD SetLPI -METHOD StringB -METHOD TextCount -METHOD Text -METHOD OpenHeader -METHOD EditOnHeader -METHOD EditOffHeader -METHOD CloseHeader -METHOD DeleteHeader -METHOD EnableHeader -METHOD DisableHeader -METHOD SaveHeader -METHOD Header -METHOD DrawHeader -METHOD Margins -METHOD CreateHeader -METHOD ImageInfo -METHOD TIFFInfo -METHOD JPEGInfo -METHOD FilePrint -METHOD BookCount -METHOD BookFirst -METHOD BookLast -METHOD BookNext -METHOD BookParent -METHOD BookPrev -METHOD CheckLine -METHOD ClosePage -METHOD GetFontInfo -METHOD M2R -METHOD M2X -METHOD M2Y -METHOD R2D -METHOD R2M -METHOD X2M -METHOD TextPrint -METHOD TextNextPara -METHOD Execute - -ENDCLASS - -//--- - -#ifdef __XPP__ -METHOD tPdf:Init( cFile, nLen, lOptimize ) -#else -METHOD Init( cFile, nLen, lOptimize ) -#endif - -local cTemp, nI, nJ, n1, n2 := 896, n12 - -DEFAULT nLen TO 200 -DEFAULT lOptimize TO .F. - -::aReport := array( PARAMLEN ) - -::aReport[ FONTNAME ] := 1 -::aReport[ FONTSIZE ] := 10 -::aReport[ LPI ] := 6 -::aReport[ PAGESIZE ] := "LETTER" -::aReport[ PAGEORIENT ] := "P" -::aReport[ PAGEX ] := 8.5 * 72 -::aReport[ PAGEY ] := 11.0 * 72 -::aReport[ REPORTWIDTH ] := nLen // 200 // should be as parameter -::aReport[ REPORTPAGE ] := 0 -::aReport[ REPORTLINE ] := 0 // 5 -::aReport[ FONTNAMEPREV ] := 0 -::aReport[ FONTSIZEPREV ] := 0 -::aReport[ PAGEBUFFER ] := "" -::aReport[ REPORTOBJ ] := 1 //2 -::aReport[ DOCLEN ] := 0 -::aReport[ TYPE1 ] := { "Times-Roman", "Times-Bold", "Times-Italic", "Times-BoldItalic", ; - "Helvetica", "Helvetica-Bold", "Helvetica-Oblique", "Helvetica-BoldOblique", ; - "Courier", "Courier-Bold", "Courier-Oblique", "Courier-BoldOblique" } -::aReport[ MARGINS ] := .T. -::aReport[ HEADEREDIT ] := .F. -::aReport[ NEXTOBJ ] := 0 -::aReport[ PDFTOP ] := 1 // top -::aReport[ PDFLEFT ] := 10 // left & right -::aReport[ PDFBOTTOM ] := ::aReport[ PAGEY ] / 72 * ::aReport[ LPI ] - 1 // bottom, default "LETTER", "P", 6 -::aReport[ HANDLE ] := fcreate( cFile ) -::aReport[ PAGES ] := {} -::aReport[ REFS ] := { 0, 0 } -::aReport[ BOOKMARK ] := {} -::aReport[ HEADER ] := {} -::aReport[ FONTS ] := {} -::aReport[ IMAGES ] := {} -::aReport[ PAGEIMAGES ] := {} -::aReport[ PAGEFONTS ] := {} - -cTemp := vpdf_FontsDat() -n1 := len( cTemp ) / ( 2 * n2 ) -::aReport[ FONTWIDTH ] := array( n1, n2 ) - -::aReport[ OPTIMIZE ] := lOptimize -::aReport[ NEXTOBJ ] := ::aReport[ REPORTOBJ ] + 4 - -n12 := 2 * n2 -for nI := 1 to n1 - for nJ := 1 to n2 - ::aReport[ FONTWIDTH ][ nI ][ nJ ] := bin2i( substr( cTemp, ( nI - 1 ) * n12 + ( nJ - 1 ) * 2 + 1, 2 ) ) - next -next - -::aReport[ DOCLEN ] := 0 -cTemp := "%PDF-1.3" + CRLF -::aReport[ DOCLEN ] += len( cTemp ) - -fwrite( ::aReport[ HANDLE ], cTemp ) - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:AtSay( cString, nRow, nCol, cUnits, lExact, cId ) -#else -METHOD AtSay( cString, nRow, nCol, cUnits, lExact, cId ) -#endif - -local _nFont, lReverse, nAt - -DEFAULT nRow TO ::aReport[ REPORTLINE ] -DEFAULT cUnits TO "R" -DEFAULT lExact TO .F. -DEFAULT cId TO "" - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFATSAY", cId, { cString, nRow, nCol, cUnits, lExact } ) - ENDIF - - IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( ::PageNumber())) + substr( cString, nAt + 12 ) - ENDIF - - lReverse := .F. - IF cUnits == "M" - nRow := ::M2Y( nRow ) - nCol := ::M2X( nCol ) - ELSEIF cUnits == "R" - IF .not. lExact - ::CheckLine( nRow ) - nRow := nRow + ::aReport[ PDFTOP] - ENDIF - nRow := ::R2D( nRow ) - nCol := ::M2X( ::aReport[ PDFLEFT ] ) + ; - nCol * 100.00 / ::aReport[ REPORTWIDTH ] * ; - ( ::aReport[ PAGEX ] - ::M2X( ::aReport[ PDFLEFT ] ) * 2 - 9.0 ) / 100.00 - ENDIF - IF !empty( cString ) - cString := ::StringB( cString ) - IF right( cString, 1 ) == chr(255) //reverse - cString := left( cString, len( cString ) - 1 ) - ::Box( ::aReport[ PAGEY ] - nRow - ::aReport[ FONTSIZE ] + 2.0 , nCol, ::aReport[ PAGEY ] - nRow + 2.0, nCol + ::M2X( ::length( cString )) + 1,,100, "D") - ::aReport[ PAGEBUFFER ] += " 1 g " - lReverse := .T. - ELSEIF right( cString, 1 ) == chr(254) //underline - cString := left( cString, len( cString ) - 1 ) - ::Box( ::aReport[ PAGEY ] - nRow + 0.5, nCol, ::aReport[ PAGEY ] - nRow + 1, nCol + ::M2X( ::length( cString )) + 1,,100, "D") - ENDIF - - // version 0.01 - IF ( nAt := at( chr(253), cString )) > 0 // some color text inside - ::aReport[ PAGEBUFFER ] += CRLF + ; - Chr_RGB( substr( cString, nAt + 1, 1 )) + " " + ; - Chr_RGB( substr( cString, nAt + 2, 1 )) + " " + ; - Chr_RGB( substr( cString, nAt + 3, 1 )) + " rg " - cString := stuff( cString, nAt, 4, "") - ENDIF - // version 0.01 - - _nFont := ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ]} ) - IF !( ::aReport[ FONTNAME ] == ::aReport[ FONTNAMEPREV ] ) - ::aReport[ FONTNAMEPREV ] := ::aReport[ FONTNAME ] - ::aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + ltrim(str( _nFont )) + " " + ltrim(transform( ::aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" - ELSEIF ::aReport[ FONTSIZE ] != ::aReport[ FONTSIZEPREV ] - ::aReport[ FONTSIZEPREV ] := ::aReport[ FONTSIZE ] - ::aReport[ PAGEBUFFER ] += CRLF + "BT /Fo" + ltrim(str( _nFont )) + " " + ltrim(transform( ::aReport[ FONTSIZE ], "999.99")) + " Tf " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" - ELSE - ::aReport[ PAGEBUFFER ] += CRLF + "BT " + ltrim(transform( nCol, "9999.99" )) + " " + ltrim(transform( nRow, "9999.99" )) + " Td (" + cString + ") Tj ET" - ENDIF - IF lReverse - ::aReport[ PAGEBUFFER ] += " 0 g " - ENDIF - ENDIF - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Normal() -#else -METHOD Normal() -#endif -local cName := ::GetFontInfo( "NAME" ) - - IF cName == "Times" - ::aReport[ FONTNAME ] := 1 - ELSEIF cName == "Helvetica" - ::aReport[ FONTNAME ] := 5 - ELSE - ::aReport[ FONTNAME ] := 9 - ENDIF - aadd( ::aReport[ PAGEFONTS ], ::aReport[ FONTNAME ] ) - IF ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ] } ) == 0 - aadd( ::aReport[ FONTS ], { ::aReport[ FONTNAME ], ++::aReport[ NEXTOBJ ] } ) - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Italic() -#else -METHOD Italic() -#endif -local cName := ::GetFontInfo( "NAME" ) - - IF cName == "Times" - ::aReport[ FONTNAME ] := 3 - ELSEIF cName == "Helvetica" - ::aReport[ FONTNAME ] := 7 - ELSE - ::aReport[ FONTNAME ] := 11 - ENDIF - aadd( ::aReport[ PAGEFONTS ], ::aReport[ FONTNAME ] ) - IF ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ] } ) == 0 - aadd( ::aReport[ FONTS ], { ::aReport[ FONTNAME ], ++::aReport[ NEXTOBJ ] } ) - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Bold() -#else -METHOD Bold() -#endif -local cName := ::GetFontInfo( "NAME" ) - - IF cName == "Times" - ::aReport[ FONTNAME ] := 2 - ELSEIF cName == "Helvetica" - ::aReport[ FONTNAME ] := 6 - ELSEIF cName == "Courier" - ::aReport[ FONTNAME ] := 10 // Courier // 0.04 - ENDIF - - aadd( ::aReport[ PAGEFONTS ], ::aReport[ FONTNAME ] ) - IF ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ] } ) == 0 - aadd( ::aReport[ FONTS ], { ::aReport[ FONTNAME ], ++::aReport[ NEXTOBJ ] } ) - ENDIF - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:BoldItalic() -#else -METHOD BoldItalic() -#endif -local cName := ::GetFontInfo( "NAME" ) - -IF cName == "Times" - ::aReport[ FONTNAME ] := 4 -ELSEIF cName == "Helvetica" - ::aReport[ FONTNAME ] := 8 -ELSEIF cName == "Courier" - ::aReport[ FONTNAME ] := 12 // 0.04 -ENDIF - -aadd( ::aReport[ PAGEFONTS ], ::aReport[ FONTNAME ] ) -IF ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ] } ) == 0 - aadd( ::aReport[ FONTS ], { ::aReport[ FONTNAME ], ++::aReport[ NEXTOBJ ] } ) -ENDIF - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookAdd( cTitle, nLevel, nPage, nLine ) -#else -METHOD BookAdd( cTitle, nLevel, nPage, nLine ) -#endif - -aadd( ::aReport[ BOOKMARK ], { nLevel, alltrim( cTitle ), 0, 0, 0, 0, 0, 0, nPage, iif( nLevel == 1, ::aReport[ PAGEY ], ::aReport[ PAGEY ] - nLine * 72 / ::aReport[ LPI ] ) }) - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookClose( ) -#else -METHOD BookClose( ) -#endif - -::aReport[ BOOKMARK ] := nil - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookOpen( ) -#else -METHOD BookOpen( ) -#endif - -::aReport[ BOOKMARK ] := {} - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Box( x1, y1, x2, y2, nBorder, nShade, cUnits, cColor, cId ) -#else -METHOD Box( x1, y1, x2, y2, nBorder, nShade, cUnits, cColor, cId ) -#endif - -local cBoxColor - -DEFAULT nBorder TO 0 -DEFAULT nShade TO 0 -DEFAULT cUnits TO "M" -DEFAULT cColor TO "" - - cBoxColor := "" - IF !empty( cColor ) - cBoxColor := " " + Chr_RGB( substr( cColor, 2, 1 )) + " " + ; - Chr_RGB( substr( cColor, 3, 1 )) + " " + ; - Chr_RGB( substr( cColor, 4, 1 )) + " rg " - IF empty( alltrim( cBoxColor ) ) - cBoxColor := "" - ENDIF - ENDIF - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFBOX", cId, { x1, y1, x2, y2, nBorder, nShade, cUnits } ) - ENDIF - - IF cUnits == "M" - y1 += 0.5 - y2 += 0.5 - - IF nShade > 0 - ::aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + ltrim(str(::M2X( y1 ))) + " " + ltrim(str(::M2Y( x1 ))) + " " + ltrim(str(::M2X( y2 - y1 ))) + " -" + ltrim(str(::M2X( x2 - x1 ))) + " re f 0 g" - ENDIF - - IF nBorder > 0 - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(::M2X( y1 ))) + " " + ltrim(str(::M2Y( x1 ))) + " " + ltrim(str(::M2X( y2 - y1 ))) + " -" + ltrim(str(::M2X( nBorder ))) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(::M2X( y2 - nBorder ))) + " " + ltrim(str(::M2Y( x1 ))) + " " + ltrim(str(::M2X( nBorder ))) + " -" + ltrim(str(::M2X( x2 - x1 ))) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(::M2X( y1 ))) + " " + ltrim(str(::M2Y( x2 - nBorder ))) + " " + ltrim(str(::M2X( y2 - y1 ))) + " -" + ltrim(str(::M2X( nBorder ))) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str(::M2X( y1 ))) + " " + ltrim(str(::M2Y( x1 ))) + " " + ltrim(str(::M2X( nBorder ))) + " -" + ltrim(str(::M2X( x2 - x1 ))) + " re f" - ENDIF - ELSEIF cUnits == "D" // "Dots" - IF nShade > 0 - ::aReport[ PAGEBUFFER ] += CRLF + transform( 1.00 - nShade / 100.00, "9.99") + " g " + cBoxColor + ltrim(str( y1 )) + " " + ltrim(str( ::aReport[ PAGEY ] - x1 )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( x2 - x1 )) + " re f 0 g" - ENDIF - - IF nBorder > 0 -/* - 1 - +-----+ - 4 | | 2 - +-----+ - 3 -*/ - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( ::aReport[ PAGEY ] - x1 )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( nBorder )) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y2 - nBorder )) + " " + ltrim(str( ::aReport[ PAGEY ] - x1 )) + " " + ltrim(str( nBorder )) + " -" + ltrim(str( x2 - x1 )) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( ::aReport[ PAGEY ] - x2 + nBorder )) + " " + ltrim(str( y2 - y1 )) + " -" + ltrim(str( nBorder )) + " re f" - ::aReport[ PAGEBUFFER ] += CRLF + "0 g " + ltrim(str( y1 )) + " " + ltrim(str( ::aReport[ PAGEY ] - x1 )) + " " + ltrim(str( nBorder )) + " -" + ltrim(str( x2 - x1 )) + " re f" - ENDIF - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Box1( nTop, nLeft, nBottom, nRight, nBorderWidth, cBorderColor, cBoxColor ) -#else -METHOD Box1( nTop, nLeft, nBottom, nRight, nBorderWidth, cBorderColor, cBoxColor ) -#endif - -DEFAULT nBorderWidth to 0.5 -DEFAULT cBorderColor to chr(0) + chr(0) + chr(0) -DEFAULT cBoxColor to chr(255) + chr(255) + chr(255) - - ::aReport[ PAGEBUFFER ] += CRLF + ; - Chr_RGB( substr( cBorderColor, 1, 1 )) + " " + ; - Chr_RGB( substr( cBorderColor, 2, 1 )) + " " + ; - Chr_RGB( substr( cBorderColor, 3, 1 )) + ; - " RG" + ; - CRLF + ; - Chr_RGB( substr( cBoxColor, 1, 1 )) + " " + ; - Chr_RGB( substr( cBoxColor, 2, 1 )) + " " + ; - Chr_RGB( substr( cBoxColor, 3, 1 )) + ; - " rg" + ; - CRLF + ltrim(str( nBorderWidth )) + " w" + ; - CRLF + ltrim( str ( nLeft + nBorderWidth / 2 )) + " " + ; - CRLF + ltrim( str ( ::aReport[ PAGEY ] - nBottom + nBorderWidth / 2)) + " " + ; - CRLF + ltrim( str ( nRight - nLeft - nBorderWidth )) + ; - CRLF + ltrim( str ( nBottom - nTop - nBorderWidth )) + " " + ; - " re" + ; - CRLF + "B" -return nil - -//--- - -#ifdef __XPP__ -METHOD tPdf:Center( cString, nRow, nCol, cUnits, lExact, cId ) -#else -METHOD Center( cString, nRow, nCol, cUnits, lExact, cId ) -#endif - -local nLen, nAt -DEFAULT nRow TO ::aReport[ REPORTLINE ] -DEFAULT cUnits TO "R" -DEFAULT lExact TO .F. -DEFAULT nCol TO iif( cUnits == "R", ::aReport[ REPORTWIDTH ] / 2, ::aReport[ PAGEX ] / 72 * 25.4 / 2 ) - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFCENTER", cId, { cString, nRow, nCol, cUnits, lExact } ) - ENDIF - - IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( ::PageNumber())) + substr( cString, nAt + 12 ) - ENDIF - - nLen := ::length( cString ) / 2 - IF cUnits == "R" - IF .not. lExact - ::CheckLine( nRow ) - nRow := nRow + ::aReport[ PDFTOP] - ENDIF - ENDIF - ::AtSay( cString, ::R2M( nRow ), iif( cUnits == "R", ::aReport[ PDFLEFT ] + ( ::aReport[ PAGEX ] / 72 * 25.4 - 2 * ::aReport[ PDFLEFT ] ) * nCol / ::aReport[ REPORTWIDTH ], nCol ) - nLen, "M", lExact ) -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Close() -#else -METHOD Close() -#endif - -local nI, cTemp, nCurLevel, nObj1, nLast, nCount, nFirst, nRecno, nBooklen - -// FIELD FIRST, PREV, NEXT, LAST, COUNT, PARENT, PAGE, COORD, TITLE, LEVEL - - ::ClosePage() - - // kids - ::aReport[ REFS ][ 2 ] := ::aReport[ DOCLEN ] - cTemp := ; - "1 0 obj"+CRLF+; - "<<"+CRLF+; - "/Type /Pages /Count " + ltrim(str(::aReport[ REPORTPAGE ])) + CRLF +; - "/Kids [" - - for nI := 1 to ::aReport[ REPORTPAGE ] - cTemp += " " + ltrim(str( ::aReport[ PAGES ][ nI ] )) + " 0 R" - next - - cTemp += " ]" + CRLF + ; - ">>" + CRLF + ; - "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - // info - ++::aReport[ REPORTOBJ ] - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - cTemp := ltrim(str( ::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - "<<" + CRLF + ; - "/Producer ()" + CRLF + ; - "/Title ()" + CRLF + ; - "/Author ()" + CRLF + ; - "/Creator ()" + CRLF + ; - "/Subject ()" + CRLF + ; - "/Keywords ()" + CRLF + ; - "/CreationDate (D:" + str(year(date()), 4) + padl( month(date()), 2, "0") + padl( day(date()), 2, "0") + substr( time(), 1, 2 ) + substr( time(), 4, 2 ) + substr( time(), 7, 2 ) + ")" + CRLF + ; - ">>" + CRLF + ; - "endobj" + CRLF - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - // root - ++::aReport[ REPORTOBJ ] - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - cTemp := ltrim(str( ::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - "<< /Type /Catalog /Pages 1 0 R /Outlines " + ltrim(str( ::aReport[ REPORTOBJ ] + 1 )) + " 0 R" + iif( ( nBookLen := len( ::aReport[ BOOKMARK ] )) > 0, " /PageMode /UseOutlines", "") + " >>" + CRLF + "endobj" + CRLF - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - ++::aReport[ REPORTOBJ ] - nObj1 := ::aReport[ REPORTOBJ ] - - IF nBookLen > 0 - - nRecno := 1 - nFirst := ::aReport[ REPORTOBJ ] + 1 - nLast := 0 - nCount := 0 - while nRecno <= nBookLen - nCurLevel := ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - ::aReport[ BOOKMARK ][ nRecno ][ BOOKPARENT ] := ::BookParent( nRecno, nCurLevel, ::aReport[ REPORTOBJ ] ) - ::aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ] := ::BookPrev( nRecno, nCurLevel, ::aReport[ REPORTOBJ ] ) - ::aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ] := ::BookNext( nRecno, nCurLevel, ::aReport[ REPORTOBJ ] ) - ::aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ] := ::BookFirst( nRecno, nCurLevel, ::aReport[ REPORTOBJ ] ) - ::aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ] := ::BookLast( nRecno, nCurLevel, ::aReport[ REPORTOBJ ] ) - ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ] := ::BookCount( nRecno, nCurLevel ) - IF nCurLevel == 1 - nLast := nRecno - ++nCount - ENDIF - ++nRecno - enddo - - nLast += ::aReport[ REPORTOBJ ] - - cTemp := ltrim(str( ::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + "<< /Type /Outlines /Count " + ltrim(str( nCount )) + " /First " + ltrim(str( nFirst )) + " 0 R /Last " + ltrim(str( nLast )) + " 0 R >>" + CRLF + "endobj" //+ CRLF - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - ++::aReport[ REPORTOBJ ] - nRecno := 1 - FOR nI := 1 to nBookLen - //cTemp := IIF ( nI > 1, CRLF, "") + ltrim(str( ::aReport[ REPORTOBJ ] + nI - 1)) + " 0 obj" + CRLF + ; - cTemp := CRLF + ltrim(str( ::aReport[ REPORTOBJ ] + nI - 1)) + " 0 obj" + CRLF + ; - "<<" + CRLF + ; - "/Parent " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKPARENT ])) + " 0 R" + CRLF + ; - "/Dest [" + ltrim(str( ::aReport[ PAGES ][ ::aReport[ BOOKMARK ][ nRecno ][ BOOKPAGE ] ] )) + " 0 R /XYZ 0 " + ltrim( str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOORD ])) + " 0]" + CRLF + ; - "/Title (" + alltrim( ::aReport[ BOOKMARK ][ nRecno ][ BOOKTITLE ]) + ")" + CRLF + ; - iif( ::aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ] > 0, "/Prev " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKPREV ])) + " 0 R" + CRLF, "") + ; - iif( ::aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ] > 0, "/Next " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKNEXT ])) + " 0 R" + CRLF, "") + ; - iif( ::aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ] > 0, "/First " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKFIRST ])) + " 0 R" + CRLF, "") + ; - iif( ::aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ] > 0, "/Last " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKLAST ])) + " 0 R" + CRLF, "") + ; - iif( ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ] != 0, "/Count " + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOUNT ])) + CRLF, "") + ; - ">>" + CRLF + "endobj" + CRLF -// "/Dest [" + ltrim(str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKPAGE ] * 3 )) + " 0 R /XYZ 0 " + ltrim( str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOORD ])) + " 0]" + CRLF + ; -// "/Dest [" + ltrim(str( ::aReport[ PAGES ][ nRecno ] )) + " 0 R /XYZ 0 " + ltrim( str( ::aReport[ BOOKMARK ][ nRecno ][ BOOKCOORD ])) + " 0]" + CRLF + ; - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] + 2 ) - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - ++nRecno - NEXT - ::BookClose() - - ::aReport[ REPORTOBJ ] += nBookLen - 1 - ELSE - cTemp := ltrim(str( ::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + "<< /Type /Outlines /Count 0 >>" + CRLF + "endobj" + CRLF - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - ENDIF - - cTemp := CRLF - ::aReport[ DOCLEN ] += len( cTemp ) - - ++::aReport[ REPORTOBJ ] - cTemp += "xref" + CRLF + ; - "0 " + ltrim(str( ::aReport[ REPORTOBJ ] )) + CRLF +; - padl( ::aReport[ REFS ][ 1 ], 10, "0") + " 65535 f" + CRLF - - for nI := 2 to len( ::aReport[ REFS ] ) - cTemp += padl( ::aReport[ REFS ][ nI ], 10, "0") + " 00000 n" + CRLF - next - - cTemp += "trailer << /Size " + ltrim(str( ::aReport[ REPORTOBJ ] )) + " /Root " + ltrim(str( nObj1 - 1 )) + " 0 R /Info " + ltrim(str( nObj1 - 2 )) + " 0 R >>" + CRLF + ; - "startxref" + CRLF + ; - ltrim(str( ::aReport[ DOCLEN ] )) + CRLF + ; - "%%EOF" + CRLF - fwrite( ::aReport[ HANDLE ], cTemp ) - - fclose( ::aReport[ HANDLE ] ) - - ::aReport := nil - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Image( cFile, nRow, nCol, cUnits, nHeight, nWidth, cId ) -#else -METHOD Image( cFile, nRow, nCol, cUnits, nHeight, nWidth, cId ) -#endif - -DEFAULT nRow TO ::aReport[ REPORTLINE ] -DEFAULT nCol TO 0 -DEFAULT nHeight TO 0 -DEFAULT nWidth TO 0 -DEFAULT cUnits TO "R" -DEFAULT cId TO "" - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFIMAGE", cId, { cFile, nRow, nCol, cUnits, nHeight, nWidth } ) - ENDIF - - IF cUnits == "M" - nRow := ::aReport[ PAGEY ] - ::M2Y( nRow ) - nCol := ::M2X( nCol ) - nHeight := ::aReport[ PAGEY ] - ::M2Y( nHeight ) - nWidth := ::M2X( nWidth ) - ELSEIF cUnits == "R" - //IF .not. lExact - // ::CheckLine( nRow ) - // nRow := nRow + ::aReportStyle[ PDFTOP] - //ENDIF - nRow := ::aReport[ PAGEY ] - ::R2D( nRow ) - nCol := ::M2X( ::aReport[ PDFLEFT ] ) + ; - nCol * 100.00 / ::aReport[ REPORTWIDTH ] * ; - ( ::aReport[ PAGEX ] - ::M2X( ::aReport[ PDFLEFT ] ) * 2 - 9.0 ) / 100.00 - nHeight := ::aReport[ PAGEY ] - ::R2D( nHeight ) - nWidth := ::M2X( ::aReport[ PDFLEFT ] ) + ; - nWidth * 100.00 / ::aReport[ REPORTWIDTH ] * ; - ( ::aReport[ PAGEX ] - ::M2X( ::aReport[ PDFLEFT ] ) * 2 - 9.0 ) / 100.00 - ELSEIF cUnits == "D" - ENDIF - - aadd( ::aReport[ PAGEIMAGES ], { cFile, nRow, nCol, nHeight, nWidth } ) - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Length( cString ) -#else -METHOD Length( cString ) -#endif - -local nWidth := 0.00, nI, nLen, nArr, nAdd := ( ::aReport[ FONTNAME ] - 1 ) % 4 - - nLen := len( cString ) - IF right( cString, 1 ) == chr( 255 ) .or. right( cString, 1 ) == chr( 254 ) - --nLen - ENDIF - IF ::GetFontInfo("NAME") == "Times" - nArr := 1 - ELSEIF ::GetFontInfo("NAME") == "Helvetica" - nArr := 2 - ELSE - nArr := 3 - ENDIF - - For nI:= 1 To nLen - nWidth += ::aReport[ FONTWIDTH ][ nArr ][ ( asc( substr( cString, nI, 1 )) - 32 ) * 4 + 1 + nAdd ] * 25.4 * ::aReport[ FONTSIZE ] / 720.00 / 100.00 - Next -RETURN nWidth - -//--- - -#ifdef __XPP__ -METHOD tPdf:NewLine( n ) -#else -METHOD NewLine( n ) -#endif - -DEFAULT n TO 1 - IF ::aReport[ REPORTLINE ] + n + ::aReport[ PDFTOP] > ::aReport[ PDFBOTTOM ] - ::NewPage() - ::aReport[ REPORTLINE ] += 1 - ELSE - ::aReport[ REPORTLINE ] += n - ENDIF - -RETURN ::aReport[ REPORTLINE ] - -//--- - -#ifdef __XPP__ -METHOD tPdf:NewPage( _cPageSize, _cPageOrient, _nLpi, _cFontName, _nFontType, _nFontSize ) -#else -METHOD NewPage( _cPageSize, _cPageOrient, _nLpi, _cFontName, _nFontType, _nFontSize ) -#endif - - - -DEFAULT _cPageSize TO ::aReport[ PAGESIZE ] -DEFAULT _cPageOrient TO ::aReport[ PAGEORIENT ] -DEFAULT _nLpi TO ::aReport[ LPI ] -DEFAULT _cFontName TO ::GetFontInfo( "NAME" ) -DEFAULT _nFontType TO ::GetFontInfo( "TYPE" ) -DEFAULT _nFontSize TO ::aReport[ FONTSIZE ] - - IF !empty( ::aReport[ PAGEBUFFER ] ) - ::ClosePage() - ENDIF - - ::aReport[ PAGEFONTS ] := {} - ::aReport[ PAGEIMAGES ] := {} - - ++::aReport[ REPORTPAGE ] - - ::PageSize( _cPageSize ) - ::PageOrient( _cPageOrient ) - ::SetLPI( _nLpi ) - - ::SetFont( _cFontName, _nFontType, _nFontSize ) - - ::DrawHeader() - - ::aReport[ REPORTLINE ] := 0 - ::aReport[ FONTNAMEPREV ] := 0 - ::aReport[ FONTSIZEPREV ] := 0 - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:PageSize( _cPageSize ) -#else -METHOD PageSize( _cPageSize ) -#endif - -local nSize, aSize := { { "LETTER", 8.50, 11.00 }, ; - { "LEGAL" , 8.50, 14.00 }, ; - { "LEDGER", 11.00, 17.00 }, ; - { "EXECUTIVE", 7.25, 10.50 }, ; - { "A4", 8.27, 11.69 }, ; - { "A3", 11.69, 16.54 }, ; - { "JIS B4", 10.12, 14.33 }, ; - { "JIS B5", 7.16, 10.12 }, ; - { "JPOST", 3.94, 5.83 }, ; - { "JPOSTD", 5.83, 7.87 }, ; - { "COM10", 4.12, 9.50 }, ; - { "MONARCH", 3.87, 7.50 }, ; - { "C5", 6.38, 9.01 }, ; - { "DL", 4.33, 8.66 }, ; - { "B5", 6.93, 9.84 } } - - DEFAULT _cPageSize TO "LETTER" - - nSize := ascan( aSize, {| arr | LEFTEQUAL( arr[ 1 ], _cPageSize ) } ) - - IF nSize == 0 .or. nSize > 2 - nSize := 1 - ENDIF - - ::aReport[ PAGESIZE ] := aSize[ nSize ][ 1 ] - - IF ::aReport[ PAGEORIENT ] == "P" - ::aReport[ PAGEX ] := aSize[ nSize ][ 2 ] * 72 - ::aReport[ PAGEY ] := aSize[ nSize ][ 3 ] * 72 - ELSE - ::aReport[ PAGEX ] := aSize[ nSize ][ 3 ] * 72 - ::aReport[ PAGEY ] := aSize[ nSize ][ 2 ] * 72 - ENDIF - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:PageOrient( _cPageOrient ) -#else -METHOD PageOrient( _cPageOrient ) -#endif - - DEFAULT _cPageOrient TO "P" - - ::aReport[ PAGEORIENT ] := _cPageOrient - ::PageSize( ::aReport[ PAGESIZE ] ) -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:PageNumber( n ) -#else -METHOD PageNumber( n ) -#endif - -DEFAULT n TO 0 - IF n > 0 - ::aReport[ REPORTPAGE ] := n // NEW !!! - ENDIF -RETURN ::aReport[ REPORTPAGE ] - -//--- - -#ifdef __XPP__ -METHOD tPdf:Reverse( cString ) -#else -METHOD Reverse( cString ) -#endif - -RETURN cString + chr(255) - -//--- - -#ifdef __XPP__ -METHOD tPdf:RJust( cString, nRow, nCol, cUnits, lExact, cId ) -#else -METHOD RJust( cString, nRow, nCol, cUnits, lExact, cId ) -#endif - -local nLen, nAdj := 1.0, nAt - -DEFAULT nRow TO ::aReport[ REPORTLINE ] -DEFAULT cUnits TO "R" -DEFAULT lExact TO .F. - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFRJUST", cId, { cString, nRow, nCol, cUnits, lExact } ) - ENDIF - - IF ( nAt := at( "#pagenumber#", cString ) ) > 0 - cString := left( cString, nAt - 1 ) + ltrim(str( ::PageNumber())) + substr( cString, nAt + 12 ) - ENDIF - - nLen := ::length( cString ) - - IF cUnits == "R" - IF .not. lExact - ::CheckLine( nRow ) - nRow := nRow + ::aReport[ PDFTOP] - ENDIF - ENDIF - ::AtSay( cString, ::R2M( nRow ), iif( cUnits == "R", ::aReport[ PDFLEFT ] + ( ::aReport[ PAGEX ] / 72 * 25.4 - 2 * ::aReport[ PDFLEFT ] ) * nCol / ::aReport[ REPORTWIDTH ] - nAdj, nCol ) - nLen, "M", lExact ) -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:SetFont( _cFont, _nType, _nSize, cId ) -#else -METHOD SetFont( _cFont, _nType, _nSize, cId ) -#endif - -DEFAULT _cFont TO "Times" -DEFAULT _nType TO 0 -DEFAULT _nSize TO 10 - - IF ::aReport[ HEADEREDIT ] - return ::Header( "PDFSETFONT", cId, { _cFont, _nType, _nSize } ) - ENDIF - - _cFont := upper( _cFont ) - ::aReport[ FONTSIZE ] := _nSize - - IF _cFont == "TIMES" - ::aReport[ FONTNAME ] := _nType + 1 - ELSEIF _cFont == "HELVETICA" - ::aReport[ FONTNAME ] := _nType + 5 - ELSE - ::aReport[ FONTNAME ] := _nType + 9 // 0.04 - ENDIF - - aadd( ::aReport[ PAGEFONTS ], ::aReport[ FONTNAME ] ) - - IF ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ FONTNAME ] } ) == 0 - aadd( ::aReport[ FONTS ], { ::aReport[ FONTNAME ], ++::aReport[ NEXTOBJ ] } ) - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:SetLPI(_nLpi) -#else -METHOD SetLPI(_nLpi) -#endif - -local cLpi := alltrim(str(_nLpi)) -DEFAULT _nLpi TO 6 - - cLpi := iif(cLpi$"1;2;3;4;6;8;12;16;24;48",cLpi,"6") - ::aReport[ LPI ] := val( cLpi ) - - ::PageSize( ::aReport[ PAGESIZE ] ) -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:StringB( cString ) -#else -METHOD StringB( cString ) -#endif - -cString := strtran( cString, "(", "\(" ) -cString := strtran( cString, ")", "\)" ) - -RETURN cString - -//--- - -#ifdef __XPP__ -METHOD tPdf:TextCount( cString, nTop, nLeft, nLength, nTab, nJustify, cUnits ) -#else -METHOD TextCount( cString, nTop, nLeft, nLength, nTab, nJustify, cUnits ) -#endif - -RETURN ::Text( cString, nTop, nLeft, nLength, nTab, nJustify, cUnits, .F. ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:Text( cString, nTop, nLeft, nLength, nTab, nJustify, cUnits, cColor, lPrint ) -#else -METHOD Text( cString, nTop, nLeft, nLength, nTab, nJustify, cUnits, cColor, lPrint ) -#endif - -local cDelim := chr(0)+chr(9)+chr(10)+chr(13)+chr(26)+chr(32)+chr(138)+chr(141) -local nI, cTemp, cToken, k, nL, nRow, nLines, nLineLen, nStart -local lParagraph, nSpace, nNew, nTokenLen, nCRLF, nTokens, nLen - -DEFAULT nTab TO -1 -DEFAULT cUnits TO "R" -DEFAULT nJustify TO 4 -DEFAULT lPrint TO .T. -DEFAULT cColor TO "" - - IF cUnits == "M" - nTop := ::M2R( nTop ) - ELSEIF cUnits == "R" - nLeft := ::X2M( ::M2X( ::aReport[ PDFLEFT ] ) + ; - nLeft * 100.00 / ::aReport[ REPORTWIDTH ] * ; - ( ::aReport[ PAGEX ] - ::M2X( ::aReport[ PDFLEFT ] ) * 2 - 9.0 ) / 100.00 ) - ENDIF - - ::aReport[ REPORTLINE ] := nTop - 1 - - nSpace := ::length( " " ) - nLines := 0 - nCRLF := 0 - nNew := nTab - cString := alltrim( cString ) - nTokens := numtoken( cString, cDelim ) - - nStart := 1 - - IF nJustify == 1 .or. nJustify == 4 - nLeft := nLeft - ELSEIF nJustify == 2 - nLeft := nLeft - nLength / 2 - ELSEIF nJustify == 3 - nLeft := nLeft - nLength - ENDIF - - nL := nLeft - nL += nNew * nSpace - nLineLen := nSpace * nNew - nSpace - - lParagraph := .T. - nI := 1 - - while nI <= nTokens - cToken := token( cString, cDelim, nI ) - nTokenLen := ::length( cToken ) - nLen := len( cToken ) - - IF nLineLen + nSpace + nTokenLen > nLength - IF nStart == nI // single word > nLength - k := 1 - while k <= nLen - cTemp := "" - nLineLen := 0.00 - nL := nLeft - IF lParagraph - nLineLen += nSpace * nNew - IF nJustify != 2 - nL += nSpace * nNew - ENDIF - lParagraph := .F. - ENDIF - IF nJustify == 2 - nL := nLeft + ( nLength - ::length( cTemp ) ) / 2 - ELSEIF nJustify == 3 - nL := nLeft + nLength - ::length( cTemp ) - ENDIF - while k <= nLen .and. ( ( nLineLen += ::length( substr( cToken, k, 1 ))) <= nLength ) - nLineLen += ::length( substr( cToken, k, 1 )) - cTemp += substr( cToken, k, 1 ) - ++k - enddo - IF empty( cTemp ) // single character > nlength - cTemp := substr( cToken, k, 1 ) - ++k - ENDIF - ++nLines - IF lPrint - nRow := ::NewLine( 1 ) - ::AtSay( cColor + cTemp, ::R2M( nRow + ::aReport[ PDFTOP] ), nL, "M" ) - ENDIF - enddo - ++nI - nStart := nI - ELSE - ::TextPrint( nI - 1, nLeft, @lParagraph, nJustify, nSpace, nNew, nLength, @nLineLen, @nLines, @nStart, cString, cDelim, cColor, lPrint ) - ENDIF - - ELSEIF ( nI == nTokens ) .or. ( nI < nTokens .and. ( nCRLF := ::TextNextPara( cString, cDelim, nI ) ) > 0 ) - IF nI == nTokens - nLineLen += nSpace + nTokenLen - ENDIF - ::TextPrint( nI, nLeft, @lParagraph, nJustify, nSpace, nNew, nLength, @nLineLen, @nLines, @nStart, cString, cDelim, cColor, lPrint ) - ++nI - - IF nCRLF > 1 - nLines += nCRLF - 1 - ENDIF - IF lPrint - /*nRow :=*/ ::NewLine( nCRLF - 1 ) - ENDIF - - ELSE - nLineLen += nSpace + nTokenLen - ++nI - ENDIF - enddo - -RETURN nLines - -//--- - -#ifdef __XPP__ -METHOD tPdf:UnderLine( cString ) -#else -METHOD UnderLine( cString ) -#endif - -RETURN cString + chr(254) - -//--- - -#ifdef __XPP__ -METHOD tPdf:OpenHeader( cFile ) -#else -METHOD OpenHeader( cFile ) -#endif - -local nAt, cCmd - -DEFAULT cFile TO "" - - IF !empty( cFile ) - cFile := alltrim( cFile ) - IF len( cFile ) > 12 .or. ; - at( " ", cFile ) > 0 .or. ; - ( at( " ", cFile ) == 0 .and. len( cFile ) > 8 ) .or. ; - ( ( nAt := at( ".", cFile )) > 0 .and. len( substr( cFile, nAt + 1 )) > 3 ) - - cCmd := "copy " + cFile + " temp.tmp > nul" - RunExternal( cCmd ) - - cFile := "temp.tmp" - ENDIF - // ::aReport[ HEADER ] := FT_RestArr( cFile, @nErrorCode ) - ::aReport[ HEADER ] := File2Array( cFile ) - ELSE - ::aReport[ HEADER ] := {} - ENDIF - ::aReport[ MARGINS ] := .T. - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:EditOnHeader() -#else -METHOD EditOnHeader() -#endif - -::aReport[ HEADEREDIT ] := .T. -::aReport[ MARGINS ] := .T. - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:EditOffHeader() -#else -METHOD EditOffHeader() -#endif - -::aReport[ HEADEREDIT ] := .F. -::aReport[ MARGINS ] := .T. - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:CloseHeader() -#else -METHOD CloseHeader() -#endif - - ::aReport[ HEADER ] := {} - ::aReport[ MARGINS ] := .F. -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:DeleteHeader( cId ) -#else -METHOD DeleteHeader( cId ) -#endif - -local nRet := -1, nId - cId := upper( cId ) - nId := ascan( ::aReport[ HEADER ], {| arr | arr[ 3 ] == cId }) - IF nId > 0 - nRet := len( ::aReport[ HEADER ] ) - 1 - aDel( ::aReport[ HEADER ], nId ) - aSize( ::aReport[ HEADER ], nRet ) - ::aReport[ MARGINS ] := .T. - ENDIF -RETURN nRet - -//--- - -#ifdef __XPP__ -METHOD tPdf:EnableHeader( cId ) -#else -METHOD EnableHeader( cId ) -#endif - -local nId - cId := upper( cId ) - nId := ascan( ::aReport[ HEADER ], {| arr | arr[ 3 ] == cId }) - IF nId > 0 - ::aReport[ HEADER ][ nId ][ 1 ] := .T. - ::aReport[ MARGINS ] := .T. - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:DisableHeader( cId ) -#else -METHOD DisableHeader( cId ) -#endif - -local nId - cId := upper( cId ) - nId := ascan( ::aReport[ HEADER ], {| arr | arr[ 3 ] == cId }) - IF nId > 0 - ::aReport[ HEADER ][ nId ][ 1 ] := .F. - ::aReport[ MARGINS ] := .T. - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:SaveHeader( cFile ) -#else -METHOD SaveHeader( cFile ) -#endif - -local cCmd - -Array2File( "temp.tmp", ::aReport[ HEADER ] ) - -cCmd := "copy temp.tmp " + cFile + " > nul" -RunExternal( cCmd ) - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Header( cFunction, cId, arr ) -#else -METHOD Header( cFunction, cId, arr ) -#endif - -local nId, nI, nLen, nIdLen - nId := 0 - IF !empty( cId ) - cId := upper( cId ) - nId := ascan( ::aReport[ HEADER ], {| arr | arr[ 3 ] == cId }) - ENDIF - IF nId == 0 - nLen := len( ::aReport[ HEADER ] ) - IF empty( cId ) - cId := cFunction - nIdLen := len( cId ) - for nI := 1 to nLen - IF ::aReport[ HEADER ][ nI ][ 2 ] == cId - IF val( substr( ::aReport[ HEADER ][ nI ][ 3 ], nIdLen + 1 ) ) > nId - nId := val( substr( ::aReport[ HEADER ][ nI ][ 3 ], nIdLen + 1 ) ) - ENDIF - ENDIF - next - ++nId - cId += ltrim(str(nId)) - ENDIF - aadd( ::aReport[ HEADER ], { .T., cFunction, cId } ) - ++nLen - for nI := 1 to len( arr ) - aadd( ::aReport[ HEADER ][ nLen ], arr[ nI ] ) - next - ELSE - aSize( ::aReport[ HEADER ][ nId ], 3 ) - for nI := 1 to len( arr ) - aadd( ::aReport[ HEADER ][ nId ], arr[ nI ] ) - next - ENDIF -RETURN cId - -//--- - -#ifdef __XPP__ -METHOD tPdf:DrawHeader() -#else -METHOD DrawHeader() -#endif - -local nI, _nFont, _nSize, nLen := len( ::aReport[ HEADER ] ) - - IF nLen > 0 - - // save font - _nFont := ::aReport[ FONTNAME ] - _nSize := ::aReport[ FONTSIZE ] - - for nI := 1 to nLen - IF ::aReport[ HEADER ][ nI ][ 1 ] // enabled - do case - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFATSAY" - ::AtSay( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 7 ], ::aReport[ HEADER ][ nI ][ 8 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFCENTER" - ::Center( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 7 ], ::aReport[ HEADER ][ nI ][ 8 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFRJUST" - ::RJust( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 7 ], ::aReport[ HEADER ][ nI ][ 8 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFBOX" - ::Box( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 7 ], ::aReport[ HEADER ][ nI ][ 8 ], ::aReport[ HEADER ][ nI ][ 9 ], ::aReport[ HEADER ][ nI ][ 10 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFSETFONT" - ::SetFont( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - case ::aReport[ HEADER ][ nI ][ 2 ] == "PDFIMAGE" - ::Image( ::aReport[ HEADER ][ nI ][ 4 ], ::aReport[ HEADER ][ nI ][ 5 ], ::aReport[ HEADER ][ nI ][ 6 ], ::aReport[ HEADER ][ nI ][ 7 ], ::aReport[ HEADER ][ nI ][ 8 ], ::aReport[ HEADER ][ nI ][ 9 ], ::aReport[ HEADER ][ nI ][ 3 ] ) - - endcase - ENDIF - next - ::aReport[ FONTNAME ] := _nFont - ::aReport[ FONTSIZE ] := _nSize - - IF ::aReport[ MARGINS ] - ::Margins() - ENDIF - - ELSE - IF ::aReport[ MARGINS ] - ::aReport[ PDFTOP] := 1 // top - ::aReport[ PDFLEFT ] := 10 // left & right - ::aReport[ PDFBOTTOM ] := ::aReport[ PAGEY ] / 72 * ::aReport[ LPI ] - 1 // bottom, default "LETTER", "P", 6 - - ::aReport[ MARGINS ] := .F. - ENDIF - ENDIF -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Margins( nTop, nLeft, nBottom ) -#else -METHOD Margins( nTop, nLeft, nBottom ) -#endif - -local nI, nLen := len( ::aReport[ HEADER ] ), nTemp, aTemp, nHeight - - for nI := 1 to nLen - IF ::aReport[ HEADER ][ nI ][ 1 ] // enabled - - IF ::aReport[ HEADER ][ nI ][ 2 ] == "PDFSETFONT" - - ELSEIF ::aReport[ HEADER ][ nI ][ 2 ] == "PDFIMAGE" - IF ::aReport[ HEADER ][ nI ][ 8 ] == 0 // picture in header, first at all, not at any page yet - aTemp := ::ImageInfo( ::aReport[ HEADER ][ nI ][ 4 ] ) - nHeight := aTemp[ IMAGE_HEIGHT ] / aTemp[ IMAGE_YRES ] * 25.4 - IF ::aReport[ HEADER ][ nI ][ 7 ] == "D" - nHeight := ::M2X( nHeight ) - ENDIF - ELSE - nHeight := ::aReport[ HEADER ][ nI ][ 8 ] - ENDIF - - IF ::aReport[ HEADER ][ nI ][ 7 ] == "M" - - nTemp := ::aReport[ PAGEY ] / 72 * 25.4 / 2 - - IF ::aReport[ HEADER ][ nI ][ 5 ] < nTemp - nTemp := ( ::aReport[ HEADER ][ nI ][ 5 ] + nHeight ) * ::aReport[ LPI ] / 25.4 // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ELSE - nTemp := ::aReport[ HEADER ][ nI ][ 5 ] * ::aReport[ LPI ] / 25.4 // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ENDIF - - ELSEIF ::aReport[ HEADER ][ nI ][ 7 ] == "D" - nTemp := ::aReport[ PAGEY ] / 2 - - IF ::aReport[ HEADER ][ nI ][ 5 ] < nTemp - nTemp := ( ::aReport[ HEADER ][ nI ][ 5 ] + nHeight ) * ::aReport[ LPI ] / 72 // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ELSE - nTemp := ::aReport[ HEADER ][ nI ][ 5 ] * ::aReport[ LPI ] / 72 // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - - ENDIF - - ENDIF - - ELSEIF ::aReport[ HEADER ][ nI ][ 2 ] == "PDFBOX" - - IF ::aReport[ HEADER ][ nI ][ 10 ] == "M" - - nTemp := ::aReport[ PAGEY ] / 72 * 25.4 / 2 - - IF ::aReport[ HEADER ][ nI ][ 4 ] < nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] < nTemp - nTemp := ::aReport[ HEADER ][ nI ][ 6 ] * ::aReport[ LPI ] / 25.4 // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ELSEIF ::aReport[ HEADER ][ nI ][ 4 ] < nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] > nTemp - - nTemp := ( ::aReport[ HEADER ][ nI ][ 4 ] + ::aReport[ HEADER ][ nI ][ 8 ] ) * ::aReport[ LPI ] / 25.4 // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - - nTemp := ( ::aReport[ HEADER ][ nI ][ 6 ] - ::aReport[ HEADER ][ nI ][ 8 ] ) * ::aReport[ LPI ] / 25.4 // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - - ELSEIF ::aReport[ HEADER ][ nI ][ 4 ] > nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] > nTemp - nTemp := ::aReport[ HEADER ][ nI ][ 4 ] * ::aReport[ LPI ] / 25.4 // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ENDIF - - ELSEIF ::aReport[ HEADER ][ nI ][ 10 ] == "D" - nTemp := ::aReport[ PAGEY ] / 2 - - IF ::aReport[ HEADER ][ nI ][ 4 ] < nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] < nTemp - nTemp := ::aReport[ HEADER ][ nI ][ 6 ] / ::aReport[ LPI ] // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ELSEIF ::aReport[ HEADER ][ nI ][ 4 ] < nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] > nTemp - - nTemp := ( ::aReport[ HEADER ][ nI ][ 4 ] + ::aReport[ HEADER ][ nI ][ 8 ] ) / ::aReport[ LPI ] // top - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - - nTemp := ( ::aReport[ HEADER ][ nI ][ 6 ] - ::aReport[ HEADER ][ nI ][ 8 ] ) / ::aReport[ LPI ] // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - - ELSEIF ::aReport[ HEADER ][ nI ][ 4 ] > nTemp .and. ; - ::aReport[ HEADER ][ nI ][ 6 ] > nTemp - nTemp := ::aReport[ HEADER ][ nI ][ 4 ] / ::aReport[ LPI ] // top - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ENDIF - - ENDIF - - ELSE - IF ::aReport[ HEADER ][ nI ][ 7 ] == "R" - nTemp := ::aReport[ HEADER ][ nI ][ 5 ] // top - IF ::aReport[ HEADER ][ nI ][ 5 ] > ::aReport[ PAGEY ] / 72 * ::aReport[ LPI ] / 2 - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ELSE - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ENDIF - ELSEIF ::aReport[ HEADER ][ nI ][ 7 ] == "M" - nTemp := ::aReport[ HEADER ][ nI ][ 5 ] * ::aReport[ LPI ] / 25.4 // top - IF ::aReport[ HEADER ][ nI ][ 5 ] > ::aReport[ PAGEY ] / 72 * 25.4 / 2 - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ELSE - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ENDIF - ELSEIF ::aReport[ HEADER ][ nI ][ 7 ] == "D" - nTemp := ::aReport[ HEADER ][ nI ][ 5 ] / ::aReport[ LPI ] // top - IF ::aReport[ HEADER ][ nI ][ 5 ] > ::aReport[ PAGEY ] / 2 - IF nTemp < ::aReport[ PDFBOTTOM ] - ::aReport[ PDFBOTTOM ] := nTemp - ENDIF - ELSE - IF nTemp > ::aReport[ PDFTOP] - ::aReport[ PDFTOP] := nTemp - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF - next - - IF nTop != NIL - ::aReport[ PDFTOP] := nTop - ENDIF - IF nLeft != NIL - ::aReport[ PDFLEFT ] := nLeft - ENDIF - IF nBottom != NIL - ::aReport[ PDFBOTTOM ] := nBottom - ENDIF - - ::aReport[ MARGINS ] := .F. - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:CreateHeader( _file, _size, _orient, _lpi, _width ) -#else -METHOD CreateHeader( _file, _size, _orient, _lpi, _width ) -#endif - -local ; - aReportStyle := { ; - { 1, 2, 3, 4, 5, 6 }, ; //"Default" - { 2.475, 4.0, 4.9, 6.4, 7.5, 64.0 }, ; //"P6" - { 3.3 , 5.4, 6.5, 8.6, 10.0, 85.35 }, ; //"P8" - { 2.475, 4.0, 4.9, 6.4, 7.5, 48.9 }, ; //"L6" - { 3.3 , 5.4, 6.5, 8.6, 10.0, 65.2 }, ; //"L8" - { 2.475, 4.0, 4.9, 6.4, 7.5, 82.0 }, ; //"P6" - { 3.3 , 5.4, 6.5, 8.6, 10.0, 109.35 } ; //"P8" - } -local nStyle := 1, nAdd := 0.00 - -DEFAULT _size TO ::aReport[ PAGESIZE ] -DEFAULT _orient TO ::aReport[ PAGEORIENT ] -DEFAULT _lpi TO ::aReport[ LPI ] -DEFAULT _width TO 200 - - IF _size == "LETTER" - IF _orient == "P" - IF _lpi == 6 - nStyle := 2 - ELSEIF _lpi == 8 - nStyle := 3 - ENDIF - ELSEIF _orient == "L" - IF _lpi == 6 - nStyle := 4 - ELSEIF _lpi == 8 - nStyle := 5 - ENDIF - ENDIF - ELSEIF _size == "LEGAL" - IF _orient == "P" - IF _lpi == 6 - nStyle := 6 - ELSEIF _lpi == 8 - nStyle := 7 - ENDIF - ELSEIF _orient == "L" - IF _lpi == 6 - nStyle := 4 - ELSEIF _lpi == 8 - nStyle := 5 - ENDIF - ENDIF - ENDIF - - ::EditOnHeader() - - IF _size == "LEGAL" - nAdd := 76.2 - ENDIF - - IF _orient == "P" - ::Box( 5.0, 5.0, 274.0 + nAdd, 210.0, 1.0 ) - ::Box( 6.5, 6.5, 272.5 + nAdd, 208.5, 0.5 ) - - ::Box( 11.5, 9.5, 22.0 , 205.5, 0.5, 5 ) - ::Box( 23.0, 9.5, 33.5 , 205.5, 0.5, 5 ) - ::Box( 34.5, 9.5, 267.5 + nAdd, 205.5, 0.5 ) - - ELSE - ::Box( 5.0, 5.0, 210.0, 274.0 + nAdd, 1.0 ) - ::Box( 6.5, 6.5, 208.5, 272.5 + nAdd, 0.5 ) - - ::Box( 11.5, 9.5, 22.0, 269.5 + nAdd, 0.5, 5 ) - ::Box( 23.0, 9.5, 33.5, 269.5 + nAdd, 0.5, 5 ) - ::Box( 34.5, 9.5, 203.5, 269.5 + nAdd, 0.5 ) - ENDIF - - ::SetFont("Arial", BOLD, 10) - ::AtSay( "Test Line 1", aReportStyle[ nStyle ][ 1 ], 1, "R", .T. ) - - ::SetFont("Times", BOLD, 18) - ::Center( "Test Line 2", aReportStyle[ nStyle ][ 2 ],,"R", .T. ) - - ::SetFont("Times", BOLD, 12) - ::Center( "Test Line 3", aReportStyle[ nStyle ][ 3 ],,"R", .T. ) - - ::SetFont("Arial", BOLD, 10) - ::AtSay( "Test Line 4", aReportStyle[ nStyle ][ 4 ], 1, "R", .T. ) - - ::SetFont("Arial", BOLD, 10) - ::AtSay( "Test Line 5", aReportStyle[ nStyle ][ 5 ], 1, "R", .T. ) - - ::AtSay( dtoc( date()) + " " + TimeAsAMPM( time() ), aReportStyle[ nStyle ][ 6 ], 1, "R", .T. ) - ::RJust( "Page: #pagenumber#", aReportStyle[ nStyle ][ 6 ], ::aReport[ REPORTWIDTH ], "R", .T. ) - - ::EditOffHeader() - ::SaveHeader( _file ) -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:ImageInfo( cFile ) -#else -METHOD ImageInfo( cFile ) -#endif - -local cTemp := upper(substr( cFile, rat(".", cFile) + 1 )), aTemp := {} - do case - case cTemp == "TIF" - aTemp := ::TIFFInfo( cFile ) - case cTemp == "JPG" - aTemp := ::JPEGInfo( cFile ) - endcase -RETURN aTemp - -//--- - -#ifdef __XPP__ -METHOD tPdf:TIFFInfo( cFile ) -#else -METHOD TIFFInfo( cFile ) -#endif - -local c40 := chr(0)+chr(0)+chr(0)+chr(0) -//local aType := {"BYTE","ASCII","SHORT","LONG","RATIONAL","SBYTE","UNDEFINED","SSHORT","SLONG","SRATIONAL","FLOAT","DOUBLE"} -local aCount := { 1, 1, 2, 4, 8, 1, 1, 2, 4, 8, 4, 8 } -local nTemp, nHandle, cValues, c2, nFieldType, nCount, nPos, nTag, nValues -local nOffset, cTemp, cIFDNext, nIFD, nFields, cTag, nn - -local nWidth := 0, nHeight := 0, nBits := 0, nFrom := 0, nLength := 0, xRes := 0, yRes := 0, aTemp := {} - - nHandle := fopen( cFile ) - - c2 := " " - fread( nHandle, @c2, 2 ) - fread( nHandle, @c2, 2 ) - - cIFDNext := " " - fread( nHandle, @cIFDNext, 4 ) - - cTemp := space(12) - - - while !( cIFDNext == c40 ) //read IFD's - - nIFD := bin2l( cIFDNext ) - - fseek( nHandle, nIFD ) - - fread( nHandle, @c2, 2 ) - nFields := bin2i( c2 ) - - for nn := 1 to nFields - fread( nHandle, @cTemp, 12 ) - - nTag := bin2w( substr( cTemp, 1, 2 ) ) - nFieldType := bin2w( substr( cTemp, 3, 2 ) ) - nCount := bin2l( substr( cTemp, 5, 4 ) ) - nOffset := bin2l( substr( cTemp, 9, 4 ) ) - - IF nCount > 1 .or. nFieldType == RATIONAL .or. nFieldType == SRATIONAL - nPos := filepos( nHandle ) - fseek( nHandle, nOffset) - - nValues := nCount * aCount[ nFieldType ] - cValues := space( nValues ) - fread( nHandle, @cValues, nValues ) - fseek( nHandle, nPos ) - ELSE - cValues := substr( cTemp, 9, 4 ) - ENDIF - - IF nFieldType == ASCII - --nCount - ENDIF - //cTag := "" - do case - case nTag == 256 - cTag := "ImageWidth" - - IF nFieldType == SHORT - nWidth := bin2w( substr( cValues, 1, 2 )) - ELSEIF nFieldType == LONG - nWidth := bin2l( substr( cValues, 1, 4 )) - ENDIF - - case nTag == 257 - cTag := "ImageLength" - IF nFieldType == SHORT - nHeight := bin2w(substr( cValues, 1, 2 )) - ELSEIF nFieldType == LONG - nHeight := bin2l(substr( cValues, 1, 4 )) - ENDIF - - case nTag == 258 - cTag := "BitsPerSample" - nTemp := 0 - IF nFieldType == SHORT - nTemp := bin2w( cValues ) - ENDIF - nBits := nTemp - case nTag == 259 - cTag := "Compression" - /*nTemp := 0 - IF nFieldType == SHORT - nTemp := bin2w( cValues ) - ENDIF*/ - case nTag == 262 - cTag := "PhotometricInterpretation" - /*nTemp := -1 - IF nFieldType == SHORT - nTemp := bin2w( cValues ) - ENDIF*/ - case nTag == 264 - cTag := "CellWidth" - case nTag == 265 - cTag := "CellLength" - case nTag == 266 - cTag := "FillOrder" - case nTag == 273 - cTag := "StripOffsets" - IF nFieldType == SHORT - nFrom := bin2w(substr( cValues, 1, 2 )) - ELSEIF nFieldType == LONG - nFrom := bin2l(substr( cValues, 1, 4 )) - ENDIF - - case nTag == 277 - cTag := "SamplesPerPixel" - case nTag == 278 - cTag := "RowsPerStrip" - case nTag == 279 - cTag := "StripByteCounts" - IF nFieldType == SHORT - nLength := bin2w(substr( cValues, 1, 2 )) - ELSEIF nFieldType == LONG - nLength := bin2l(substr( cValues, 1, 4 )) - ENDIF - - nLength *= nCount // Count all strips !!! - - case nTag == 282 - cTag := "XResolution" - xRes := bin2l(substr( cValues, 1, 4 )) - case nTag == 283 - cTag := "YResolution" - yRes := bin2l(substr( cValues, 1, 4 )) - case nTag == 284 - cTag := "PlanarConfiguration" - case nTag == 288 - cTag := "FreeOffsets" - case nTag == 289 - cTag := "FreeByteCounts" - case nTag == 296 - cTag := "ResolutionUnit" - /*nTemp := 0 - IF nFieldType == SHORT - nTemp := bin2w( cValues ) - ENDIF*/ - case nTag == 305 - cTag := "Software" - case nTag == 306 - cTag := "DateTime" - case nTag == 315 - cTag := "Artist" - case nTag == 320 - cTag := "ColorMap" - case nTag == 338 - cTag := "ExtraSamples" - case nTag == 33432 - cTag := "Copyright" - otherwise - cTag := "Unknown" - endcase - next - fread( nHandle, @cIFDNext, 4 ) - enddo - HB_SYMBOL_UNUSED( cTag ) // TOFIX - fclose( nHandle ) - - aadd( aTemp, nWidth ) - aadd( aTemp, nHeight ) - aadd( aTemp, xRes ) - aadd( aTemp, yRes ) - aadd( aTemp, nBits ) - aadd( aTemp, nFrom ) - aadd( aTemp, nLength ) - -return aTemp - -//--- - -#ifdef __XPP__ -METHOD tPdf:JPEGInfo( cFile ) -#else -METHOD JPEGInfo( cFile ) -#endif - -local c255, nAt, nHandle -local nWidth, nHeight, nBits := 8, nFrom := 0 -local nLength, xRes, yRes, aTemp := {} - - nHandle := fopen( cFile ) - - c255 := space(1024) - fread( nHandle, @c255, 1024 ) - - xRes := asc(substr( c255, 15, 1 )) * 256 + asc(substr( c255, 16, 1 )) - yRes := asc( substr( c255, 17, 1 )) * 256 + asc(substr( c255, 18, 1 )) - - nAt := at( chr(255) + chr(192), c255 ) + 5 - nHeight := asc(substr( c255, nAt, 1 )) * 256 + asc(substr( c255, nAt + 1, 1 )) - nWidth := asc( substr( c255, nAt + 2, 1 )) * 256 + asc(substr( c255, nAt + 3, 1 )) - - fclose( nHandle ) - - nLength := filesize( cFile ) - - aadd( aTemp, nWidth ) - aadd( aTemp, nHeight ) - aadd( aTemp, xRes ) - aadd( aTemp, yRes ) - aadd( aTemp, nBits ) - aadd( aTemp, nFrom ) - aadd( aTemp, nLength ) - -return aTemp - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookCount( nRecno, nCurLevel ) -#else -METHOD BookCount( nRecno, nCurLevel ) -#endif - -local nTempLevel, nCount := 0, nLen := len( ::aReport[ BOOKMARK ] ) - ++nRecno - while nRecno <= nLen - nTempLevel := ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - IF nTempLevel <= nCurLevel - exit - ELSE - IF nCurLevel + 1 == nTempLevel - ++nCount - ENDIF - ENDIF - ++nRecno - enddo -return -1 * nCount - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookFirst( nRecno, nCurLevel, nObj ) -#else -METHOD BookFirst( nRecno, nCurLevel, nObj ) -#endif - -local nFirst := 0, nLen := len( ::aReport[ BOOKMARK ] ) - ++nRecno - IF nRecno <= nLen - IF nCurLevel + 1 == ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - nFirst := nRecno - ENDIF - ENDIF -return iif( nFirst == 0, nFirst, nObj + nFirst ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookLast( nRecno, nCurLevel, nObj ) -#else -METHOD BookLast( nRecno, nCurLevel, nObj ) -#endif - -local nLast := 0, nLen := len( ::aReport[ BOOKMARK ] ) - ++nRecno - IF nRecno <= nLen - IF nCurLevel + 1 == ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - while nRecno <= nLen .and. nCurLevel + 1 <= ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - IF nCurLevel + 1 == ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - nLast := nRecno - ENDIF - ++nRecno - enddo - ENDIF - ENDIF -return iif( nLast == 0, nLast, nObj + nLast ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookNext( nRecno, nCurLevel, nObj ) -#else -METHOD BookNext( nRecno, nCurLevel, nObj ) -#endif - -local nTempLevel, nNext := 0, nLen := len( ::aReport[ BOOKMARK ] ) - ++nRecno - while nRecno <= nLen - nTempLevel := ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - IF nCurLevel > nTempLevel - exit - ELSEIF nCurLevel == nTempLevel - nNext := nRecno - exit - ELSE - // keep going - ENDIF - ++nRecno - enddo -return iif( nNext == 0, nNext, nObj + nNext ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookParent( nRecno, nCurLevel, nObj ) -#else -METHOD BookParent( nRecno, nCurLevel, nObj ) -#endif - -local nTempLevel -local nParent := 0 - --nRecno - while nRecno > 0 - nTempLevel := ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - IF nTempLevel < nCurLevel - nParent := nRecno - exit - ENDIF - --nRecno - enddo -return iif( nParent == 0, nObj - 1, nObj + nParent ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:BookPrev( nRecno, nCurLevel, nObj ) -#else -METHOD BookPrev( nRecno, nCurLevel, nObj ) -#endif - -local nTempLevel -local nPrev := 0 - --nRecno - while nRecno > 0 - nTempLevel := ::aReport[ BOOKMARK ][ nRecno ][ BOOKLEVEL ] - IF nCurLevel > nTempLevel - exit - ELSEIF nCurLevel == nTempLevel - nPrev := nRecno - exit - ELSE - // keep going - ENDIF - --nRecno - enddo -return iif( nPrev == 0, nPrev, nObj + nPrev ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:CheckLine( nRow ) -#else -METHOD CheckLine( nRow ) -#endif - - IF nRow + ::aReport[ PDFTOP] > ::aReport[ PDFBOTTOM ] - ::NewPage() - nRow := ::aReport[ REPORTLINE ] - ENDIF - ::aReport[ REPORTLINE ] := nRow -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:GetFontInfo( cParam ) -#else -METHOD GetFontInfo( cParam ) -#endif - -local cRet - IF cParam == "NAME" - IF left( ::aReport[ TYPE1 ][ ::aReport[ FONTNAME ] ], 5 ) == "Times" - cRet := "Times" - ELSEIF left( ::aReport[ TYPE1 ][ ::aReport[ FONTNAME ] ], 9 ) == "Helvetica" - cRet := "Helvetica" - ELSE - cRet := "Courier" // 0.04 - ENDIF - ELSE // size - cRet := int(( ::aReport[ FONTNAME ] - 1 ) % 4) - ENDIF - -return cRet - -//--- - -#ifdef __XPP__ -METHOD tPdf:M2R( mm ) -#else -METHOD M2R( mm ) -#endif - -return int( ::aReport[ LPI ] * mm / 25.4 ) - -//--- - -#ifdef __XPP__ -METHOD tPdf:M2X( n ) -#else -METHOD M2X( n ) -#endif - -return n * 72 / 25.4 - -//--- - -#ifdef __XPP__ -METHOD tPdf:M2Y( n ) -#else -METHOD M2Y( n ) -#endif - -return ::aReport[ PAGEY ] - n * 72 / 25.4 - -//--- - -#ifdef __XPP__ -METHOD tPdf:R2D( nRow ) -#else -METHOD R2D( nRow ) -#endif - -return ::aReport[ PAGEY ] - nRow * 72 / ::aReport[ LPI ] - -//--- - -#ifdef __XPP__ -METHOD tPdf:R2M( nRow ) -#else -METHOD R2M( nRow ) -#endif - -return 25.4 * nRow / ::aReport[ LPI ] - -//--- - -#ifdef __XPP__ -METHOD tPdf:X2M( n ) -#else -METHOD X2M( n ) -#endif - -return n * 25.4 / 72 - -//--- - -#ifdef __XPP__ -METHOD tPdf:TextPrint( nI, nLeft, lParagraph, nJustify, nSpace, nNew, nLength, nLineLen, nLines, nStart, cString, cDelim, cColor, lPrint ) -#else -METHOD TextPrint( nI, nLeft, lParagraph, nJustify, nSpace, nNew, nLength, nLineLen, nLines, nStart, cString, cDelim, cColor, lPrint ) -#endif - -local nFinish, nL, nB, nJ, cToken, nRow - - nFinish := nI - - nL := nLeft - IF lParagraph - IF nJustify != 2 - nL += nSpace * nNew - ENDIF - ENDIF - - IF nJustify == 3 // right - nL += nLength - nLineLen - ELSEIF nJustify == 2 // center - nL += ( nLength - nLineLen ) / 2 - ENDIF - - ++nLines - IF lPrint - nRow := ::NewLine( 1 ) - ENDIF - nB := nSpace - IF nJustify == 4 - nB := ( nLength - nLineLen + ( nFinish - nStart ) * nSpace ) / ( nFinish - nStart ) - ENDIF - for nJ := nStart to nFinish - cToken := token( cString, cDelim, nJ ) - IF lPrint - // version 0.02 - ::AtSay( cColor + cToken, ::R2M( nRow + ::aReport[ PDFTOP ] ), nL, "M" ) - ENDIF - nL += ::Length( cToken ) + nB - next - - nStart := nFinish + 1 - - lParagraph := .F. - - nLineLen := 0.00 - nLineLen += nSpace * nNew - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:TextNextPara( cString, cDelim, nI ) -#else -METHOD TextNextPara( cString, cDelim, nI ) -#endif - -local nAt, cAt, nCRLF, nNew, nRat, nRet := 0 - // check if next spaces paragraph(s) - nAt := attoken( cString, cDelim, nI ) + len( token( cString, cDelim, nI ) ) - cAt := substr( cString, nAt, attoken( cString, cDelim, nI + 1 ) - nAt ) - nCRLF := numat( chr(13) + chr(10), cAt ) - nRat := rat( chr(13) + chr(10), cAt ) - nNew := len( cAt ) - nRat - iif( nRat > 0, 1, 0 ) - IF nCRLF > 1 .or. ( nCRLF == 1 .and. nNew > 0 ) - nRet := nCRLF - ENDIF -return nRet - -//--- - -#ifdef __XPP__ -METHOD tPdf:ClosePage() -#else -METHOD ClosePage() -#endif - -local cTemp, cBuffer, nBuffer, nRead, nI, k, nImage, nFont, nImageHandle - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - - aadd( ::aReport[ PAGES ], ::aReport[ REPORTOBJ ] + 1 ) - - cTemp := ; - ltrim(str( ++::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - "<<" + CRLF + ; - "/Type /Page /Parent 1 0 R" + CRLF + ; - "/Resources " + ltrim(str( ++::aReport[ REPORTOBJ ] )) + " 0 R" + CRLF + ; - "/MediaBox [ 0 0 " + ltrim(transform( ::aReport[ PAGEX ], "9999.99")) + " " + ; - ltrim(transform(::aReport[ PAGEY ], "9999.99")) + " ]" + CRLF + ; - "/Contents " + ltrim(str( ++::aReport[ REPORTOBJ ] )) + " 0 R" + CRLF + ; - ">>" + CRLF + ; - "endobj" + CRLF - - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - cTemp := ; - ltrim(str(::aReport[ REPORTOBJ ] - 1)) + " 0 obj" + CRLF + ; - "<<"+CRLF+; - "/ColorSpace << /DeviceRGB /DeviceGray >>" + CRLF + ; //version 0.01 - "/ProcSet [ /PDF /Text /ImageB /ImageC ]" - - IF len( ::aReport[ PAGEFONTS ] ) > 0 - cTemp += CRLF + ; - "/Font" + CRLF + ; - "<<" - - for nI := 1 to len( ::aReport[ PAGEFONTS ] ) - nFont := ascan( ::aReport[ FONTS ], {| arr | arr[ 1 ] == ::aReport[ PAGEFONTS ][ nI ] } ) - cTemp += CRLF + "/Fo" + ltrim(str( nFont )) + " " + ltrim(str( ::aReport[ FONTS ][ nFont ][ 2 ])) + " 0 R" - next - - cTemp += CRLF + ">>" - ENDIF - - IF len( ::aReport[ PAGEIMAGES ] ) > 0 - cTemp += CRLF + "/XObject" + CRLF + "<<" - for nI := 1 to len( ::aReport[ PAGEIMAGES ] ) - nImage := ascan( ::aReport[ IMAGES ], {| arr | arr[ 1 ] == ::aReport[ PAGEIMAGES ][ nI ][ 1 ] } ) - IF nImage == 0 - aadd( ::aReport[ IMAGES ], { ::aReport[ PAGEIMAGES ][ nI ][ 1 ], ++::aReport[ NEXTOBJ ], ::ImageInfo( ::aReport[ PAGEIMAGES ][ nI ][ 1 ] ) } ) - nImage := len( ::aReport[ IMAGES ] ) - ENDIF - cTemp += CRLF + "/Image" + ltrim(str( nImage )) + " " + ltrim(str( ::aReport[ IMAGES ][ nImage ][ 2 ])) + " 0 R" - next - cTemp += CRLF + ">>" - ENDIF - - cTemp += CRLF + ">>" + CRLF + "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - cTemp := ltrim(str( ::aReport[ REPORTOBJ ] )) + " 0 obj << /Length " + ; - ltrim(str( ::aReport[ REPORTOBJ ] + 1 )) + " 0 R >>" + CRLF +; - "stream" - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - IF len( ::aReport[ PAGEIMAGES ] ) > 0 - cTemp := "" - for nI := 1 to len( ::aReport[ PAGEIMAGES ] ) - cTemp += CRLF + "q" - nImage := ascan( ::aReport[ IMAGES ], {| arr | arr[ 1 ] == ::aReport[ PAGEIMAGES ][ nI ][ 1 ] } ) - cTemp += CRLF + ltrim(str( iif( ::aReport[ PAGEIMAGES ][ nI ][ 5 ] == 0, ::M2X( ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_WIDTH ] / ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_XRES ] * 25.4 ), ::aReport[ PAGEIMAGES ][ nI ][ 5 ]))) + ; - " 0 0 " + ; - ltrim(str( iif( ::aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, ::M2X( ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), ::aReport[ PAGEIMAGES ][ nI ][ 4 ]))) + ; - " " + ltrim(str( ::aReport[ PAGEIMAGES ][ nI ][ 3 ] )) + ; - " " + ltrim(str( ::aReport[ PAGEY ] - ::aReport[ PAGEIMAGES ][ nI ][ 2 ] - ; - iif( ::aReport[ PAGEIMAGES ][ nI ][ 4 ] == 0, ::M2X( ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_HEIGHT ] / ::aReport[ IMAGES ][ nImage ][ 3 ][ IMAGE_YRES ] * 25.4 ), ::aReport[ PAGEIMAGES ][ nI ][ 4 ]))) + " cm" - cTemp += CRLF + "/Image" + ltrim(str( nImage )) + " Do" - cTemp += CRLF + "Q" - next - ::aReport[ PAGEBUFFER ] := cTemp + ::aReport[ PAGEBUFFER ] - ENDIF - - cTemp := ::aReport[ PAGEBUFFER ] - - cTemp += CRLF + "endstream" + CRLF + ; - "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - cTemp := ltrim(str( ++::aReport[ REPORTOBJ ] )) + " 0 obj" + CRLF + ; - ltrim(str(len( ::aReport[ PAGEBUFFER ] ))) + CRLF + ; - "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - for nI := 1 to len( ::aReport[ FONTS ] ) - IF ::aReport[ FONTS ][ nI ][ 2 ] > ::aReport[ REPORTOBJ ] - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - - cTemp := ; - ltrim(str( ::aReport[ FONTS ][ nI ][ 2 ] )) + " 0 obj" + CRLF + ; - "<<" + CRLF + ; - "/Type /Font" + CRLF + ; - "/Subtype /Type1" + CRLF + ; - "/Name /Fo" + ltrim(str( nI )) + CRLF + ; - "/BaseFont /" + ::aReport[ TYPE1 ][ ::aReport[ FONTS ][ nI ][ 1 ] ] + CRLF + ; - "/Encoding /WinAnsiEncoding" + CRLF + ; - ">>" + CRLF + ; - "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - ENDIF - next - - for nI := 1 to len( ::aReport[ IMAGES ] ) - IF ::aReport[ IMAGES ][ nI ][ 2 ] > ::aReport[ REPORTOBJ ] - - aadd( ::aReport[ REFS ], ::aReport[ DOCLEN ] ) - - cTemp := ; - ltrim(str( ::aReport[ IMAGES ][ nI ][ 2 ] )) + " 0 obj" + CRLF + ; - "<<" + CRLF + ; - "/Type /XObject" + CRLF + ; - "/Subtype /Image" + CRLF + ; - "/Name /Image" + ltrim(str(nI)) + CRLF + ; - "/Filter [" + iif( at( ".jpg", lower( ::aReport[ IMAGES ][ nI ][ 1 ]) ) > 0, " /DCTDecode", "" ) + " ]" + CRLF + ; - "/Width " + ltrim(str( ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_WIDTH ] )) + CRLF + ; - "/Height " + ltrim(str( ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_HEIGHT ] )) + CRLF + ; - "/BitsPerComponent " + ltrim(str( ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_BITS ] )) + CRLF + ; - "/ColorSpace /" + iif( ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_BITS ] == 1, "DeviceGray", "DeviceRGB") + CRLF + ; - "/Length " + ltrim(str( ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ])) + CRLF + ; - ">>" + CRLF + ; - "stream" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - nImageHandle := fopen( ::aReport[ IMAGES ][ nI ][ 1 ] ) - fseek( nImageHandle, ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_FROM ] ) - - nBuffer := 8192 - cBuffer := space( nBuffer ) - k := 0 - while k < ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ] - IF k + nBuffer <= ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ] - nRead := nBuffer - ELSE - nRead := ::aReport[ IMAGES ][ nI ][ 3 ][ IMAGE_LENGTH ] - k - ENDIF - fread( nImageHandle, @cBuffer, nRead ) - - ::aReport[ DOCLEN ] += nRead - fwrite( ::aReport[ HANDLE ], cBuffer, nRead ) - k += nRead - enddo - - cTemp := CRLF + "endstream" + CRLF + "endobj" + CRLF - - ::aReport[ DOCLEN ] += len( cTemp ) - fwrite( ::aReport[ HANDLE ], cTemp ) - - fClose( nImageHandle ) - ENDIF - next - - ::aReport[ REPORTOBJ ] := ::aReport[ NEXTOBJ ] - - ::aReport[ NEXTOBJ ] := ::aReport[ REPORTOBJ ] + 4 - - ::aReport[ PAGEBUFFER ] := "" - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:FilePrint( cFile ) -#else -METHOD FilePrint( cFile ) -#endif -local cPathAcro := "C:\progra~1\Adobe\Acroba~1.0\Reader" -local cRun := cPathAcro + "\AcroRd32.exe /t " + cFile + " " + ; - chr(34) + "HP LaserJet 5/5M PostScript" + chr(34) + " " + ; - chr(34) + "LPT1" + chr(34) - -IF ( ! RunExternal( cRun, "print" ) ) - alert( "Error printing to PDF reader." ) - break -ENDIF - -RETURN self - -//--- - -#ifdef __XPP__ -METHOD tPdf:Execute( cFile ) -#else -METHOD Execute( cFile ) -#endif -// Replace cPathAcro with the path at your system -local cPathAcro := "C:\progra~1\Adobe\Acroba~1.0\Reader" -local cRun := cPathAcro + "\AcroRd32.exe /t " + cFile + " " + chr(34) + "HP LaserJet 5/5M PostScript" + chr(34) + " " + chr(34) + "LPT1" + chr(34) - -IF (! RunExternal( cRun, "open", cFile ) ) - alert("Error printing to PDF reader.") - break -ENDIF - -RETURN self - -//--- -//--- -//--- - -static function FilePos( nHandle ) -return FSEEK( nHandle, 0, FS_RELATIVE ) - -//--- -/* -static function stuff( cStr, nBeg, nDel, cIns ) -return PosIns( PosDel( cStr, nBeg, nDel ), cIns, nBeg ) -*/ -//--- - -static function Chr_RGB( cChar ) -return str(asc( cChar ) / 255, 4, 2) - -//--- - -static function TimeAsAMPM( cTime ) - IF VAL(cTime) < 12 - cTime += " am" - ELSEIF VAL(cTime) == 12 - cTime += " pm" - ELSE - cTime := STR(VAL(cTime) - 12, 2) + SUBSTR(cTime, 3) + " pm" - ENDIF - cTime := left( cTime, 5 ) + substr( cTime, 10 ) -return cTime - -//--- - -static function FileSize( cFile ) - - LOCAL nLength - LOCAL nHandle - - nHandle := fOpen( cFile ) - nLength := fSeek( nHandle, 0, FS_END ) - fClose( nHandle ) - -return nLength - -//--- - -static FUNCTION NumToken( cString, cDelimiter ) -RETURN AllToken( cString, cDelimiter ) - -//--- - -static FUNCTION Token( cString, cDelimiter, nPointer ) -RETURN AllToken( cString, cDelimiter, nPointer, 1 ) - -//--- - -static function AtToken( cString, cDelimiter, nPointer ) -return AllToken( cString, cDelimiter, nPointer, 2 ) - -//--- - -static function AllToken( cString, cDelimiter, nPointer, nAction ) -local nTokens := 0 -local nPos := 1 -local nLen := len( cString ) -local nStart -local cRet := 0 - -DEFAULT cDelimiter TO chr(0)+chr(9)+chr(10)+chr(13)+chr(26)+chr(32)+chr(138)+chr(141) -DEFAULT nAction to 0 - -// nAction == 0 - numtoken -// nAction == 1 - token -// nAction == 2 - attoken - -while nPos <= nLen - if .not. substr( cString, nPos, 1 ) $ cDelimiter - nStart := nPos - while nPos <= nLen .and. .not. substr( cString, nPos, 1 ) $ cDelimiter - ++nPos - enddo - ++nTokens - IF nAction > 0 - IF nPointer == nTokens - IF nAction == 1 - cRet := substr( cString, nStart, nPos - nStart ) - ELSE - cRet := nStart - ENDIF - exit - ENDIF - ENDIF - endif - if substr( cString, nPos, 1 ) $ cDelimiter - while nPos <= nLen .and. substr( cString, nPos, 1 ) $ cDelimiter - ++nPos - enddo - endif - cRet := nTokens -ENDDO - -RETURN cRet - -//--- -// -// next 3 function written by Peter Kulek -// modified for compatibility with common.ch by V.K. -// modified DATE processing by V.K. -// -static function Array2File( cFile, aRay, nDepth, hFile ) -local nBytes := 0 -local i -local lOpen := ( hFile != nil ) - -nDepth := iif( HB_ISNUMERIC( nDepth ), nDepth, 0 ) -//if hFile == NIL -if !lOpen - if ( hFile := fCreate( cFile,FC_NORMAL ) ) == F_ERROR - return nBytes - endif -endif -nDepth++ -nBytes += WriteData( hFile,aRay ) -if HB_ISARRAY( aRay ) - for i := 1 to len( aRay ) - nBytes += Array2File( cFile,aRay[i],nDepth,hFile ) - next -endif -nDepth-- -// if nDepth == 0 -if !lOpen - fClose(hFile) -endif - -return nBytes - -//--- - -static function WriteData(hFile,xData) -local cData := valtype(xData) - - if HB_ISSTRING(xData) - cData += i2bin( len( xData ) ) + xData - elseif HB_ISNUMERIC(xData) - cData += i2bin( len( alltrim( str( xData ) ) ) ) + alltrim( str( xData ) ) - elseif HB_ISDATE( xData ) - cData += i2bin( 8 )+dtos(xData) - elseif HB_ISLOGICAL(xData) - cData += i2bin( 1 )+iif( xData,"T","F" ) - elseif HB_ISARRAY( xData ) - cData += i2bin( len( xData ) ) - else - cData += i2bin( 0 ) // NIL - endif - -return fWrite( hFile, cData, len( cData ) ) - -//--- - -static function File2Array( cFile, nLen, hFile ) -LOCAL cData,cType,nDataLen,nBytes -local nDepth := 0 -local aRay := {} -local lOpen := ( hFile != nil ) - -if hFile == NIL // First Timer - if ( hFile := fOpen( cFile,FO_READ ) ) == F_ERROR - return aRay - endif - cData := space( 3 ) - fRead( hFile, @cData, 3 ) - if !( left( cData,1 ) == "A" ) // If format of file not an array - fClose( hFile ) ////////// - return aRay - endif - nLen := bin2i( right( cData,2 ) ) -endif - -do while nDepth < nLen - cData := space( 3 ) - nBytes := fRead( hFile, @cData, 3 ) - if nBytes < 3 - exit - endif - cType := padl( cData,1 ) - nDataLen := bin2i( right( cData,2 ) ) - if !( cType == "A" ) - cData := space( nDataLen ) - nBytes:= fRead( hFile, @cData, nDataLen ) - if nBytes < nDataLen - exit - endif - endif - nDepth++ - aadd( aRay,NIL ) - if cType=="C" - aRay[ nDepth ] := cData - elseif cType=="N" - aRay[ nDepth ] := val(cData) - elseif cType=="D" - aRay[ nDepth ] := ctod( left( cData, 4 ) + "/" + substr( cData, 5, 2 ) + "/" + substr( cData, 7, 2 )) //stod(cData) - elseif cType=="L" - aRay[ nDepth ] := ( cData=="T" ) - elseif cType=="A" - aRay[ nDepth ] := File2Array( , nDataLen, hFile ) - endif -enddo - -if !lOpen - fClose( hFile ) -endif - -return aRay - -//--- - -static FUNCTION NumAt( cSearch, cString ) - - LOCAL n := 0, nAt, nPos := 0 - WHILE ( nAt := at( cSearch, substr( cString, nPos + 1 ) )) > 0 - nPos += nAt - ++n - ENDDO - -RETURN n - -//--- - -static function RunExternal( cCmd, cVerb, cFile ) -local lRet := .T. - -#ifdef __CLP__ - lRet := SwpRunCmd( cCmd, 0, "", "" ) -#endif - -#ifdef __HARBOUR__ - if cVerb != nil -// TOFIX: This requires hbwhat, which in turns requires xhb. -// This has to be solved differently. -// ShellExecute( GetDeskTopWindow(), cVerb, cFile, , , 1 ) - HB_SYMBOL_UNUSED( cFile ) - else - hb_run( cCmd ) - endif -#endif - -#ifdef __XPP__ - RunShell( cCmd, , .T., .T. ) -#endif - -return lRet - -//--- diff --git a/harbour/extras/hbvpdf/tests/tstpdf.prg b/harbour/extras/hbvpdf/tests/tstpdf.prg deleted file mode 100644 index cb70e89b16..0000000000 --- a/harbour/extras/hbvpdf/tests/tstpdf.prg +++ /dev/null @@ -1,185 +0,0 @@ -/* - * $Id$ - */ - -#include "hbvpdf.ch" - -PROCEDURE Main() - - LOCAL nWidth, nTab, nI, nJ, nK, nCol, nRow, aStyle, aFonts - LOCAL nTop, nLeft, nBottom, nRight, cText, oPdf - LOCAL aColor := { ; - "FF0000", "8B0000", "800000", "FF4500", "D2691E", "B8860B", "FF8C00", "FFA500", "DAA520", "808000", "FFD700", "FFFF00", "ADFF2F", "9ACD32", "7FFF00", "7CFC00", "00FF00", "32CD32", "008000", "006400", ; - "66CDAA", "7FFFD4", "87CEFA", "87CEEB", "F0F8FF", "E0FFFF", "B0C4DE", "B0E0E6", "AFEEEE", "ADD8E6", "8FBC8F", "90EE90", "98FB98", "00FA9A", "00FF7F", "3CB371", "2E8B57", "228B22", "556B2F", "6B8E23", ; - "5F9EA0", "40E0D0", "48D1CC", "00CED1", "20B2AA", "008B8B", "008080", "2F4F4F", "00BFFF", "00FFFF", "00FFFF", "0000FF", "0000CD", "00008B", "000080", "1E90FF", "4169E1", "4682B4", "6495ED", "7B68EE", ; - "C71585", "FF1493", "FF00FF", "FF00FF", "9370DB", "DDADDD", "DB7093", "FF69B4", "DA70D6", "EE82EE", "BA55D3", "9932CC", "8A2BE2", "9400D3", "8B008B", "800080", "4B0082", "191970", "483D8B", "6A5ACD", ; - "DC143C", "B22222", "A52A2A", "CD5C5C", "FA8072", "E9967A", "FFA07A", "F5DEB3", "FFDEAD", "EEE8AA", "FFDAB9", "FFE4C4", "FFEFD5", "FFE4E1", "FFE4B5", "D2B48C", "DEB887", "F0E68C", "BDB76B", "F4A460", ; - "FDF5E6", "FFF8DC", "FAF0E6", "FAFAD2", "FFFACD", "FFEBCD", "FFFFE0", "FAEBD7", "FFF5EE", "FFF0F5", "D8BFD8", "FFC0CB", "FFB6C1", "BC8F8F", "F08080", "FF7F50", "FF6347", "8B4513", "A0522D", "CD853F", ; - "FFFAFA", "FFFFF0", "E6E6FA", "FFFAF0", "F8F8FF", "F0FFF0", "F5F5DC", "F0FFFF", "F5FFFA", "708090", "778899", "F5F5F5", "DCDCDC", "D3D3D3", "C0C0C0", "A9A9A9", "808080", "696969", "000000", "FFFFFF" } - - SET DATE FORMAT "YYYY/MM/DD" - - aStyle := { "Normal", "Bold", "Italic", "BoldItalic" } - - aFonts := {; - { "Times", .T. , .T. , .T. , .T. }, ; - { "Helvetica", .T. , .T. , .T. , .T. }, ; - { "Courier", .T. , .T. , .T. , .T. } } - - oPdf := tPdf():New( "test.pdf", 200, .T. ) - oPdf:EditOnHeader() - oPdf:Image( "files" + hb_ps() + "color.tif", 0, 0, "M" ) - oPdf:EditOffHeader() - oPdf:SaveHeader( "test.hea" ) - oPdf:CloseHeader() - oPdf:BookOpen() - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Grids & Borders", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "Simple Grid", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - - FOR nI := 0 TO 792 STEP 36 - oPdf:Box( nI, 0, nI, 612, 0.01, , "D" ) - NEXT - FOR nI := 0 TO 612 STEP 36 - oPdf:Box( 0, nI, 792, nI, 0.01, , "D" ) - NEXT - - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "10 dots border ", 2, 2, 0 ) - oPdf:Box( 0, 0, 792, 612, 10, , "D" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Boxes", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "Boxes", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - - nRow := 85 - nCol := 85 - oPdf:Box( nRow , ( nCol * 2 ) , ( nRow * 3 ) , ( nCol * 4 ) , 1.00, 15, "D" ) - oPdf:Box( nRow + 10, ( nCol * 2 ) + 10, ( nRow * 3 ) + 10, ( nCol * 4 ) + 10, 0.50, 25, "D" ) - oPdf:Box( nRow + 20, ( nCol * 2 ) + 20, ( nRow * 3 ) + 20, ( nCol * 4 ) + 20, 0.25, 35, "D" ) - oPdf:Box( nRow + 30, ( nCol * 2 ) + 30, ( nRow * 3 ) + 30, ( nCol * 4 ) + 30, 0.15, 45, "D" ) - oPdf:Box( nRow + 40, ( nCol * 2 ) + 40, ( nRow * 3 ) + 40, ( nCol * 4 ) + 40, 0.10, 55, "D" ) - oPdf:Box( nRow + 50, ( nCol * 2 ) + 50, ( nRow * 3 ) + 50, ( nCol * 4 ) + 50, 0.05, 65, "D" ) - oPdf:Box( nRow + 60, ( nCol * 2 ) + 60, ( nRow * 3 ) + 60, ( nCol * 4 ) + 60, 0.01, 75, "D" ) - oPdf:Box( nRow + 70, ( nCol * 2 ) + 70, ( nRow * 3 ) + 70, ( nCol * 4 ) + 70, 0.01, 85, "D" ) - oPdf:Box( nRow + 80, ( nCol * 2 ) + 80, ( nRow * 3 ) + 80, ( nCol * 4 ) + 80, 0.01, 95, "D" ) - oPdf:Box( nRow + 90, ( nCol * 2 ) + 90, ( nRow * 3 ) + 90, ( nCol * 4 ) + 90, 0.01, 100, "D" ) - - FOR nI := 1 TO 7 - nRow := 150 + nI * 10 - FOR nJ := 1 TO 20 - nCol := nJ * 10 - 3 - oPdf:Box( nRow, nCol, nRow + 10, nCol + 10, 0.01, nI * 10, "M", Chr( 253 ) + Chr( cton( SubStr( aColor[ ( nI - 1 ) * 20 + nJ ], 1, 2 ), 16 ) ) + Chr( cton( SubStr( aColor[ ( nI - 1 ) * 20 + nJ ], 3, 2 ), 16 ) ) + Chr( cton( SubStr( aColor[ ( nI - 1 ) * 20 + nJ ], 5, 2 ), 16 ) ) ) - NEXT - NEXT - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Color Boxes ", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - FOR nI := 1 TO 140 - nTop := ( nI - 1 ) * 2.4 - nLeft := ( nI - 1 ) * 2.1 - nBottom := oPdf:aReport[ PAGEY ] - ( nI - 1 ) * 2.47 - nRight := oPdf:aReport[ PAGEX ] - ( nI - 1 ) * 2.18 - oPdf:Box1( nTop, nLeft, nBottom, nRight, 10, Chr( cton( SubStr( aColor[ nI ], 1, 2 ), 16 ) ) + Chr( cton( SubStr( aColor[ nI ], 3, 2 ), 16 ) ) + Chr( cton( SubStr( aColor[ nI ], 5, 2 ), 16 ) ) ) - NEXT - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Memos", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "Different Styles & Colors", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - nWidth := 90 - nTab := 0 - cText := MemoRead( "files" + hb_ps() + "test.txt" ) - - oPdf:Text( cText, 28, 107.95, nWidth, nTab, 3, "M", Chr( 253 ) + Chr( 0 ) + Chr( 0 ) + Chr( 255 ) ) - oPdf:Text( cText, 58, 107.95, nWidth, nTab, 2, "M", Chr( 253 ) + Chr( 0 ) + Chr( 255 ) + Chr( 0 ) ) - oPdf:Text( cText, 88, 107.95, nWidth, nTab, 1, "M", Chr( 253 ) + Chr( 255 ) + Chr( 0 ) + Chr( 0 ) ) - oPdf:Text( cText, 118, 107.95 - nWidth / 2, nWidth, nTab, 4, "M", Chr( 253 ) + Chr( 255 ) + Chr( 255 ) + Chr( 0 ) ) - - oPdf:Text( cText, 34, 100, nWidth, nTab, 3, "R", Chr( 253 ) + Chr( 0 ) + Chr( 128 ) + Chr( 128 ) ) //, pdfTextCount( memoread( "files" + hb_ps() + "test.txt" ), 33, 100, nWidth, nTab, 3, "R" ) - oPdf:Text( cText, 41, 100, nWidth, nTab, 2, "R", Chr( 253 ) + Chr( 0 ) + Chr( 191 ) + Chr( 255 ) ) //, pdfTextCount( memoread( "files" + hb_ps() + "test.txt" ), 40, 100, nWidth, nTab, 2, "R" ) - oPdf:Text( cText, 48, 100, nWidth, nTab, 1, "R", Chr( 253 ) + Chr( 244 ) + Chr( 164 ) + Chr( 96 ) ) //, pdfTextCount( memoread( "files" + hb_ps() + "test.txt" ), 47, 100, nWidth, nTab, 1, "R" ) - oPdf:Text( cText, 55, 35, nWidth, nTab, 4, "R", Chr( 253 ) + Chr( 0 ) + Chr( 0 ) + Chr( 0 ) ) //, pdfTextCount( memoread( "files" + hb_ps() + "test.txt" ), 54, 35, nWidth, nTab, 4, "R" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Fonts", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "Different Styles", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - nK := 6 - FOR nI := 1 TO Len( aFonts ) // Fonts - ++nk - FOR nJ := 1 TO 4 // Styles - IF aFonts[ nI ][ nJ + 1 ] - oPdf:SetFont( aFonts[ nI ][ 1 ], nJ - 1, oPdf:aReport[ FONTSIZE ] ) - oPdf:RJust( "This is a test for " + aFonts[ nI ][ 1 ] + " " + ; - aStyle[ nJ ], nK++, oPdf:aReport[ REPORTWIDTH ], "R" ) - ENDIF - NEXT - oPdf:RJust( oPdf:Underline( "Underline" ), nK++, oPdf:aReport[ REPORTWIDTH ], "R" ) - oPdf:RJust( oPdf:Reverse( "Test" ), nK, oPdf:aReport[ REPORTWIDTH ], "R" ) - NEXT - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Pictures", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "TIFF", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - // file, row, col, units, height, width - oPdf:Image( "files" + hb_ps() + "color.tif", 0, 0, "M" ) - oPdf:RJust( oPdf:Underline( "TIFF" ), nK++, oPdf:aReport[ REPORTWIDTH ], "R" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "JPEG", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:Image( "files" + hb_ps() + "color.jpg", 0, 0, "M" ) // file, row, col, units, height, width - oPdf:RJust( oPdf:Underline( "JPEG" ), nK, oPdf:aReport[ REPORTWIDTH ], "R" ) - - oPdf:OpenHeader( "test.hea" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Headers", 1, oPdf:aReport[ REPORTPAGE ], 0 ) - oPdf:BookAdd( "Picture Header Page 8", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - - oPdf:AtSay( Chr( 253 ) + Chr( 255 ) + Chr( 0 ) + Chr( 0 ) + "Red Sample of header repeating on pages 8-10", 1, 20, "R" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Picture Header Page 9", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - - oPdf:AtSay( Chr( 253 ) + Chr( 0 ) + Chr( 255 ) + Chr( 0 ) + "Green Sample of header repeating on pages 8-10", 1, 20, "R" ) - - oPdf:NewPage( "LETTER", "P", 6 ) - oPdf:BookAdd( "Picture Header Page 10", 2, oPdf:aReport[ REPORTPAGE ], 0 ) - - oPdf:AtSay( Chr( 253 ) + Chr( 0 ) + Chr( 0 ) + Chr( 255 ) + "Blue Sample of header repeating on pages 8-10", 1, 20, "R" ) - - oPdf:Close() - -#ifndef __XPP__ - oPdf:Execute( "test.pdf" ) -#endif - -// oPdf:FilePrint() - - RETURN - -// -// This function called only used in tstPdf.prg -// - -STATIC FUNCTION cton( cString, nBase ) - - LOCAL cTemp, nI, cChar, n := 0, nLen - - nLen := Len( cString ) - cTemp := "" - FOR nI := nLen TO 1 step - 1 - cTemp += SubStr( cString, nI, 1 ) - NEXT - cTemp := Upper( cTemp ) - - FOR nI := 1 TO nLen - cChar := SubStr( cTemp, nI, 1 ) - IF .NOT. IsDigit( cChar ) - n := n + ( ( Asc( cChar ) - 65 ) + 10 ) * ( nBase ^ ( nI - 1 ) ) - ELSE - n := n + ( ( nBase ^ ( nI - 1 ) ) * Val( cChar ) ) - ENDIF - NEXT - - RETURN n diff --git a/harbour/extras/httpsrv/session.prg b/harbour/extras/httpsrv/session.prg index 83f7657618..520d3a7cf1 100644 --- a/harbour/extras/httpsrv/session.prg +++ b/harbour/extras/httpsrv/session.prg @@ -846,13 +846,13 @@ METHOD SendCacheLimiter() CLASS uhttpd_Session uhttpd_SetHeader( 'Pragma', 'no-cache' ) CASE ::cCache_Limiter == 'private' uhttpd_SetHeader( 'Expires', 'Thu, 19 Nov 1981 08:52:00 GMT' ) - uhttpd_SetHeader( 'Cache-Control', 'private, max-age=' + LTrim( Str( ::nCache_Expire * 60 ) ) ) + uhttpd_SetHeader( 'Cache-Control', 'private, max-age=' + hb_ntos( ::nCache_Expire * 60 ) ) IF hb_FGetDateTime( hb_argv(0), @dDate ) uhttpd_SetHeader( 'Last-Modified', uhttpd_DateToGMT( dDate ) ) ENDIF CASE ::cCache_Limiter == 'public' uhttpd_SetHeader( 'Expires', uhttpd_DateToGMT( ,,, ::nCache_Expire * 60 ) ) - uhttpd_SetHeader( 'Cache-Control', 'public, max-age=' + LTrim( Str( ::nCache_Expire * 60 ) ) ) + uhttpd_SetHeader( 'Cache-Control', 'public, max-age=' + hb_ntos( ::nCache_Expire * 60 ) ) IF hb_FGetDateTime( hb_argv(0), @dDate ) uhttpd_SetHeader( 'Last-Modified', uhttpd_DateToGMT( dDate ) ) ENDIF diff --git a/harbour/extras/httpsrv/uhttpd.prg b/harbour/extras/httpsrv/uhttpd.prg index 0af3f4b09d..f622ee5d17 100644 --- a/harbour/extras/httpsrv/uhttpd.prg +++ b/harbour/extras/httpsrv/uhttpd.prg @@ -563,7 +563,7 @@ PROCEDURE Main( ... ) IF s_lConsole hb_DispOutAt( 1, 5, APP_NAME + " - web server - v. " + APP_VERSION ) - hb_DispOutAt( 4, 5, "Server listening (Port: " + LTrim( Str( nPort ) ) + ") : ..." ) + hb_DispOutAt( 4, 5, "Server listening (Port: " + hb_ntos( nPort ) + ") : ..." ) hb_DispOutAt( 10, 9, "Waiting." ) ENDIF @@ -1436,7 +1436,7 @@ STATIC PROCEDURE WriteToLog( cRequest ) aMonths[ VAL( SUBSTR( cDate, 5, 2 ) ) ] + ; "/" + LEFT( cDate, 4 ) + ":" + cTime + ' ' + cBias + '] "' + ; LEFT( cRequest, AT( CR_LF, cRequest ) - 1 ) + '" ' + ; - LTRIM( STR( t_nStatusCode ) ) + " " + iif( nSize == 0, "-", LTRIM( STR( nSize ) ) ) + ; + hb_ntos( t_nStatusCode ) + " " + iif( nSize == 0, "-", hb_ntos( nSize ) ) + ; ' "' + iif( Empty( cReferer ), "-", cReferer ) + '" "' + _SERVER[ "HTTP_USER_AGENT" ] + ; '"' + hb_eol() @@ -1764,7 +1764,7 @@ STATIC PROCEDURE defineServer( hSocket ) IF ! Empty( aI := hb_socketGetSockName( hSocket ) ) _SERVER[ "SERVER_ADDR" ] := aI[ HB_SOCKET_ADINFO_ADDRESS ] - _SERVER[ "SERVER_PORT" ] := LTrim( Str( aI[ HB_SOCKET_ADINFO_PORT ] ) ) + _SERVER[ "SERVER_PORT" ] := hb_ntos( aI[ HB_SOCKET_ADINFO_PORT ] ) ENDIF // add other _SERVER vars @@ -2007,7 +2007,7 @@ STATIC PROCEDURE ShowServerStatus() LOCAL cThreads uhttpd_SetHeader( "Content-Type", "text/html" ) uhttpd_Write( '' ) - uhttpd_Write( '' ) + uhttpd_Write( '' ) uhttpd_Write( '' ) uhttpd_Write( 'Server Status

Server Status

')
    //uhttpd_Write( '')
@@ -2020,7 +2020,7 @@ STATIC PROCEDURE ShowServerStatus()
       uhttpd_Write( '
Max Connections: ' + Str( s_nMaxConnections ) )
       uhttpd_Write( '
Total Connections: ' + Str( s_nTotConnections ) )
       cThreads := ""
-      aEval( s_aRunningThreads, {| e | cThreads += LTrim( Str( hb_threadId( e ) ) ) + "," } )
+      aEval( s_aRunningThreads, {| e | cThreads += hb_ntos( hb_threadId( e ) ) + "," } )
       cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "" ) + " }"
       uhttpd_Write( '
Running Threads: ' + cThreads )
 
@@ -2030,7 +2030,7 @@ STATIC PROCEDURE ShowServerStatus()
       uhttpd_Write( '
Max Service Connections: ' + Str( s_nMaxServiceConnections ) )
       uhttpd_Write( '
Total Service Connections: ' + Str( s_nTotServiceConnections ) )
       cThreads := ""
-      aEval( s_aServiceThreads, {| e | cThreads += LTrim( Str( hb_threadId( e ) ) ) + "," } )
+      aEval( s_aServiceThreads, {| e | cThreads += hb_ntos( hb_threadId( e ) ) + "," } )
       cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "" ) + " }"
       uhttpd_Write( '
Service Threads: ' + cThreads )
 #endif // FIXED_THREADS
@@ -2141,17 +2141,17 @@ STATIC PROCEDURE Help()
    ?
    ? "Parameters: (all optionals)"
    ?
-   ? "-p       | --port           webserver tcp port         (default: " + LTrim( Str( LISTEN_PORT ) ) + ")"
+   ? "-p       | --port           webserver tcp port         (default: " + hb_ntos( LISTEN_PORT ) + ")"
    ? "-c       | --config         Configuration file         (default: " + APP_NAME + ".ini)"
    ? "                            It is possibile to define file path"
    ? "-a       | --approot        Application root directory (default: )"
    ? "-d       | --docroot        Document root directory    (default: \home)"
    ? "-i       | --indexes        Allow directory view       (default: no)"
    ? "-s       | --stop           Stop webserver"
-   ? "-ts      | --start-threads  Define starting threads    (default: " + LTrim( Str( START_RUNNING_THREADS ) ) + ")"
-   ? "-tm      | --max-threads    Define max threads         (default: " + LTrim( Str( MAX_RUNNING_THREADS ) ) + ")"
-   ? "-cr      | --console-rows   Console rows               (default: " + LTrim( Str( MaxRow() + 1 ) ) + ")"
-   ? "-cc      | --console-cols   Console cols               (default: " + LTrim( Str( MaxCol() + 1 ) ) + ")"
+   ? "-ts      | --start-threads  Define starting threads    (default: " + hb_ntos( START_RUNNING_THREADS ) + ")"
+   ? "-tm      | --max-threads    Define max threads         (default: " + hb_ntos( MAX_RUNNING_THREADS ) + ")"
+   ? "-cr      | --console-rows   Console rows               (default: " + hb_ntos( MaxRow() + 1 ) + ")"
+   ? "-cc      | --console-cols   Console cols               (default: " + hb_ntos( MaxCol() + 1 ) + ")"
    ? "-h | -?  | --help           This help message"
    ?
    WAIT
@@ -2627,7 +2627,7 @@ STATIC FUNCTION Handler_ServerStatus()
    LOCAL cThreads
    uhttpd_SetHeader( "Content-Type", "text/html" )
    uhttpd_Write( '' )
-   uhttpd_Write( '' )
+   uhttpd_Write( '' )
    uhttpd_Write( '' )
    uhttpd_Write( 'Server Status
Server Status
')
    //uhttpd_Write( '
')
@@ -2640,7 +2640,7 @@ STATIC FUNCTION Handler_ServerStatus()
       uhttpd_Write( '
Max Connections: ' + Str( s_nMaxConnections ) )
       uhttpd_Write( '
Total Connections: ' + Str( s_nTotConnections ) )
       cThreads := ""
-      aEval( s_aRunningThreads, {| e | cThreads += LTrim( Str( hb_threadId( e ) ) ) + "," } )
+      aEval( s_aRunningThreads, {| e | cThreads += hb_ntos( hb_threadId( e ) ) + "," } )
       cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "" ) + " }"
       uhttpd_Write( '
Running Threads: ' + cThreads )
 
@@ -2650,7 +2650,7 @@ STATIC FUNCTION Handler_ServerStatus()
       uhttpd_Write( '
Max Service Connections: ' + Str( s_nMaxServiceConnections ) )
       uhttpd_Write( '
Total Service Connections: ' + Str( s_nTotServiceConnections ) )
       cThreads := ""
-      aEval( s_aServiceThreads, {| e | cThreads += LTrim( Str( hb_threadId( e ) ) ) + "," } )
+      aEval( s_aServiceThreads, {| e | cThreads += hb_ntos( hb_threadId( e ) ) + "," } )
       cThreads := "{ " + iif( !Empty( cThreads ), Left( cThreads, Len( cThreads ) - 1 ), "" ) + " }"
       uhttpd_Write( '
Service Threads: ' + cThreads )
 #endif // FIXED_THREADS
diff --git a/harbour/tests/gtkeys.prg b/harbour/tests/gtkeys.prg
index 1a049df68b..8302001ab2 100644
--- a/harbour/tests/gtkeys.prg
+++ b/harbour/tests/gtkeys.prg
@@ -19,6 +19,10 @@ REQUEST HB_CODEPAGE_PLMAZ
 REQUEST HB_CODEPAGE_PLISO
 REQUEST HB_CODEPAGE_PL852
 REQUEST HB_CODEPAGE_PLWIN
+
+#define hb_keyCode( n ) Asc( n )
+#define hb_keyChar( c ) Chr( c )
+#define hb_ntos( n ) LTrim( Str( n ) )
 #endif
 
 PROCEDURE Main( cTermCP, cHostCP, lBoxChar )
@@ -267,14 +271,14 @@ PROCEDURE Main( cTermCP, cHostCP, lBoxChar )
       IF ( i := AScan( aKeys, {| x | x[ 2 ] == k } ) ) != 0
          ? " key:" + Str( aKeys[ i, 2 ], 7 ) + "  " + PadR( aKeys[ i, 1 ], 18 ) + aKeys[ i, 3 ]
       ELSEIF k >= 32 .AND. k <= 126 .OR. ( k >= 160 .AND. k <= 255 ) .OR. ;
-            ( k >= 0 .AND. k <= 255 .AND. IsAlpha( Chr( k ) ) )
-         ? "char:" + Str( k, 7 ) + "  " + Chr( k )
+            ( k >= 0 .AND. k <= 255 .AND. IsAlpha( hb_keyChar( k ) ) )
+         ? "char:" + Str( k, 7 ) + "  " + hb_keyChar( k )
       ELSE
          ? " key:" + Str( k, 7 )
       ENDIF
- //   ?? "  (" + ltrim( str( maxrow() ) ) + ":" + ltrim( str( maxcol() ) ) + ")"
+ //   ?? "  (" + hb_ntos( maxrow() ) + ":" + hb_ntos( maxcol() ) + ")"
 
-      IF k == Asc( "@" ) .AND. NextKey() == 0
+      IF k == hb_keyCode( "@" ) .AND. NextKey() == 0
          EXIT
 #ifdef __HARBOUR__
       ELSEIF k == K_CTRL_INS
diff --git a/harbour/tests/tb1.prg b/harbour/tests/tb1.prg
index 2a8465aed0..71bd465147 100644
--- a/harbour/tests/tb1.prg
+++ b/harbour/tests/tb1.prg
@@ -38,6 +38,7 @@
    #define _DRAW_7 Chr( 183 ) + " " + Chr( 214 ) + Chr( 196 ) + "HIDE" + Chr( 195 ) + Chr( 196 )
    #define _DRAW_8 Chr( 189 ) + " " + Chr( 211 ) + Chr( 196 )
    #define _DRAW_9 Chr( 186 ) + " " + Chr( 186 )
+   #define hb_keyCode( n ) Asc( n )
 #endif
 
 PROCEDURE Main()
@@ -131,8 +132,8 @@ PROCEDURE Main()
          oBrw:colorRect( { oBrw:rowPos, 1, oBrw:rowPos, 4 }, { 7, 6 } )
       ELSEIF nKey == K_DEL
          oBrw:refreshCurrent()
-      ELSEIF nKey >= Asc( "0" ) .AND. nKey <= Asc( "3" )
-         oBrw:freeze := nKey - Asc( "0" )
+      ELSEIF nKey >= hb_keyCode( "0" ) .AND. nKey <= hb_keyCode( "3" )
+         oBrw:freeze := nKey - hb_keyCode( "0" )
       ELSEIF nKey == K_LBUTTONDOWN .AND. ;
             oBrw:HitTest( MRow(), MCol() ) == HTHEADSEP .AND. ;
             ( ( nCol := oBrw:mColPos ) == 2 .OR. nCol == 3 )
diff --git a/harbour/tests/wvtext.prg b/harbour/tests/wvtext.prg
index bca3a6be20..cc84065ad2 100644
--- a/harbour/tests/wvtext.prg
+++ b/harbour/tests/wvtext.prg
@@ -80,7 +80,7 @@ PROCEDURE Main()
       CASE nKey == K_ENTER
          Alert( " Pressed" )
 
-      CASE nKey == Asc( "0" ) // setmode
+      CASE nKey == hb_keyCode( "0" ) // setmode
          SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
          DO WHILE .T.
             nModeCols := MaxCol() + 1
@@ -103,7 +103,7 @@ PROCEDURE Main()
          ENDDO
          DispScreen()
 
-      CASE nKey == Asc( "1" ) // "1" get/set Window-Height
+      CASE nKey == hb_keyCode( "1" ) // "1" get/set Window-Height
          nWndHeight := hb_gtInfo( HB_GTI_SCREENHEIGHT )
          nMaxWHeight := hb_gtInfo( HB_GTI_DESKTOPHEIGHT )
          SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@@ -118,7 +118,7 @@ PROCEDURE Main()
          ENDIF
          DispScreen()
 
-      CASE nKey == Asc( "2" )  // get/set Window-WIDTH
+      CASE nKey == hb_keyCode( "2" )  // get/set Window-WIDTH
          nWndWIDTH := hb_gtInfo( HB_GTI_SCREENWIDTH )
          nMaxWWIDTH := hb_gtInfo( HB_GTI_DESKTOPWIDTH )
          SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@@ -133,7 +133,7 @@ PROCEDURE Main()
          ENDIF
          DispScreen()
 
-      CASE nKey == Asc( "3" ) // get/set Window-Size
+      CASE nKey == hb_keyCode( "3" ) // get/set Window-Size
          aWndSize := hb_gtInfo( HB_GTI_SCREENSIZE )
          nMaxWWIDTH := hb_gtInfo( HB_GTI_DESKTOPWIDTH )
          nMaxWHeight := hb_gtInfo( HB_GTI_DESKTOPHEIGHT )
@@ -150,7 +150,7 @@ PROCEDURE Main()
          ENDIF
          DispScreen()
 
-      CASE nKey == Asc( "4" ) // set Window-Position by pixels
+      CASE nKey == hb_keyCode( "4" ) // set Window-Position by pixels
          aWndSize := hb_gtInfo( HB_GTI_SETPOS_XY )
          SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
          @ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@@ -165,7 +165,7 @@ PROCEDURE Main()
          ENDIF
          DispScreen()
 
-      CASE nKey == Asc( "5" ) // set Window-Position by row/col
+      CASE nKey == hb_keyCode( "5" ) // set Window-Position by row/col
          aWndSize := hb_gtInfo( HB_GTI_SETPOS_ROWCOL )
          SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
          @ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )