Realmente se usar com outra LIB junto como GTWVT, GTWVW, WVWTOOLS e etc... ai não vai funcionar, nesse caso tem que adptar o errorsys.prg do xharbour.gilbertosilverio escreveu: Fiz teste com xhb 1.2.1 + wvt + hwgui e tambem da erro.
Enviar arq. de erro por email.
Moderador: Moderadores
- sygecom
- Administrador

- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: Enviar arq. de erro por email.
Mas você compilou junto com seu sistema o ultimo ErrorSys.prg que postei ? esta linkando na LIB da Hwgui. ? Acabei de testar na rede e funcionou tudo certo aqui, simulei varios erros e todos enviaram.
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
-
gilbertosilverio
- Usuário Nível 3

- Mensagens: 339
- Registrado em: 18 Jan 2009 10:39
- Localização: Ribeirao Pires - SP
Re: Enviar arq. de erro por email.
Leonardo,
Creio que o erro estaja aqui;
LogInitialPath := "\" + CurDir() + IIf( Empty( CurDir() ), "", "\" )
pois se mapeio a unidade da rede, funciona, ja se crio um atalho direto da pasta como, \\maquina\c\Pastasis\sistema.exe, da a mensagem de erro.
erro irrecuperavel 9003 - Muitas chamadas recursivas ao manipulador de erros
Creio que o erro estaja aqui;
LogInitialPath := "\" + CurDir() + IIf( Empty( CurDir() ), "", "\" )
pois se mapeio a unidade da rede, funciona, ja se crio um atalho direto da pasta como, \\maquina\c\Pastasis\sistema.exe, da a mensagem de erro.
erro irrecuperavel 9003 - Muitas chamadas recursivas ao manipulador de erros
GilbertoSilverio
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
- sygecom
- Administrador

- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: Enviar arq. de erro por email.
Então foi por isso, aqui o teste que fiz foi em uma rede mapeada. Vou fazer um teste em atalho direto, e depois reporto aqui uma solução.
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
-
gilbertosilverio
- Usuário Nível 3

- Mensagens: 339
- Registrado em: 18 Jan 2009 10:39
- Localização: Ribeirao Pires - SP
Re: Enviar arq. de erro por email.
Agradeço sua atençao...
GilbertoSilverio
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
-
gilbertosilverio
- Usuário Nível 3

