by karinha » Mon Jan 22, 2007 9:31 pm
#Include "Error.Ch"
#Include "FiveWin.Ch"
#Define SW_SHOWNA 8 // &H8
#Define SW_SHOW 5 // &H5
#Define SW_HIDE 0 // &H0
External _fwGenError // Link FiveWin generic Error Objects Generator
#Define NTRIM(n) ( LTrim( Str( n ) ) )
#Ifdef __CLIPPER__
#define DLG_TITLE "FiveWin: The CA-Clipper For Windows Library"
#Else
#Ifdef __XHARBOUR__
#define DLG_TITLE "FiveWin For [x]Harbour-Erros de GPF"
#Else
#define DLG_TITLE "FiveWin For Xbase++"
#Endif
#Endif
/*************
* ErrorSys()
*
* Note: automatically executes at startup
*/
proc ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
return
proc ErrorLink()
return
/*************
* ErrorDialog()
*/
static function ErrorDialog( e ) // -> logical or quits App.
local oDlg, oLbx, oFont, oWnd
local lRet // if lRet == nil -> default action: QUIT
local n, j, cMessage, aStack := {}
local oSay, hLogo
local nButtons := 1
local cErrorLog := ""
local aVersions := GetVersion()
local aTasks
local aRDDs, nTarget, uValue
local oOldError
local cRelation
local lIsWinNT := IsWinNT()
// by default, division by zero yields zero
if ( e:genCode == EG_ZERODIV )
return 0
end
// for network open error, set NETERR() and subsystem default
if ( e:genCode == EG_OPEN .and. ;
( e:osCode == 32 .or. e:osCode == 5 ) .and. ;
e:canDefault )
NetErr( .t. )
return .f. // Warning: Exiting!
end
// for lock error during APPEND BLANK, set NETERR() and subsystem default
if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
endif
if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
// "Exibindo a barra de tarefas"
ShowWindow(FindWindow( 'Shell_TrayWnd',Nil), SW_SHOWNA)
oWnd:End()
__QUIT()
endif
ErrorBlock( {|e| ( MsgStop( OemToAnsi( ErrorMessage(e) ), "Mensagem de Erro" )+;
" Linha do Erro: " + ;
Str( ProcLine( 1 ), 3 ) ), __Quit() } )
cErrorLog += "Aplica‡Æo: " + CRLF
cErrorLog += "===========" + CRLF
cErrorLog += " Caminho(Path): " + GetModuleFileName( GetInstance() )
#ifdef __CLIPPER__
cErrorLog += " (16 bits)" + CRLF
#else
cErrorLog += " (32 bits)" + CRLF
#endif
cErrorLog += " Tamanho: " + Transform( FSize( GetModuleFileName( ;
GetInstance() ) ), "9,999,999 bytes" ) + CRLF
#ifdef __CLIPPER__
cErrorLog += " Numero Maximo de Arquivos Permitidos: ( SetHandleCount() ) " + ;
Str( SetHandleCount(), 3 ) + CRLF
#endif
cErrorLog += " Hora Inicial: " + TimeFromStart() + CRLF
cErrorLog += " Ocorrencia de Erro: " + ;
DToC( Date() ) + ", " + Time() + CRLF
// Error object analysis
cMessage = " Descri‡Æo do Erro: " + ErrorMessage( e ) + CRLF
cErrorLog += cMessage
if ValType( e:Args ) == "A"
cErrorLog += " Argumentos:" + CRLF
for n = 1 to Len( e:Args )
cErrorLog += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
next
endif
cErrorLog += CRLF + "Chamada da Pilha: " + CRLF
cErrorLog += "================= " + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty(ProcName( n ) )
AAdd( aStack, " Chamada De: " + Trim( ProcName( n ) ) + ;
"(" + NTRIM( ProcLine( n ) ) + ")" )
cErrorLog += ATail( aStack ) + CRLF
endif
n++
end
cErrorLog += CRLF + "Sistema: " + CRLF
cErrorLog += "======" + CRLF
#ifdef __CLIPPER__
cErrorLog += " CPU Tipo: " + GetCPU() + CRLF
#else
cErrorLog += " CPU Tipo: " + GetCPU() + " " + ;
AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" + CRLF
#endif
cErrorLog += " Hardware Memoria: " + ;
cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
" megas" + CRLF + CRLF
cErrorLog += " Recursos Livres(Free): " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" + CRLF + ;
" GDI Recursos : " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" + CRLF + ;
" Recursos Usados : " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" + CRLF + CRLF
cErrorLog += " Versão do Compilador: " + Version() + CRLF
#ifdef __CLIPPER__
cErrorLog += " VersÆo do MsDos e Windows: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 4 ] ) ) + CRLF + CRLF
#else
cErrorLog += " VersÆo do Windows: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + ;
" " + aVersions[ 5 ] + CRLF + CRLF
#endif
aTasks = GetTasks()
cErrorLog += " Total de Aplicações Rodando no Windows: " + ;
AllTrim( Str( Len( aTasks ) ) ) + CRLF
for n = 1 to Len( aTasks )
cErrorLog += " " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
next
// Warning!!! Keep here this code !!! Or we will be consuming GDI as
// we don't generate the error but we were generating the bitmap
hLogo = FWBitMap()
if e:canRetry
nButtons++
endif
if e:canDefault
nButtons++
endif
cErrorLog += CRLF + "Vari veis em uso: " + CRLF + ;
"================= " + CRLF
cErrorLog += " Procedimento Tipo Valor" + CRLF
cErrorLog += " ==========================" + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty( ProcName( n ) )
cErrorLog += " " + Trim( ProcName( n ) ) + CRLF
for j = 1 to ParamCount( n )
cErrorLog += " Param " + Str( j, 3 ) + ": " + ;
ValType( GetParam( n, j ) ) + ;
" " + cGetInfo( GetParam( n, j ) ) + CRLF
next
for j = 1 to LocalCount( n )
cErrorLog += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
next
endif
n++
end
cErrorLog += CRLF + "RDDs Usados: " + CRLF + ;
"============ " + CRLF
aRDDs = RddList( 1 )
for n = 1 to Len( aRDDs )
cErrorLog += " " + aRDDs[ n ] + CRLF
next
cErrorLog += CRLF + "DataBases em Uso: " + CRLF + ;
"================= " + CRLF
for n = 1 to 255
if ! Empty( Alias( n ) )
cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", " " ) + ;
PadR( Alias( n ), 15 ) + Space( 20 ) + "RddNome: " + ;
( Alias( n ) )->( RddName() ) + CRLF
cErrorLog += " ==============================" + CRLF
cErrorLog += " RecNo RecCount BOF EOF" + CRLF
cErrorLog += " " + Transform( ( Alias( n ) )->( RecNo() ), "99999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "99999" ) + ;
" " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
" " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF
cErrorLog += " Indices em Uso " + Space( 23 ) + "TagName" + CRLF
for j = 1 to 15
if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
cErrorLog += Space( 8 ) + ;
If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", " " ) + ;
PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
( Alias( n ) )->( OrdName( j ) ) + ;
CRLF
endif
next
cErrorLog += CRLF + " Relations em Uso " + CRLF
for j = 1 to 8
if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF
// uValue = ( Alias( n ) )->( DbRelation( j ) )
// cErrorLog += cValToChar( &( uValue ) ) + CRLF
endif
next
endif
next
n = 1
cErrorLog += CRLF + "Classes em Uso:" + CRLF
cErrorLog += "===============" + CRLF
while ! Empty( __ClassName( n ) )
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
cErrorLog += CRLF + "Analise da Memoria" + CRLF
cErrorLog += "===============" + CRLF
#ifdef __CLIPPER__
cErrorLog += " Memoria Estatica:" + CRLF
cErrorLog += " Seguimento de Dados: 64k" + CRLF
#endif
#ifdef __CLIPPER__
cErrorLog += " Tamanho Inicial: " + ;
LTrim( Str( nInitDSSize() ) ) + ;
" Bytes (SYMP=" + LTrim( Str( nSymPSize() ) ) + ;
", Stack(Pilha)=" + LTrim( Str( nStackSize() ) ) + ;
", Heap(Pilha)=" + LTrim( Str( nHeapSize() ) ) + ")" + CRLF
cErrorLog += " PRG Stack: " + ;
LTrim( Str( 65535 - ( nStatics() * 14 ) - nInitDSSize() ) ) + ;
" Bytes" + CRLF
#endif
#ifdef __CLIPPER__
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Variaveis Estaticas: " + ;
LTrim( Str( nStatics() * 14 ) ) + " Bytes" + CRLF + CRLF
#else
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Variaveis Estaticas: " + ;
CRLF + CRLF
#endif
cErrorLog += " Consumo de Memoria Dinamica: " + CRLF
cErrorLog += " Memoria Atual.: " + Str( MemUsed() ) + " Bytes" + CRLF
cErrorLog += " Memoria Maxima: " + Str( MemMax() ) + " Bytes" + CRLF
// nSymNames() no longer returns a real value! 15/April/97
/*
cErrorLog += " Segmento SYMBOLS" + CRLF
cErrorLog += " " + LTrim( Str( nSymNames() ) ) + " SymbolNomes: " + ;
LTrim( Str( nSymNames() * 16 ) ) + " bytes"
*/
// Generates a file with an Error Log
BEGIN SEQUENCE
oOldError = ErrorBlock( { || DoBreak() } )
MemoWrit( "Error.Log", cErrorLog )
END SEQUENCE
ErrorBlock( oOldError )
/* PANTALLA DE CONTROL DEL ERROR */
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -12
DEFINE DIALOG oDlg ;
SIZE 360, 260 + If( lIsWinNT, 50, 0 ) ;
TITLE DLG_TITLE ;
FONT oFont ;
STYLE DS_MODALFRAME
oDlg:lHelpIcon := .F.
@ 0, 0 SAY oSay PROMPT OemToAnsi( cMessage ) ;
CENTERED OF oDlg FONT oFont SIZE 149, 20
oSay:nStyle = nOR( oSay:nStyle, 128 ) // SS_NOPREFIX
oSay:nTop = 3
oSay:nLeft = 22
oSay:nBottom = 25
oSay:nRight = 148
@ 34, 6 SAY "Listagem do Stack(Pilha)" OF oDlg FONT oFont PIXEL
n = aStack[ 1 ]
@ 43, 3 LISTBOX oLbx VAR n ITEMS aStack OF oDlg ;
SIZE 175, 60 + If( lIsWinNT, 18, 0 ) PIXEL //145
if nButtons == 1 .or. nButtons == 3
@ 100 + If( lIsWinNT, 24, 0 ), 70 BUTTON "&Saida" OF oDlg ;
ACTION( oDlg:End() ) CANCEL ;
SIZE 30, 11 PIXEL FONT oFont DEFAULT
else
@ 100 + If( lIsWinNT, 24, 0 ), 40 BUTTON "&Saida" OF oDlg ;
ACTION( oDlg:End() ) CANCEL ;
SIZE 30, 11 PIXEL FONT oFont
endif
if e:CanRetry
@ 100 + If( lIsWinNT, 24, 0 ), If( nButtons == 2, 82, 13 ) ;
BUTTON "&Retentar" ;
OF oDlg ACTION ( lRet := .t., oDlg:End() ) CANCEL ;
SIZE 30, 11 FONT oFont PIXEL
endif
if e:CanDefault
@ 100 + If( lIsWinNT, 24, 0 ), 108 BUTTON "&Default" OF oDlg ;
ACTION ( lRet := .f., oDlg:End() ) CANCEL ;
SIZE 30, 11 FONT oFont PIXEL
endif
@ 32, 74 BUTTON "Verificar o Arquivo Error.Log" OF oDlg ;
FONT oFont PIXEL ;
SIZE 074, 10 ;
ACTION( WinExec( "Notepad.exe Error.Log" ) ) // Bloco de Notas
SET FONT OF oDlg TO oFont
ACTIVATE DIALOG oDlg CENTERED ;
ON PAINT DrawBitmap( hDC, hLogo, 6, 6 )
DeleteObject( hLogo )
oFont:End()
If lRet == Nil .Or. ( !LWRunning() .And. lRet )
DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
/*
Rossine,
Please add these lines in source\function\errsysw.prg:
Código:
*/
//-> Novo, By Antonio Linares - Incorporei em 22/01/2007 - JoÆo
//-> NEW !!! Forum Internacional, Antonio Linares.
//-> Corre‡Æo de Estouro de Pilha.
FOR n = 1 TO LEN( GetAllWin() )
IF ValType( GetAllWin()[ n ] ) == "O"
GetAllWin()[ n ]:UnLink()
ENDIF
NEXT
// "Exibindo a barra de tarefas"
ShowWindow(FindWindow( 'Shell_TrayWnd',Nil), SW_SHOWNA)
oWnd:End()
__QUIT() // must be QUIT !!!
Else
DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
/*
Rossine,
Please add these lines in source\function\errsysw.prg:
Código:
*/
//-> Novo, By Antonio Linares - Incorporei em 22/01/2007 - JoÆo
//-> NEW !!! Forum Internacional, Antonio Linares.
//-> Corre‡Æo de Estouro de Pilha.
FOR n = 1 TO LEN( GetAllWin() )
IF ValType( GetAllWin()[ n ] ) == "O"
GetAllWin()[ n ]:UnLink()
ENDIF
NEXT
// "Exibindo a barra de tarefas"
ShowWindow(FindWindow( 'Shell_TrayWnd',Nil), SW_SHOWNA)
oWnd:End()
__QUIT() // must be QUIT !!!
Endif
return lRet
//----------------------------------------------------------------------------//
static function DoBreak()
BREAK
return nil
//----------------------------------------------------------------------------//
static func ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Warning " ),;
"(DOS Error " + NTRIM(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",;
"/" + NTRIM( 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 "Classe: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
//----------------------------------------------------------------------------//
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
function GetCPU()
local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
"HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
.f. )
local cCpu := oReg:Get( "ProcessorNameString" )
oReg:Close()
return cCpu
//----------------------------------------------------------------------------//
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341