MOD-HARBOUR

Código: Seleccionar todo

#include "FileIO.ch"

function main()

	local hData := {=>}
	
	hData[ 'string'  ] := 'Hello world'
	hData[ 'numeric' ] := 1234
	hData[ 'date'    ] := date()
	hData[ 'logic'   ] := .T.						
	hData[ 'array'   ] := { 'Rambo', 1234, date()}
	hData[ 'class'   ] := ErrorNew()
	hData[ 'dummy_h' ] := {=>}
	hData[ 'dummy_a' ] := {}
	
		?? '<b>Test Logs</b><hr>'
	
	//	Output console DbWin32
	
		?? 'Check DBwin32<hr>'		
		
		_d( 'Test Debug for Windows...' )
		_d( 1234 )
		_d( date() )
		_d( .T. )
		_d( hData )		
		
		_d( '===== Multiple Vars =========' )	
		_d( 'Hello var', 1234, date(), { 'var1' => 123 }, {}, NIL )
		_d( '=============================' )
	
	//	Output to logfile
	
		?? 'Check log file', _l_File(), '<hr>'	
		
		_l()												//	Delete log file
		_l( '*** LOG ***' )
		_l( hData )	
		
		_l_File( hb_getenv( 'PRGPATH') + '/log2.txt' )	//	Declare new log file	
		_l( 'New log...')
		_l( time() )
	
retu nil


function _l_File( cFileLog )

	static cFile 	
	
	DEFAULT cFileLog TO ''
	
	if cFile == NIL 
		cFile := hb_getenv( 'PRGPATH') + '/log.txt'
	endif 
	
	if !empty( cFileLog )
		cFile := cFileLog 
	endif	

retu cFile 

/*	-------------------------------------------------
	Log file	
	Use: _l( uValue, ... )
---------------------------------------------------*/

function _l( ... )

	local cFile := _l_File()
	local hFile 
	
	if PCount() == 0
		if  fErase( cFile ) == -1
			//	? 'Error eliminando ' + cFilename, fError()
		endif
		retu nil 
	endif

	if ! File( cFile )
		fClose( FCreate( cFile ) )	
	endif

	if ( ( hFile := FOpen( cFile, FO_WRITE ) ) == -1 )	
		retu nil
	endif

	cLine  	:=  BuildLog( ... )
		
	fSeek( hFile, 0, FS_END )
	fWrite( hFile, cLine, Len( cLine ) )		

	fClose( hFile )   

retu 

/*	-------------------------------------------------
	Console for DbWin32  (only windows)
	Use: _d( uValue, ... )
---------------------------------------------------*/

function _d( ... )

retu WAPI_OutputDebugString( BuildLog( ... ) )

/*
	static pLib

	if pLib == NIL
		pLib := hb_LibLoad( 'kernel32.dll' )
	endif		
	
retu hb_DynCall( {'OutputDebugStringA', pLib }, BuildLog( ... ) )
*/

static function BuildLog( ... )

    local cLine 	:= ''
   	local nParam 	:= PCount()
	local nI 
	
	for nI := 1 to nParam
		cLine  	+= 'Type (' + valtype( pValue(nI) ) + ') ' + ValToLog( pValue(nI) ) + CRLF 		
	next	


retu cLine

static function ValToLog( u, nTab )

   local cType := ValType( u )
   local cResult
   local n, nLen, aPair, hValue 
   
   DEFAULT nTab TO  0
   
   nTab++

   do case
      case cType == "C" .or. cType == "M"
           cResult = u

      case cType == "D"		; cResult = DToC( u )
      case cType == "L" 	; cResult = If( u, ".T.", ".F." )
      case cType == "N"		; cResult = AllTrim( Str( u ) )	  
      case cType == "A"		; cResult := HashArrayToLog( @nTab, u )
		
      case cType == "O"		
	  
		hValue		:= ObjToHash(u)		
		cResult 	:= HashArrayToLog( @nTab, hValue )
		
      case cType == "P"   	; cResult = hb_NumToHex( u )  
      case cType == "S"		; cResult = "(Symbol)"  
      case cType == "H"		; cResult := HashArrayToLog( @nTab, u )   
      case cType == "U"		; cResult = "nil"
	  
      otherwise
           cResult = "type not supported yet in function ValToLog()"
   endcase

retu cResult 

static function HashArrayToLog( nTab, u )	

	local cResult 	:= ''
	local cType 	:= valtype( u)
	local nLen 	:= len( u )	
	local uValue 
	local n

	if nLen > 0 
	
		cResult := '{' + CRLF 
	
		for n := 1 to nLen			

			do case 
				case cType == 'H'		
					
					aPair := HB_HPairAt( u, n )					
					
					cResult += Replicate( space(3), nTab ) + 'Key: ' + aPair[1]  + ' (' + valtype(aPair[2]) + ') => ' + ValtoLog( aPair[2], nTab ) + CRLF				
				
				case cType == 'A'

					cResult += Replicate( space(3), nTab ) + 'Type (' + valtype( u[n] ) + ') ' + ValtoLog( u[n], nTab ) + CRLF				
			endcase

		next 
		
		cResult += Replicate( space(3), --nTab ) + '}'	
		
	else 
	
		if cType == 'H'
			cResult := '{=>}'
		else 
			cResult := '{}'
		endif	
	
	endif

retu cResult

static function ObjToHash( o )

	local hObj 	:= {=>}
	local hPairs 	:= {=>} 
	local oError 
	local aDatas, aParents 
	
	try 
	
		aDatas 		:= __objGetMsgList( o, .T. )
		aParents 	:= __ClsGetAncestors( o:ClassH )
	
		AEval( aParents, { | h, n | aParents[ n ] := __ClassName( h ) } ) 
	
		hObj[ "CLASS" ] := o:ClassName()
		hObj[ "FROM" ]  := aParents 
	
		AEval( aDatas, { | cData | hPairs[ cData ] := __ObjSendMsg( o, cData ) } )
		
		hObj[ "DATAs" ]   := hPairs
		hObj[ "METHODs" ] := __objGetMsgList( o, .F. )
	
	catch oError 
	
		hObj[ 'error'] := 'Error ObjToHash'		
		
	end 

retu hObj