- Mensagens: 339
- Registrado em: 18 Jan 2009 10:39
- Localização: Ribeirao Pires - SP
Re: Enviar arq. de erro por email.
Leonardo,
Consegui enviar os erros pelo errorsys.prg do xhb.
Caso sirva de exemplo, com ele consigo enviar tanto local como em rede, quando usado com wvw, wvt. Com Hwgui nao testei.
Consegui enviar os erros pelo errorsys.prg do xhb.
Caso sirva de exemplo, com ele consigo enviar tanto local como em rede, quando usado com wvw, wvt. Com Hwgui nao testei.
Código: Selecionar todos
STATIC cNOME
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
PROCEDURE ErrorSys
Errorblock( { | oError | DefError( oError ) } )
Return
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
STATIC FUNCTION DefError( oError )
LOCAL cMessage
LOCAL cDOSError
LOCAL aOptions
LOCAL nChoice
LOCAL n
// By default, division by zero results in zero
IF oError:genCode == EG_ZERODIV
RETURN 0
ENDIF
// By default, retry on RDD lock error failure */
IF oError:genCode == EG_LOCK .AND. ;
oError:canRetry
// oError:tries++
RETURN .T.
ENDIF
// Set NetErr() of there was a database open error
IF oError:genCode == EG_OPEN .AND. ;
oError:osCode == 32 .AND. ;
oError:canDefault
NetErr( .T. )
RETURN .F.
ENDIF
// Set NetErr() if there was a lock error on dbAppend()
IF oError:genCode == EG_APPENDLOCK .AND. ;
oError:canDefault
NetErr( .T. )
RETURN .F.
ENDIF
// Making sure we display the error info!
DO WHILE DispCount() > 0
DispEnd()
ENDDO
cMessage := ErrorMessage( oError )
If !Empty( oError:osCode )
cDOSError := "(DOS Error " + Ltrim( Str( oError:osCode ) ) + ")"
Endif
If ValType( oError:Args ) == "A"
cMessage += " Arguments: (" + Arguments( oError ) + ")"
Endif
// Build buttons
IF MaxCol() > 0
aOptions := {}
// AAdd( aOptions, "Break" )
Aadd( aOptions, "Fechar" )
If oError:canRetry
Aadd( aOptions, "Repetir" )
Endif
If oError:canDefault
Aadd( aOptions, "Default" )
Endif
// Show alert box
//TraceLog( cMessage )
nChoice := 0
While nChoice == 0
If Empty( oError:osCode )
nChoice := Alert( cMessage, aOptions )
Else
nChoice := Alert( cMessage + ";" + cDOSError, aOptions )
Endif
Enddo
IF ! Empty( nChoice )
DO CASE
CASE aOptions[ nChoice ] == "Break"
Break( oError )
CASE aOptions[ nChoice ] == "Repetir"
RETURN .T.
CASE aOptions[ nChoice ] == "Default"
RETURN .F.
ENDCASE
ENDIF
ELSE
IF Empty( oError:osCode )
nChoice := Alert( cMessage + ";" + oError:ProcName + "(" + LTrim( Str( oError:ProcLine() ) ) + ") in module: " + oError:ModuleName )
ELSE
nChoice := Alert( cMessage + ";" + cDOSError + ";" + oError:ProcName + "(" + LTrim( Str( oError:ProcLine() ) ) + ") in module: " + oError:ModuleName )
ENDIF
ENDIF
// "Quit" selected
IF ! Empty( oError:osCode )
cMessage += " " + cDOSError
ENDIF
? cMessage
?
? "Error at ...:", oError:ProcName + "(" + LTrim( Str( oError:ProcLine ) ) + ") in Module:", oError:ModuleName
n := 2
WHILE ! Empty( ProcName( ++n ) )
? "Called from :", ProcName( n ) + ;
"(" + LTrim( Str( ProcLine( n ) ) ) + ") in Module:", ProcFile( n )
ENDDO
/// For some strange reason, the DOS prompt gets written on the first line
/// *of* the message instead of on the first line *after* the message after
/// the program quits, unless the screen has scrolled. - dgh
LogError( oError )
ErrorLevel( 1 )
?
ENVIA_ERRO(cNOME)
QUIT
RETURN .F.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Function ENVIA_ERRO()
LOCAL oSmtp, oEMail
LOCAL cSmtpUrl
LOCAL cSubject, cFrom, cTo, cBody, cFile
cSmtpUrl := "smtp://meuemail:senha@smtp.mail.yahoo.com.br"
cFrom := "meuemail@yahoo.com.br"
cTo := "meuemail@ymail.com"
cSubject := [Envio de erro]
cFile := cNOME
cBody := [Envio de erro]
oEMail := TIpMail():new()
oEMail:setHeader( cSubject, cFrom, cTo )
oEMail:setBody( cBody )
oEMail:attachFile( cFile )
//oEMail:hHeaders[ "Disposition-Notification-To" ] := cFrom // solicita confirmacao
oSmtp := TIpClientSmtp():new( cSmtpUrl )
IF oSmtp:open()
oSmtp:sendMail( oEMail )
oSmtp:close()
MSGINFO( [E-Mail enviado], [Aviso] )
ELSE
MSGINFO( "Erro:", oSmtp:lastErrorMessage() )
ENDIF
RETURN Nil
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage
// start error message
cMessage := Iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "
// add subsystem name if available
If Ischaracter( oError:subsystem )
cMessage += oError:subsystem()
Else
cMessage += "???"
Endif
// add subsystem's error code if available
If Isnumber( oError:subCode )
cMessage += "/" + Ltrim( Str( oError:subCode ) )
Else
cMessage += "/???"
Endif
// add error description if available
If Ischaracter( oError:description )
cMessage += " " + oError:description
Endif
// add either filename or operation
Do Case
Case !Empty( oError:filename )
cMessage += ": " + oError:filename
Case !Empty( oError:operation )
cMessage += ": " + oError:operation
Endcase
Return cMessage
STATIC FUNCTION LogError( oerr )
LOCAL cScreen
LOCAL aLogFile := SET( _SET_ERRORLOG )
LOCAL cLogFile := aLogFile[1] // error log file name
LOCAL lAppendLog := aLogFile[2] // .f. = create a new error log (default) .t. = append to a existing one.
LOCAL nStart := 1
LOCAL nCellSize
LOCAL nRange
LOCAL nCols
LOCAL nRows
LOCAL nCount
LOCAL nForLoop
LOCAL cOutString
LOCAL cSubString
LOCAL nHandle
LOCAL nBytes
LOCAL nHandle2 := -1
LOCAL cLogFile2 := "_error.log"
LOCAL cBuff := ""
LOCAL nRead := 0
nCols := MaxCol()
IF nCols > 0
nRows := MaxRow()
cScreen := Savescreen()
ENDIF
//Alert( 'An error occured, Information will be ;written to error.log' )
If !lAppendLog
nHandle := FCreate( cLogFile, FC_NORMAL )
Else
If !File( cLogFile )
nHandle := FCreate( cLogFile, FC_NORMAL )
Else
nHandle := FCreate( cLogFile2, FC_NORMAL )
nHandle2 := FOpen( cLogFile, FO_READ )
Endif
Endif
If nHandle < 3 .and. lower( cLogFile ) != 'error.log'
// Force creating error.log in case supplied log file cannot
// be created for any reason
cLogFile := 'error.log'
nHandle := Fcreate( cLogFile, FC_NORMAL )
Endif
If nHandle < 3
Else
FWriteLine( nHandle, Padc( ' xHarbour Error Log ' , 79, '-' ) )
FWriteLine( nHandle, '' )
FWriteLine( nHandle, 'Data...............: ' + dtoc( date() ) )
FWriteLine( nHandle, 'Hora...............: ' + time() )
FWriteLine( nHandle, '' )
FWriteLine( nHandle, 'Aplicacao .........: ' + hb_cmdargargv() )
FWriteLine( nHandle, 'Nome da estacao ...: ' + netname() )
FWriteLine( nHandle, 'memoria avaliada...: ' + strvalue( Memory(0) ) )
FWriteLine( nHandle, 'disco corrente ....: ' + diskname() )
FWriteLine( nHandle, 'diretorio usado ..: ' + curdir() )
FWriteLine( nHandle, '' )
FWriteLine( nHandle, 'systema operacional: ' + os() )
FWriteLine( nHandle, 'xHarbour version...: ' + version() )
FWriteLine( nHandle, 'xHarbour built on..: ' + hb_builddate() )
FWriteLine( nHandle, 'C/C++ compiler.....: ' + hb_compiler() )
FWriteLine( nHandle, 'Multi Threading....: ' + If( Hb_MultiThread(),"YES","NO" ) )
FWriteLine( nHandle, 'VM Optimization....: ' + strvalue( Hb_VmMode() ) )
/*
IF Type( "Select()" ) != "UI"
FWriteLine( nHandle, '' )
FWriteLine( nHandle, 'Current Area ......:' + strvalue( &("Select()") ) )
ENDIF
*/
FWriteLine( nHandle, '' )
FWriteLine( nHandle, Padc( ' Environmental Information ', 79, '-' ) )
FWriteLine( nHandle, '' )
FWriteLine( nHandle, "SET ALTERNATE......: " + strvalue( Set( _SET_ALTERNATE ), .T. ) )
FWriteLine( nHandle, "SET ALTFILE........: " + strvalue( Set( _SET_ALTFILE ) ) )
FWriteLine( nHandle, "SET AUTOPEN........: " + strvalue( Set( _SET_AUTOPEN ), .T. ) )
FWriteLine( nHandle, "SET AUTORDER.......: " + strvalue( Set( _SET_AUTORDER ) ) )
FWriteLine( nHandle, "SET AUTOSHARE......: " + strvalue( Set( _SET_AUTOSHARE ) ) )
FWriteLine( nHandle, "SET BACKGROUNDTASKS: " + strvalue( Set( _SET_BACKGROUNDTASKS ), .T. ) )
FWriteLine( nHandle, "SET BACKGROUNDTICK.: " + strvalue( Set( _SET_BACKGROUNDTICK ), .T. ) )
FWriteLine( nHandle, "SET BELL...........: " + strvalue( Set( _SET_BELL ), .T. ) )
FWriteLine( nHandle, "SET BLINK..........: " + strvalue( SetBlink() ) )
FWriteLine( nHandle, "SET CANCEL.........: " + strvalue( Set( _SET_CANCEL ), .T. ) )
FWriteLine( nHandle, "SET CENTURY........: " + strvalue( __SetCentury(), .T. ) )
FWriteLine( nHandle, "SET COLOR..........: " + strvalue( Set( _SET_COLOR ) ) )
FWriteLine( nHandle, "SET CONFIRM........: " + strvalue( Set( _SET_CONFIRM ), .T. ) )
FWriteLine( nHandle, "SET CONSOLE........: " + strvalue( Set( _SET_CONSOLE ), .T. ) )
FWriteLine( nHandle, "SET COUNT..........: " + strvalue( Set( _SET_COUNT ) ) )
FWriteLine( nHandle, "SET CURSOR.........: " + strvalue( Set( _SET_CURSOR ) ) )
FWriteLine( nHandle, "SET DATE FORMAT....: " + strvalue( Set( _SET_DATEFORMAT ) ) )
FWriteLine( nHandle, "SET DBFLOCKSCHEME..: " + strvalue( Set( _SET_DBFLOCKSCHEME ) ) )
FWriteLine( nHandle, "SET DEBUG..........: " + strvalue( Set( _SET_DEBUG ), .T. ) )
FWriteLine( nHandle, "SET DECIMALS.......: " + strvalue( Set( _SET_DECIMALS ) ) )
FWriteLine( nHandle, "SET DEFAULT........: " + strvalue( Set( _SET_DEFAULT ) ) )
FWriteLine( nHandle, "SET DELETED........: " + strvalue( Set( _SET_DELETED ), .T. ) )
FWriteLine( nHandle, "SET DELIMCHARS.....: " + strvalue( Set( _SET_DELIMCHARS ) ) )
FWriteLine( nHandle, "SET DELIMETERS.....: " + strvalue( Set( _SET_DELIMITERS ), .T. ) )
FWriteLine( nHandle, "SET DEVICE.........: " + strvalue( Set( _SET_DEVICE ) ) )
FWriteLine( nHandle, "SET DIRCASE........: " + strvalue( Set( _SET_DIRCASE ) ) )
FWriteLine( nHandle, "SET DIRSEPARATOR...: " + strvalue( Set( _SET_DIRSEPARATOR ) ) )
FWriteLine( nHandle, "SET EOL............: " + strvalue( Asc( Set( _SET_EOL ) ) ) )
FWriteLine( nHandle, "SET EPOCH..........: " + strvalue( Set( _SET_EPOCH ) ) )
FWriteLine( nHandle, "SET ERRORLOG.......: " + if(!Empty(aLogFile), strvalue( aLogFile[1] )+","+strvalue( aLogFile[2] ), "") )
FWriteLine( nHandle, "SET ERRORLOOP......: " + strvalue( Set( _SET_ERRORLOOP ) ) )
FWriteLine( nHandle, "SET ESCAPE.........: " + strvalue( Set( _SET_ESCAPE ), .T. ) )
FWriteLine( nHandle, "SET EVENTMASK......: " + strvalue( Set( _SET_EVENTMASK ) ) )
FWriteLine( nHandle, "SET EXACT..........: " + strvalue( Set( _SET_EXACT ), .T. ) )
FWriteLine( nHandle, "SET EXCLUSIVE......: " + strvalue( Set( _SET_EXCLUSIVE ), .T. ) )
FWriteLine( nHandle, "SET EXIT...........: " + strvalue( Set( _SET_EXIT ), .T. ) )
FWriteLine( nHandle, "SET EXTRA..........: " + strvalue( Set( _SET_EXTRA ), .T. ) )
FWriteLine( nHandle, "SET EXTRAFILE......: " + strvalue( Set( _SET_EXTRAFILE ) ) )
FWriteLine( nHandle, "SET FILECASE.......: " + strvalue( Set( _SET_FILECASE ) ) )
FWriteLine( nHandle, "SET FIXED..........: " + strvalue( Set( _SET_FIXED ), .T. ) )
FWriteLine( nHandle, "SET FORCEOPT.......: " + strvalue( Set( _SET_FORCEOPT ), .T. ) )
FWriteLine( nHandle, "SET HARDCOMMIT.....: " + strvalue( Set( _SET_HARDCOMMIT ), .T. ) )
FWriteLine( nHandle, "SET IDLEREPEAT.....: " + strvalue( Set( _SET_IDLEREPEAT ), .T. ) )
FWriteLine( nHandle, "SET INSERT.........: " + strvalue( Set( _SET_INSERT ), .T. ) )
FWriteLine( nHandle, "SET INTENSITY......: " + strvalue( Set( _SET_INTENSITY ), .T. ) )
FWriteLine( nHandle, "SET LANGUAGE.......: " + strvalue( Set( _SET_LANGUAGE ) ) )
FWriteLine( nHandle, "SET MARGIN.........: " + strvalue( Set( _SET_MARGIN ) ) )
FWriteLine( nHandle, "SET MBLOCKSIZE.....: " + strvalue( Set( _SET_MBLOCKSIZE ) ) )
FWriteLine( nHandle, "SET MCENTER........: " + strvalue( Set( _SET_MCENTER ), .T. ) )
FWriteLine( nHandle, "SET MESSAGE........: " + strvalue( Set( _SET_MESSAGE ) ) )
FWriteLine( nHandle, "SET MFILEEXT.......: " + strvalue( Set( _SET_MFILEEXT ) ) )
FWriteLine( nHandle, "SET OPTIMIZE.......: " + strvalue( Set( _SET_OPTIMIZE ), .T. ) )
FWriteLine( nHandle, "SET OUTPUTSAFETY...: " + strvalue( Set( _SET_OUTPUTSAFETY ), .T. ) )
FWriteLine( nHandle, "SET PATH...........: " + strvalue( Set( _SET_PATH ) ) )
FWriteLine( nHandle, "SET PRINTER........: " + strvalue( Set( _SET_PRINTER ), .T. ) )
FWriteLine( nHandle, "SET PRINTERJOB.....: " + strvalue( Set( _SET_PRINTERJOB ) ) )
FWriteLine( nHandle, "SET PRINTFILE......: " + strvalue( Set( _SET_PRINTFILE ) ) )
FWriteLine( nHandle, "SET SCOREBOARD.....: " + strvalue( Set( _SET_SCOREBOARD ), .T. ) )
FWriteLine( nHandle, "SET SCROLLBREAK....: " + strvalue( Set( _SET_SCROLLBREAK ), .T. ) )
FWriteLine( nHandle, "SET SOFTSEEK.......: " + strvalue( Set( _SET_SOFTSEEK ), .T. ) )
FWriteLine( nHandle, "SET STRICTREAD.....: " + strvalue( Set( _SET_STRICTREAD ), .T. ) )
FWriteLine( nHandle, "SET TRACE..........: " + strvalue( Set( _SET_TRACE ), .T. ) )
FWriteLine( nHandle, "SET TRACEFILE......: " + strvalue( Set( _SET_TRACEFILE ) ) )
FWriteLine( nHandle, "SET TRACESTACK.....: " + strvalue( Set( _SET_TRACESTACK ) ) )
FWriteLine( nHandle, "SET TRIMFILENAME...: " + strvalue( Set( _SET_TRIMFILENAME ) ) )
FWriteLine( nHandle, "SET TYPEAHEAD......: " + strvalue( Set( _SET_TYPEAHEAD ) ) )
FWriteLine( nHandle, "SET UNIQUE.........: " + strvalue( Set( _SET_UNIQUE ), .T. ) )
FWriteLine( nHandle, "SET VIDEOMODE......: " + strvalue( Set( _SET_VIDEOMODE ) ) )
FWriteLine( nHandle, "SET WRAP...........: " + strvalue( Set( _SET_WRAP ), .T. ) )
FWriteLine( nHandle, "" )
IF nCols > 0
FWriteLine( nHandle, Padc( 'Detailed Work Area Items', nCols, '-' ) )
ELSE
FWriteLine( nHandle, 'Detailed Work Area Items ' )
ENDIF
FWriteLine( nHandle, "" )
IF Type( "Select()" ) != "UI"
For nCount := 1 To 600
If !Empty( ( nCount )->( &("Alias()") ) )
( nCount )->( FWriteLine( nHandle, "Work Area No ......: " + strvalue( &("Select()") ) ) )
( nCount )->( FWriteLine( nHandle, "Alias .............: " + &("Alias()") ) )
( nCount )->( FWriteLine( nHandle, "Current Recno .....: " + strvalue( &("RecNo()") ) ) )
( nCount )->( FWriteLine( nHandle, "Current Filter ....: " + &("DbFilter()") ) )
( nCount )->( FWriteLine( nHandle, "Relation Exp. .....: " + &("DbRelation()") ) )
( nCount )->( FWriteLine( nHandle, "Index Order .......: " + strvalue( &("IndexOrd(0)") ) ) )
( nCount )->( FWriteLine( nHandle, "Active Key ........: " + strvalue( &("IndexKey(0)") ) ) )
( nCount )->( FWriteLine( nHandle, "" ) )
Endif
Next
ENDIF
FWriteLine( nHandle, "" )
IF nCols > 0
FWriteLine( nHandle, Padc( " Internal Error Handling Information ", nCols, "-" ) )
ELSE
FWriteLine( nHandle, " Internal Error Handling Information " )
ENDIF
FWriteLine( nHandle, "" )
FWriteLine( nHandle, "Subsystem Call ....: " + oErr:subsystem() )
FWriteLine( nHandle, "System Code .......: " + strvalue( oErr:suBcode() ) )
FWriteLine( nHandle, "Default Status ....: " + strvalue( oerr:candefault() ) )
FWriteLine( nHandle, "Description .......: " + oErr:description() )
FWriteLine( nHandle, "Operation .........: " + oErr:operation() )
FWriteLine( nHandle, "Arguments .........: " + Arguments( oErr ) )
FWriteLine( nHandle, "Involved File .....: " + oErr:filename() )
FWriteLine( nHandle, "Dos Error Code ....: " + strvalue( oErr:oscode() ) )
#ifdef HB_THREAD_SUPPORT
FWriteLine( nHandle, "Running threads ...: " + strvalue( oErr:RunningThreads() ) )
FWriteLine( nHandle, "VM thread ID ......: " + strvalue( oErr:VmThreadId() ) )
FWriteLine( nHandle, "OS thread ID ......: " + strvalue( oErr:OsThreadId() ) )
#endif
FWriteLine( nHandle, "" )
FWriteLine( nHandle, " Trace Through:" )
FWriteLine( nHandle, "----------------" )
FWriteLine( nHandle, Padr( oErr:ProcName, 21 ) + " : " + Transform( oErr:ProcLine, "999,999" ) + " in Module: " + oErr:ModuleName )
nCount := 3
While !Empty( Procname( ++ nCount ) )
FWriteLine( nHandle, Padr( Procname( nCount ), 21 ) + ' : ' + Transform( Procline( nCount ), "999,999" ) + " in Module: " + ProcFile( nCount ) )
Enddo
FWriteLine( nHandle, "" )
FWriteLine( nHandle, "" )
IF valtype( cScreen ) == "C"
FWriteLine( nHandle, Padc( " Video Screen Dump ", nCols, "#" ) )
FWriteLine( nHandle, "" )
//FWriteLine( nHandle, "" )
FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
//FWriteLine( nHandle, "" )
nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
nRange := ( nCols + 1 ) * nCellSize
For nCount := 1 To nRows + 1
cOutString := ''
cSubString := Substr( cScreen, nStart, nRange )
For nForLoop := 1 To nRange step nCellSize
cOutString += Substr( cSubString, nForLoop, 1 )
Next
FWriteLine( nHandle, "|" + cOutString + "|" )
nStart += nRange
Next
FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
FWriteLine( nHandle, "" )
FWriteLine( nHandle, "" )
ELSE
FWriteLine( nHandle, " Video Screen Dump not available" )
ENDIF
cNOME:=cLOGFILE
if lAppendLog .and. nHandle2 != -1
nBytes := FSeek( nHandle2, 0, FS_END )
cBuff := space(10)
FSeek( nHandle2, 0, FS_SET )
while nBytes > 0
nRead := FRead( nHandle2, @cBuff, 10 )
FWrite( nHandle, cBuff, nRead )
nBytes -= nRead
cBuff := space( 10 )
enddo
FClose( nHandle2 )
FClose( nHandle )
FErase( cLogFile )
FRename( cLogFile2, cLogFile )
else
FClose( nHandle )
endif
Endif
Return .f.
STATIC FUNCTION strvalue( c, l )
LOCAL cr := ''
Default l To .f.
Switch ValType( c )
Case "C"
cr := c
exit
Case "N"
cr := Alltrim( Str( c ) )
exit
Case "M"
cr := c
exit
Case "D"
cr := Dtoc( c )
exit
Case "L"
// cr := If( l, If( c, "On", "Off" ), If( c, "True", "False" ) )
cr := If( l, If( c, "On", "Off" ), If( c, ".t.", ".f." ) )
exit
End
Return Upper( cr )
STATIC FUNCTION FWriteLine( nh, c )
Fwrite( nh, c + HB_OsNewLine() )
//HB_OutDebug( c + HB_OsNewLine() )
Return nil
STATIC FUNCTION Arguments( oErr )
LOCAL xArg, cArguments := ""
IF ValType( oErr:Args ) == "A"
FOR EACH xArg IN oErr:Args
cArguments += " [" + Str( HB_EnumIndex(), 2 ) + "] = Type: " + ValType( xArg )
IF xArg != NIL
cArguments += " Val: " + CStr( xArg )
ENDIF
NEXT
ENDIF
RETURN cArguments
#ifdef __PLATFORM__Windows
#pragma BEGINDUMP
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbvm.h"
#include "hbvmpub.h"
#include "hbfast.h"
#include "hbstack.h"
#include "thread.h"
#include <windows.h>
static PHB_SYMB s_xHbFunc = NULL;
LONG WINAPI PRGUnhandledExceptionFilter( EXCEPTION_POINTERS *ExceptionInfo )
{
if( s_xHbFunc )
{
HB_ITEM Exception;
PHB_DYNS pDyn = hb_dynsymFind( "HB_CSTRUCTURE" );
Exception.type = HB_IT_NIL;
//TraceLog( NULL, "%s(%p)\n", pExecSym->pSymbol->szName, ExceptionInfo );
if( pDyn )
{
hb_vmPushSymbol( pDyn->pSymbol );
hb_vmPushNil();
hb_itemPushStaticString( "EXCEPTION_POINTERS", 18 );
hb_vmPushLong( 8 );
hb_vmDo( 2 );
if( hb_stackReturnItem()->type == HB_IT_OBJECT )
{
HB_ITEM_NEW( Buffer );
HB_ITEM Adopt;
hb_itemForwardValue( &Exception, hb_stackReturnItem() );
hb_itemPutCLStatic( &Buffer, (char *) ExceptionInfo, sizeof( EXCEPTION_POINTERS ) );
Adopt.type = HB_IT_LOGICAL;
Adopt.item.asLogical.value = FALSE;
hb_objSendMsg( &Exception, "Buffer", 2, &Buffer, &Adopt );
}
}
hb_vmPushSymbol( s_xHbFunc );
hb_vmPushNil();
hb_itemPushForward( &Exception );
hb_vmDo( 1 );
//TraceLog( NULL, "Done\n" );
}
return hb_itemGetNL( hb_stackReturnItem() );
}
HB_FUNC( SETERRORMODE )
{
hb_retni( SetErrorMode( hb_parni( 1 ) ) ) ;
}
HB_FUNC( SETUNHANDLEDEXCEPTIONFILTER )
{
LPTOP_LEVEL_EXCEPTION_FILTER pDefaultHandler;
s_xHbFunc = (PHB_SYMB) hb_parptr( 1 );
pDefaultHandler = SetUnhandledExceptionFilter( PRGUnhandledExceptionFilter );
//TraceLog( NULL, "Default: %p\n", pDefaultHandler );
hb_retnl( (LONG) pDefaultHandler );
}
#pragma ENDDUMP
#endif
*+ EOF: ERRORSYS.PRGGilbertoSilverio
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
-
gilbertosilverio
- Usuário Nível 3

