Try with this code :
PROCEDURE Main()
#ifdef __XHARBOUR__
REQUEST HB_GT_WIN
#endif
? Null * "A"
RETURN
//----------------------------------------//
PROCEDURE ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
RETURN
//----------------------------------------//
proc ErrorLink()
return
//----------------------------------------//
PROCEDURE ErrorDialog( e )
LOCAL cErrorLog := ''
ErrorBlock( {|e| Alert( ErrorMessage( e ) + " from Errorsys, line:" + Str(
ProcLine( 1 ), 3 ) ), __Quit() } )
FOR j = 1 to LocalCount( n )
cErrorLog += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
NEXT
? "Don't arrive, for GPF"
RETURN
//----------------------------------------------------------------------------//
static function ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Atención " ),;
"(DOS Error " + AllTrim(Str(e:osCode)) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C",;
e:SubSystem() ,;
"???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N",;
"/" + AllTrim( Str( e:SubCode ) ) ,;
"/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
// returns extended info for a certain variable type
static function cGetInfo( uVal )
local cType := ValType( uVal )
do case
case cType == "C"
return '"' + cValToChar( uVal ) + '"'
case cType == "O"
return "Class: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
//----------------------------------------//
function GetLocal( nProcLevel, nLocal )
return HB_DBG_VMVARLGET( nProcLevel + 1, ParamCount( nProcLevel + 1 ) + nLocal )
//----------------------------------------//
function LocalCount( nProcLevel )
return HB_DBG_VMSTKLCOUNT( nProcLevel + 1 ) - ParamCount( nProcLevel + 1 )
//----------------------------------------//
function cValToChar( uVal )
local cType := ValType( uVal )
do case
case cType == "C" .or. cType == "M"
return uVal
case cType == "D"
return DToC( uVal )
case cType == "L"
return If( uVal, ".T.", ".F." )
case cType == "N"
return AllTrim( Str( uVal ) )
case cType == "B"
return "{|| ... }"
case cType == "A"
return "{ ... }"
case cType == "O"
return "Object"
otherwise
return ""
endcase
return nil
function ParamCount( nProcLevel )
return Len( HB_DBG_VMPARLLIST( nProcLevel + 1 ) )
//----------------------------------------------------------------------------//
-------------------------------------------------------------------------
This SF.net email is sponsored by the 2008 JavaOne(SM) Conference
Don't miss this year's exciting event. There's still time to save $100.
Use priority code J8TL2D2.
http://ad.doubleclick.net/clk;198757673;13503038;p?http://java.sun.com/javaone
_______________________________________________
xHarbour-developers mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/xharbour-developers