- Mensagens: 339
- Registrado em: 18 Jan 2009 10:39
- Localização: Ribeirao Pires - SP
Re: Enviar arq. de erro por email.
Ola Leonardo,
Agora complicou tudo...
Nao sei o que acontece, mais hoje ao compilar um progama com wvw + hwgui, usando os mesmo compiladores de ontem, xhb 1.1 e hwgui 2.17, sem a sua rotina de envio de erro por e-mail, ao executar o programa forçando um erro, ele gera a mensagem de erro, da hwgui, mostra em tela, mais quando termino o programa da GPF.
O engraçado e que nao alterei nada, nem no xhb nem na hwgui, somente retirei a sua rotina... não consigo entender o que acontece... Voltei tua rotina mais mesmo assim, ela cria o log de erro, envia o email, e ao sair da GPF.
Em outra maquina tambem ocorre a mesma coisa, da GPF.
Tem como eu saber, o porque deste GPF, pois e criado um log no windows, da pra saber onde ocorre o erro?
Grato.
Agora complicou tudo...
Nao sei o que acontece, mais hoje ao compilar um progama com wvw + hwgui, usando os mesmo compiladores de ontem, xhb 1.1 e hwgui 2.17, sem a sua rotina de envio de erro por e-mail, ao executar o programa forçando um erro, ele gera a mensagem de erro, da hwgui, mostra em tela, mais quando termino o programa da GPF.
O engraçado e que nao alterei nada, nem no xhb nem na hwgui, somente retirei a sua rotina... não consigo entender o que acontece... Voltei tua rotina mais mesmo assim, ela cria o log de erro, envia o email, e ao sair da GPF.
Em outra maquina tambem ocorre a mesma coisa, da GPF.
Tem como eu saber, o porque deste GPF, pois e criado um log no windows, da pra saber onde ocorre o erro?
Grato.
GilbertoSilverio
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
-
gilbertosilverio
- Usuário Nível 3

- Mensagens: 339
- Registrado em: 18 Jan 2009 10:39
- Localização: Ribeirao Pires - SP
Re: Enviar arq. de erro por email.
Ola Leonardo,
Consegui descobrir o por que dava erro 9003 quando a unidade não estava mapeada...
Este trecho e que causa o erro.
cMessage += Chr( 13 ) + Chr( 10 ) + 'Memoria Disponivel.: ' + alltrim(str( Memory(0) )) + ' - Espaço em Disco....: ' + alltrim(str( DiskSpace() ))
Com relação ao GPF que estava dando ontem, hoje esta tudo ok. Vai entender o Rwindows...
Grato.
Consegui descobrir o por que dava erro 9003 quando a unidade não estava mapeada...
Este trecho e que causa o erro.
cMessage += Chr( 13 ) + Chr( 10 ) + 'Memoria Disponivel.: ' + alltrim(str( Memory(0) )) + ' - Espaço em Disco....: ' + alltrim(str( DiskSpace() ))
Com relação ao GPF que estava dando ontem, hoje esta tudo ok. Vai entender o Rwindows...
Grato.
GilbertoSilverio
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
gilbertosilverio@gmail.com
gilbertosilverio2003@yahoo.com.br
- sygecom
- Administrador

- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: Enviar arq. de erro por email.
Menos mal que resolveu. Segunda que vou poder testar em uma rede. vlw pelo retorno da dica.
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
- sygecom
- Administrador

- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: Enviar arq. de erro por email.
Apenas para completar, eu testei aqui na rede e deu os erros relatado pelo Colega Gilberto, então conforme a dica dele removi onde tinha o DISKSPACE() e na linha:
Mudei para:
Mais uma vez obrigado.
Código: Selecionar todos
LogInitialPath := "\" + CurDir() + IIf( Empty( CurDir() ), "", "\" )
Código: Selecionar todos
LogInitialPath := SubStr( hb_argv(0), 1, LEN(hb_argv(0))- LEN(substr(hb_argv(0), RAT("\", hb_argv(0))+1)) )Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql