In order for this site to work correctly we need to store a small file (called a cookie) on your computer. Most every site in the world does this, however since the 25th of May 2011, by law we have to get your permission first. Please abandon the forum if you disagree.
Para que este foro funcione correctamente es necesario guardar un pequeño fichero (llamado cookie) en su ordenador. La mayoría de los sitios de Internet lo hacen, no obstante desde el 25 de Marzo de 2011 y por ley, necesitamos de su permiso con antelación. Abandone este foro si no está conforme.
Para que este foro funcione correctamente es necesario guardar un pequeño fichero (llamado cookie) en su ordenador. La mayoría de los sitios de Internet lo hacen, no obstante desde el 25 de Marzo de 2011 y por ley, necesitamos de su permiso con antelación. Abandone este foro si no está conforme.
rutina en caso de errores
rutina en caso de errores
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
rutina en caso de errores
Te anexo el Errorsys.prg de Xailer
Saludos
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files ERRORSYS.PRG (182 B)Â
Saludos
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files ERRORSYS.PRG (182 B)Â
rutina en caso de errores
Te reenvio el Errorsys.prg comprimido porque no pasó
Saludos
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
Saludos
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
rutina en caso de errores
Sorry
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files ERRORSYS.rar (2.3 KB)Â
Alex
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files ERRORSYS.rar (2.3 KB)Â
-
- Mensajes: 1831
- Registrado: Mar Oct 11, 2005 9:53 am
rutina en caso de errores
Bingen hizo una version distinta con unas adecuaciones, yo la uso, pero aun
me da unos problemitas que por tiempo no los he correjido. no se si ya
bingen tenga algo mas...
Saludos.
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files zErrorManager.zip (7.8 KB)Â
me da unos problemitas que por tiempo no los he correjido. no se si ya
bingen tenga algo mas...
Saludos.
"macgyber" escribió en el mensaje de noticias:[email=4df3decd@svctag-j7w3v3j....]4df3decd@svctag-j7w3v3j....[/email]
en clipper existia errorsys para el tratamiento de errores.
incluso yo le hice algunos agregados:
a) le sacaba una foto a la pantalla que se estaba desplegando en el
momento del error,
b) los ultimos procedimientos o funciones 8
c) la ultima tecla apretada
d) el tipo de error
e) fecha y hora
f) usuario
por otro lado generaba un log de actividad con:
a) fecha y hora
b) usuario
c) procedimiento
grababa un registro cada vez que entraba a una opcion del menu, estaba
conectado con el menu, cada opcion del menu tenia un número o letra
(1,2,...9,a,b,...z)
12112 = opcion 1 del menu principal, luego opcion 2 y de esta la opcion
1 luego nuevamente la opcion 1 del siguiente menu y luego la opcion 2
todo eso lo guardaba en una base de datos (la foto en el campo memo)
luego podia ver los diferentes errores en el programa del cliente y ver
cuantas veces entro en ese submenu y a que otros submenus entro antes,
con esto descubri que si entraba luego de facturar en articulos daba
error pues un archivo quedaba abierto, pero si antes entraba en
proveedores (dejaba cerrado proveedores) y luego articulos no habia error
me resultaba util para analizar causas y efectos, aunque muchas veces
los solucionaba con la info del error solamente
muchos clientes no anotan la info del error, salen de la aplicación y
luego llaman, pero al tener la opcion de ver los errores uno le dice que
vaya y que te diga por telefono lo que dice la pantalla del error
mismo en la pantalla del error les ponia un mensaje parpadeante que
decía "LLAME YA, LLAME YA"
alguien tiene algo como esto ?
--
Attached files zErrorManager.zip (7.8 KB)Â
Ramón Zea
Móvil: 01-993-231-62-29
ramonzea@yahoo.com
zeasoftware@hotmail.com
zeasoft.movil@hotmail.com
http://www.paginasprodigy.com/zeasoftware/
Móvil: 01-993-231-62-29
ramonzea@yahoo.com
zeasoftware@hotmail.com
zeasoft.movil@hotmail.com
http://www.paginasprodigy.com/zeasoftware/
-
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
rutina en caso de errores
/*
* ErrorManager.prg Gestión de errores personalizada
*
* Copyright 2003 Jose F. Gimenez <jfgimenez@wanadoo.es>
* Copyright 2003, 2009 Xailer.com
* All rights reserved
*
* Modified by BiSoft 2008-2009 Bingen Ugaldebere
*
* Partes del código han sido copiadas del proyecto xHarbour
*
*/
#include "Xailer.ch"
#include "Error.ch"
#define GHW_HWNDFIRST 0
#define GHW_HWNDNEXT 2
#define GWW_HINSTANCE -6
#define ERROR_MODULES {"ERRORSYS", "__ERRRT", "HBOBJECT", "(b)HBOBJECT" }
//---------------------------------------------------------- ----------------
FUNCTION ErrorManager( oError )
Local hImage
Local bError
Local cMessage, aOptions, nChoice, nCount, cProcName
Local cCopyRight:= "Sistema de gestión de errores para Xailer V. 2.1 BiSoft 15-01-2010"
Local cErrPath := Application:cDirectory+"Errors", cFileError:=""
Local cSendMail := ""
Local nLog := 0, aLogs := {}, nMaxLogs := 30 //Max number of errors saved
//Set parameters if not set before in application
Try
Valtype(AppData:cLicence)
Catch
AppData:AddData("cLicence","")
End
Try
Valtype(AppData:cDataError)
Catch
AppData:AddData("cDataError",cErrPath)
End
Try
Valtype(AppData:cErrorMail)
Catch
AppData:AddData("cErrorMail",cSendMail)
End
Try
Valtype(AppData:lUSer)
Catch
AppData:AddData("lUSer",.T.)
End
// By default, division by zero results in zero
If oError:genCode == EG_ZERODIV
Return 0
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
// Modify errorblock to handle errors inside this module
bError := ErrorBlock( {|e| MsgInfo( LT( XA_MSG_ERROR_IN_ERRORSYS, ErrorMessage( e ), LTrim( Str( ProcLine( 1 ), 6 ) ) ) ), __Quit() } )
//Message of MySql Commands out of sync
If "MySQL"$ToString(oError:Subsystem) .And. ;
"Commands out of sync; you can't run this command now"$ToString(oError:Description)
Msginfo("Error en la conexión a la base de Datos SQL.","MySQL Communication failure")
Return {}
Endif
// All other errors
nCount := 0
// NOTA: Si ProcName y ProcLine vienen ya rellenos, buscarlos en la pila de
// llamadas y continuar a partir de ahi - [JFG]
While ( cProcName := Procname( nCount ),;
!( cProcName == oError:ProcName ) .and. ;
ProcLine( nCount ) != oError:ProcLine .AND. !Empty( cProcName ) )
nCount++
Enddo
IF Empty( cProcName )
nCount := 1
ENDIF
While ( cProcName := Procname( nCount ),;
!Empty( cProcName ) .and. ;
Ascan( ERROR_MODULES, {|v| v $ cProcName } ) > 0 )
nCount++
Enddo
cMessage := ProcName( nCount ) + "(" + LTrim( Str( ProcLine( nCount ) ) ) + ") " + CRLF
cMessage += ErrorMessage( oError ) + CRLF
cMessage += LT( XA_MSG_ERROR_ARGUMENTS, Arguments( oError ) )
If !Empty( oError:osCode )
cMessage += CRLF + LT( XA_MSG_ERROR_DOS, Ltrim( Str( oError:osCode ) ) )
Endif
aOptions := { LT( XA_MSG_ERROR_QUIT ) }
If oError:canRetry
Aadd( aOptions, LT( XA_MSG_ERROR_RETRY ) )
Endif
If oError:canDefault
Aadd( aOptions, LT( XA_MSG_ERROR_IGNORE ) )
Endif
*msginfo(cMessage)
//Collect and save information ____________________________________________________________ _
LogError( oError )
PcConfig()
Forms()
DbfStatus()
ActiveTasks()
AppdataList()
CopyRight(cCopyRight)
//__________________________________________________________ ________________________________
//Create BMP of error window and convert to PNG_____________________________________________
CursorWait()
/*
WITH OBJECT TCaptureBitmap():New() //Desktop Bitmap Capture
:Capture( GetDesktopWindow() )
:CopyToClipboard()
:Save( "Error.Bmp" )
END
*/
WITH OBJECT TCaptureBitmap():Create()
:Capture( )
:Save( "Error.Bmp" )
:Capture()
:CopyToClipboard()
END
/*
WITH OBJECT GDP():Create() //Convert to PNG
hImage := :LoadImageFromFile( "Error.Bmp" )
:SaveToPNG( "Error.Bmp", "Error.Png" )
:DeleteImage( hImage )
:Destroy()
END
*/
If File( "Error.Bmp" ) .And. File( "Error.Png" ) //Delete BMP if converted to PNG
FErase( "Error.bmp" )
Endif
If ! ExistDir( AppData:cDataError ) //Create errors folder if not exist
MakeDir( AppData:cDataError )
EndIf
//Copy last Error.Log and Error.Png to errors folder
cFileError:=AppData:cDataError+"Error"+Dtos(Date())+" "+StrTran(Time(),":","")+".Log"
Copy File "Error.Log" To &cFileError
cFileError:=StrTran(cFileError,".Log",".Png")
If File("Error.Png")
Copy File "Error.Png" To &cFileError
Endif
//Delete old Error.Log files
aLogs:=Directory(AppData:cDataError+"*.Log")
aLogs:=Asort(aLogs,,,{|x,y| x[1] < y[1] })
For nLog:=1 to Len(aLogs)-nMaxLogs+1
Ferase(AppData:cDataError+aLogs[nLog,1])
Ferase(AppData:cDataError+StrTran(Upper(aLogs[nLog,1]),".LOG ",".Png"))
Next
CursorArrow()
//__________________________________________________________ ________________________________
//Show error form and options_____________________________________________________ __________
nChoice := ShowError( cMessage, aOptions )
Errorblock( bError )
If !Empty( nChoice )
Do Case
Case aOptions[ nChoice ] == LT( XA_MSG_ERROR_RETRY )
*DestroyWindow(GetActiveWindow())
Return .T.
Case aOptions[ nChoice ] == LT( XA_MSG_ERROR_IGNORE )
Return .F.
Endcase
Endif
Break( oError )
//__________________________________________________________ ________________________________
RETURN .F.
//---------------------------------------------------------- ----------------
FUNCTION ShowError( cMessage, aOptions )
LOCAL nRet
WITH OBJECT TErrorForm()
:cMessage := cMessage
:aOptions := aOptions
:New( Application:oMainForm )
nRet := :ShowModal( , .T. )
END
If nRet == nil
nRet := 1
Endif
RETURN nRet
//---------------------------------------------------------- ----------------
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage
//Start error message
cMessage := Iif( oError:severity > ES_WARNING, LT( XA_MSG_ERROR_ERROR ), LT( XA_MSG_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 Arguments( oError )
LOCAL nArg, cArguments := ""
IF ValType( oError:Args ) == "A"
FOR nArg := 1 TO Len( oError:Args )
cArguments += " " + LT( XA_MSG_ERROR_ARGUMENT, Str( nArg, 2 ), ValType( oError:Args[ nArg ] ), ToString( oError:Args[ nArg ] ) )
NEXT
ENDIF
RETURN cArguments
//---------------------------------------------------------- ----------------
STATIC FUNCTION LogError( oError )
Local n
Local aFiles := Array( 1 ), aSizes:= Array( 1 ), aDates:= Array( 1 ), aTimes:= Array( 1 )
Local aDir := aDir( Application:cFileName , aFiles , aSizes, aDates, aTimes)
Local cProcName
Local nHandle, nCount, nWorkArea := Select()
Local lWorkAreas := .f.
nHandle := FCreate( "Error.log", 0 )
If nHandle >= 3
Try
FWrite( nHandle, Application:oMainform:cText + CRLF + CRLF )
Catch
FWrite( nHandle, "Error de la aplicación" + CRLF + CRLF )
End
FWrite( nHandle, "Ejecutable: "+aFiles[ 1 ]+" Tamaño "+Alltrim(TransForm(aSizes[ 1 ],"@E 999,999,999"))+" Fecha "+Dtoc(aDates[ 1 ])+" "+aTimes[ 1 ]+CRLF+CRLF )
FWrite( nHandle, AppData:cLicence + CRLF + CRLF )
FWrite( nHandle, "Fecha: "+DToC( Date() ) +" Hora: "+Time() + CRLF+ CRLF )
#ifndef __XHARBOUR__
#define hb_PCodeVer() ""
#endif
FWrite( nHandle, PadC( " "+LT( XA_MSG_ERRORLOG_INFOTITLE )+" ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, LT( XA_MSG_ERRORLOG_INFOTEXT, ;
oError:subsystem(), ;
LTrim( ToString( oError:suBcode() ) ), ;
LTrim( ToString( oError:candefault() ) ), ;
oError:description(), ;
oError:operation(), ;
Arguments( oError ), ;
oError:filename(), ;
LTrim( ToString( oError:oscode() ) ) ) )
nCount := 0
// NOTA: Si ProcName y ProcLine vienen ya rellenos, buscarlos en la pila de
// llamadas y continuar a partir de ahi - [JFG]
While ( cProcName := Procname( nCount ),;
!( cProcName == oError:ProcName ) .and. ;
ProcLine( nCount ) != oError:ProcLine .AND. !Empty( cProcName ) )
nCount++
Enddo
IF Empty( cProcName )
nCount := 1
ENDIF
While ( cProcName := Procname( nCount ),;
!Empty( cProcName ) .and. ;
Ascan( ERROR_MODULES, {|v| v $ cProcName } ) > 0 )
nCount++
Enddo
While !Empty( Procname( nCount ) )
FWrite( nHandle, " " + Procname( nCount ) + " (" + LTrim( Str( Procline( nCount ), 20 ) ) + ")" + CRLF )
nCount ++
Enddo
FWrite( nHandle, "" + CRLF )
If ValType( oError:Args ) == "A"
FWrite( nHandle," Argumentos :" +CRLF)
For n = 1 to Len( oError:Args )
FWrite( nHandle, " [" + Str( n, 4 ) + "] = " + ValType( oError:Args[ n ] ) + " " + ;
If(Len(ToString( oError:Args[ n ] ))>255,;
Left(ToString( oError:Args[ n ] ),250)+"....("+Alltrim(Str(Len(ToString( oError:Args[ n ] ))))+")",;
ToString( oError:Args[ n ] ) ) +CRLF)
Next
EndIf
If Application:oActiveForm<>Nil
FWrite( nHandle, " Formulario activo: "+Application:oActiveForm:cText + CRLF + CRLF )
Endif
If Application:oActiveControl<>Nil
FWrite( nHandle, " Control activo: "+Application:oActiveControl:cText + CRLF + CRLF )
Endif
//About Xailer xHb and compìler
FWrite( nHandle, PadC( " "+LT( XA_MSG_ERRORLOG_COMPILERTITLE )+" ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, LT( XA_MSG_ERRORLOG_COMPILERTEXT, ;
XailerVersion(), ;
Version() + " " + hb_PCodeVer(), ;
HB_Compiler(), ;
OsVersion() ) + CRLF )
FClose( nHandle )
Endif
Errorlevel( 1 )
RETURN .F.
//---------------------------------------------------------- ----------------
//PC Caracteristics
Static Function PCConfig()
Local nItem:=1, lForms:=.F., nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle, PadC( " Datos del equipo ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, " User Name : "+ NetName(.T.)+ CRLF )
FWrite( nHandle, " Computer Name : "+ NetName()+ CRLF )
FWrite( nHandle, " Local IP : "+LocalIp()[1]+ CRLF+ CRLF)
FWrite( nHandle, " HD Size ( "+Left(Application:cDirectory,2)+" ): "+LTrim( ToString( HB_DiskSpace(Left(Application:cDirectory,2),1 )/1073741824 ))+"Gb Free/"+LTrim( ToString( HB_DiskSpace(Left(Application:cDirectory,2),3 )/1073741824 ))+"Gb Total"+ CRLF )
FWrite( nHandle, " Memory Size : "+LTrim( ToString( Memory( 0 )/1024 ))+"Kb Free/"+LTrim( ToString( Memory( 101 )/1024 ))+"Kb Total/"+LTrim( ToString( Memory( 101 )/1002 ))+"Kb Maximum memory used" + CRLF )
With ObJect tSysver():Create()
If :nProcessorArch>0
FWrite( nHandle, " Procesador: "+{"x86","Intel Itanium","x64 (AMD o Intel)","WOW64 "}[:nProcessorArch] + CRLF )
Endif
End
FWrite( nHandle, CRLF+" Default Printer: "+Printer:cPrintername + CRLF )
FWrite( nHandle, " Monitor pixels : "+Alltrim(Tostring(Screen:aMonitors[1]:nWidth))+"x"+Alltrim(Tostring(Screen:aMonitors[1]:nHeight))+ CRLF )
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ----------------
//Opened Forms
Static Function Forms()
Local nItem:=1, lForms:=.F., nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
For nItem:=1 to Len(Application:aForms)
If !lForms
FWrite( nHandle,CRLF + PadC(" Formularios en uso en la aplicación ",78,"_") + CRLF+ CRLF )
lForms:=.T.
Endif
FWrite( nHandle, " "+StrZero(nItem,2)+" "+Application:aForms[nItem]:cText+CRLF )
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ----------------
//Opened Areas and some information about DBFs
Static Function DbfStatus()
Local aFieldNames := ARRAY(0), aTypes := ARRAY(0),aWidths := ARRAY(0), aDecimals := ARRAY(0)
Local n:=0, j:=0, aRDDs:={}, lIndex:=.F., lRelation:=.F., nTarget:=0
Local nHandle
Local lRdds:=.F., lDbfDataSets:=.F.
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
aRDDs = RddList( 1 )
For n = 1 to Len( aRDDs )
If !lRdds
FWrite( nHandle,CRLF + PadC(" RDDs Linkados en la aplicación ",78,"_") + CRLF+ CRLF )
lRdds:=.T.
Endif
FWrite( nHandle, " " + aRDDs[ n ]+CRLF )
Next
For n = 1 to 255
If ! Empty( Alias( n ) )
If !lDbfDatasets
FWrite( nHandle,CRLF + PadC(" DBF DataSets en uso ",78,"_") + CRLF+ CRLF )
lDbfDataSets:=.T.
Endif
//Database info
FWrite( nHandle, CRLF + CRLF + "Area "+Str( n, 3 ) + ": " + ;
PadR( Alias( n ), 15 ) + ;
If( Select() == n,PadR( "(Area actual)", 23 ), Space(23) ) + ;
"RddName: " + ( Alias( n ) )->( RddName() ) +CRLF+;
" ============================================================ " +CRLF+;
" RecNo RecCount BOF EOF Fields" )
FWrite( nHandle," " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
" " + ToString( ( Alias( n ) )->( BoF() ) ) + ;
" " + ToString( ( Alias( n ) )->( EoF() ) )+ ;
" " + ToString( ( Alias( n ) )->( FCount() ) ) ;
+ CRLF )
//Index info
lIndex:=.F.
For j = 1 to 15
If ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
If !lIndex
FWrite( nHandle,"TagName "+CHR(9)+PadR("Indices del Archivo ") )
EndIf
lIndex:=.T.
FWrite( nHandle, Space( 8 ) + Str(j,2)+" "+Padr(( Alias( n ) )->( OrdName( j ) ),15)+" "+;
If( ( Alias( n ) )->( IndexOrd() ) == j, "En uso=> ", Space(9) ) + ;
( Alias( n ) )->( IndexKey( j ) ) + CRLF )
EndIf
Next
//Relations info
lRelation:=.F.
For j = 1 to 8
If ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
If !lRelation
FWrite( nHandle, CRLF + " Relaciones en uso" + CRLF+;
" =================" )
EndIf
lRelation:=.T.
FWrite( nHandle, Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF )
EndIf
Next
EndIf
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ------------------//
// Names of all the active Tasks running in Windows
Static Function ActiveTasks()
Local hWnd := GetWindow( GetActiveWindow(), GHW_HWNDFIRST )
Local nTask:=0, cTask, aTasks:={}
Local nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + PadC(" Tareas activas en curso ",78,"_") + CRLF+ CRLF )
while hWnd != 0
cTask = GetWindowText( hWnd )
If ! Empty(cTask)
If AScan( aTasks, cTask ) == 0
Aadd(aTasks,cTask)
FWrite( nHandle,StrZero(++nTask,2)+" "+cTask+CRLF )
EndIf
EndIf
hWnd = GetWindow( hWnd, GHW_HWNDNEXT )
end
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
// Names of all the active Tasks running in Windows
Static Function AppdataList()
Local nHandle, nItem:=1
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + PadC(" AppDatas y sus valores ",78,"_") + CRLF+ CRLF )
For nItem:=1 to Len(AppData:aProperties)
If Ascan({"CFTPSERVER","CFTPPATH","CFTPUSER","CFTPPSW"},Upper(AppData:aProperties[nItem,1]))=0
FWrite( nHandle,Padr(AppData:aProperties[nItem,1],20)+ToString(AppDa ta:aProperties[nItem,2])+CRLF )
Endif
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
// Finalize Error.log with Copyright
Static Function CopyRight(cCopyRight)
Local nHandle, nItem:=1
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + CRLF + cCopyRight)
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
* ErrorForm.prg
* Clase TErrorForm()
*
* Copyright 2006 Jose F. Gimenez <jfgimenez@wanadoo.es>
* Copyright 2006 Xailer.com
* All rights reserved
CLASS TErrorForm FROM TForm
COMPONENT oImage
COMPONENT oMemo1
COMPONENT oMemo2
COMPONENT oDetails
COMPONENT oPrint
COMPONENT oFindText
COMPONENT oCopyText
COMPONENT oEmailText
DATA cMessage
DATA aOptions
METHOD CreateForm()
METHOD WMNCLButtonDblClk( nHitTest )
METHOD Details( oSender )
METHOD Print( oSender )
METHOD FindText( oSender )
METHOD CopyText( oSender )
METHOD EmailText( oSender )
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD CreateForm() CLASS TErrorForm
LOCAL i
::nWidth := 600
::nHeight := 130
::nClientHeight:= 107
::oFont:=TFont():Create( "MS Sans Serif", 9 )
Try
::cText := LT( XA_MSG_ERROR_TITLE )+" "+Application:oMainform:cText
Catch
::cText := LT( XA_MSG_ERROR_TITLE )
End
::oIcon := IDI_HAND
::nBorderStyle := bsDIALOG
::lMinimizeBox := .F.
::lAutoScroll := .F.
::Create()
WITH OBJECT ::oImage := TImage():New( Self )
:SetBounds( 2, 8, 32, 32 )
:lTransparent := .T.
:lTabStop := .F.
:nBorderStyle := bvNONE
:oPicture := Application:oIcon
:Create()
END
WITH OBJECT ::oMemo1 := TMemo():New( Self )
:SetBounds( 36, 8, 552, 60 )
:lReadOnly := .T.
:lVScroll := .F.
:nAnchors := akLEFTTOPRIGHT
:cText := ::cMessage
:Create()
END
FOR i := 1 TO Len( ::aOptions )
WITH OBJECT TButton():New( Self )
:SetBounds( ( i - 1 ) * 80 + 5, 75, 75, 25 )
:cText := ::aOptions[ i ]
:nModalResult := i
:Create()
END
NEXT
WITH OBJECT ::oDetails := TButton( Self )
:SetBounds( 512, 75, 75, 25 )
:nAnchors := akTOPRIGHT
:cText := LT( XA_MSG_ERROR_DETAILS ) + " >>>"
:OnClick := "Details"
:Create()
END
WITH OBJECT ::oMemo2 := TRichEdit():New( Self )
:SetBounds( 6, 110, 582, 200 )
:lReadOnly := .T.
:cFileName := "Error.log"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oEmailText := TButton( Self )
:SetBounds( 10, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Enviar error via email"
:OnClick := "EmailText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oCopyText := TButton( Self )
:SetBounds( 160, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Copiar texto del error"
:OnClick := "CopyText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oFindText := TButton( Self )
:SetBounds( 310, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Buscar texto en error"
:OnClick := "FindText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oPrint := TButton( Self )
:SetBounds( 460, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Imprimir texto del error"
:OnClick := "Print"
:lVisible := .F.
:Create()
END
Try
::oActiveControl := ::aControls[ 3 ]
::oActiveControl:lDefault := .T.
Catch
End
RETURN Self
//---------------------------------------------------------- --------------------
METHOD WMNCLButtonDblClk( nHitTest ) CLASS TErrorForm
/* NOTA: Esto se usa para maximizar la ventana al hacer doble click en el titulo,
aunque sea un dialogo y no tenga boton de maximizar - [JFG]
NOTE: This is used to maximize the window when the user double clicks on the
caption, although it's a dialog and doesn't have a maximize button - [JFG]
*/
IF nHitTest == HTCAPTION
IF IsZoomed( ::Handle )
::Restore()
::oDetails:Enable()
ELSE
IF !( ::oDetails:cText = "<" )
::Details()
ENDIF
::Maximize()
::oDetails:Disable()
ENDIF
::oMemo2:SetBounds( ,, ::nClientWidth - 13, ::nClientHeight - ::oMemo2:nTop - 56 )
::oPrint:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oFindText:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oCopyText:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oEmailtext:SetBounds( , ::nClientHeight - 50 , 125, 25 )
RETURN 0
ENDIF
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD Details( oSender ) CLASS TErrorForm
If ::oDetails:cText = "<"
::oDetails:cText := LT( XA_MSG_ERROR_DETAILS ) + " >>>"
::oDetails:oParent:nClientHeight := 107
::oMemo2:Hide()
::oPrint:Hide()
::oFindText:Hide()
::oCopyText:Hide()
::oEmailText:Hide()
::oMemo1:SetFocus()
Else
::oDetails:cText := "<<< " + LT( XA_MSG_ERROR_DETAILS )
::oDetails:oParent:nClientHeight := 360
::oMemo2:Show()
::oPrint:Show()
::oFindText:Show()
::oCopyText:Show()
::oEmailText:Show()
If AppData:cErrorMail=Nil .or. Empty(AppData:cErrorMail)
::oEmailText:lEnabled:=.F.
Endif
::oMemo2:SetFocus()
Endif
::lCentered:=.T.
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD Print( oSender ) CLASS TErrorForm
::oMemo2:PrintDlg("Error del sistema")
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD FindText( oSender ) CLASS TErrorForm
::oMemo2:FindDlg()
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD CopyText( oSender ) CLASS TErrorForm
::oMemo2:SelectAll()
::oMemo2:Copy()
::oMemo2:GoToLine(1)
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD EmailText( oSender ) CLASS TErrorForm
If AppData:cErrorMail<>Nil .And. !Empty(AppData:cErrorMail) .And. File("Error.Log")
WITH OBJECT tMapi():New( )
:Create()
If :Logon()
:cFromName := ""
:cFromAddress := ""
:cSubject := "Error de la Aplicación "+AppData:cAppCaption
:cMessage := "Envío de mensaje de error de "+AppData:cAppCaption
:lAskRecipients:=.T.
:aReceipts:={ {AppData:cOwnerName, AppData:cErrorMail, mapiTO } }
:aAttachments := { { "Error.Log", AppData:cAppPath+"Error.Log" } }
If File("Error.Png")
Aadd(:aAttachments,{ "Error.Png", AppData:cAppPath+"Error.Png" })
Endif
If !:Send()
MsgInfo("Error sending Error.Log by email")
Endif
:Logoff()
Endif
End
Endif
RETURN Nil
//---------------------------------------------------------- ----------------
#pragma BEGINDUMP
#include "windows.h"
#include "xailer.h"
#include "winsock2.h"
XA_FUNC( LOCALIP )
{
WSADATA wsa;
char cHost[256];
struct hostent *h;
int nAddr = 0, n = 0;
WSAStartup( MAKEWORD( 2, 0 ), &wsa );
if( gethostname( cHost, 256 ) == 0 )
{
h = gethostbyname( cHost );
if( h )
while( h->h_addr_list[ nAddr ] )
nAddr++;
}
hb_reta( nAddr );
if( nAddr )
while( h->h_addr_list[n] )
{
char cAddr[256];
wsprintf( cAddr, "%d.%d.%d.%d", (BYTE) h->h_addr_list[n][0],
(BYTE) h->h_addr_list[n][1],
(BYTE) h->h_addr_list[n][2],
(BYTE) h->h_addr_list[n][3] );
hb_storc( cAddr, -1, ++n );
}
WSACleanup();
}
#pragma ENDDUMP
Static Function OsVersion(oSender)
Local cVersion
With Object tSysver():Create()
cVersion:= :cSysName+" "
Do Case
Case :lIsWin7
cVersion+=" "+:cCSDVersion
Case :lIsWinVista
cVersion+="Vista "+:cCSDVersion
Case :lIsWinXP
cVersion+="XP "+:cCSDVersion
Case :lIsWinXP64
cVersion+="XP 64bit"+:cCSDVersion
Case :lIsWinServer2003
cVersion+="Server 2003 "+:cCSDVersion
Case :lIsWin2000
cVersion+="2000 "+:cCSDVersion
Case :lIsWinME
cVersion+="Millenium Edition"+:cCSDVersion
Case :lIsWin98
cVersion+="98"+:cCSDVersion
EndCase
End
Return cVersion
--
* ErrorManager.prg Gestión de errores personalizada
*
* Copyright 2003 Jose F. Gimenez <jfgimenez@wanadoo.es>
* Copyright 2003, 2009 Xailer.com
* All rights reserved
*
* Modified by BiSoft 2008-2009 Bingen Ugaldebere
*
* Partes del código han sido copiadas del proyecto xHarbour
*
*/
#include "Xailer.ch"
#include "Error.ch"
#define GHW_HWNDFIRST 0
#define GHW_HWNDNEXT 2
#define GWW_HINSTANCE -6
#define ERROR_MODULES {"ERRORSYS", "__ERRRT", "HBOBJECT", "(b)HBOBJECT" }
//---------------------------------------------------------- ----------------
FUNCTION ErrorManager( oError )
Local hImage
Local bError
Local cMessage, aOptions, nChoice, nCount, cProcName
Local cCopyRight:= "Sistema de gestión de errores para Xailer V. 2.1 BiSoft 15-01-2010"
Local cErrPath := Application:cDirectory+"Errors", cFileError:=""
Local cSendMail := ""
Local nLog := 0, aLogs := {}, nMaxLogs := 30 //Max number of errors saved
//Set parameters if not set before in application
Try
Valtype(AppData:cLicence)
Catch
AppData:AddData("cLicence","")
End
Try
Valtype(AppData:cDataError)
Catch
AppData:AddData("cDataError",cErrPath)
End
Try
Valtype(AppData:cErrorMail)
Catch
AppData:AddData("cErrorMail",cSendMail)
End
Try
Valtype(AppData:lUSer)
Catch
AppData:AddData("lUSer",.T.)
End
// By default, division by zero results in zero
If oError:genCode == EG_ZERODIV
Return 0
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
// Modify errorblock to handle errors inside this module
bError := ErrorBlock( {|e| MsgInfo( LT( XA_MSG_ERROR_IN_ERRORSYS, ErrorMessage( e ), LTrim( Str( ProcLine( 1 ), 6 ) ) ) ), __Quit() } )
//Message of MySql Commands out of sync
If "MySQL"$ToString(oError:Subsystem) .And. ;
"Commands out of sync; you can't run this command now"$ToString(oError:Description)
Msginfo("Error en la conexión a la base de Datos SQL.","MySQL Communication failure")
Return {}
Endif
// All other errors
nCount := 0
// NOTA: Si ProcName y ProcLine vienen ya rellenos, buscarlos en la pila de
// llamadas y continuar a partir de ahi - [JFG]
While ( cProcName := Procname( nCount ),;
!( cProcName == oError:ProcName ) .and. ;
ProcLine( nCount ) != oError:ProcLine .AND. !Empty( cProcName ) )
nCount++
Enddo
IF Empty( cProcName )
nCount := 1
ENDIF
While ( cProcName := Procname( nCount ),;
!Empty( cProcName ) .and. ;
Ascan( ERROR_MODULES, {|v| v $ cProcName } ) > 0 )
nCount++
Enddo
cMessage := ProcName( nCount ) + "(" + LTrim( Str( ProcLine( nCount ) ) ) + ") " + CRLF
cMessage += ErrorMessage( oError ) + CRLF
cMessage += LT( XA_MSG_ERROR_ARGUMENTS, Arguments( oError ) )
If !Empty( oError:osCode )
cMessage += CRLF + LT( XA_MSG_ERROR_DOS, Ltrim( Str( oError:osCode ) ) )
Endif
aOptions := { LT( XA_MSG_ERROR_QUIT ) }
If oError:canRetry
Aadd( aOptions, LT( XA_MSG_ERROR_RETRY ) )
Endif
If oError:canDefault
Aadd( aOptions, LT( XA_MSG_ERROR_IGNORE ) )
Endif
*msginfo(cMessage)
//Collect and save information ____________________________________________________________ _
LogError( oError )
PcConfig()
Forms()
DbfStatus()
ActiveTasks()
AppdataList()
CopyRight(cCopyRight)
//__________________________________________________________ ________________________________
//Create BMP of error window and convert to PNG_____________________________________________
CursorWait()
/*
WITH OBJECT TCaptureBitmap():New() //Desktop Bitmap Capture
:Capture( GetDesktopWindow() )
:CopyToClipboard()
:Save( "Error.Bmp" )
END
*/
WITH OBJECT TCaptureBitmap():Create()
:Capture( )
:Save( "Error.Bmp" )
:Capture()
:CopyToClipboard()
END
/*
WITH OBJECT GDP():Create() //Convert to PNG
hImage := :LoadImageFromFile( "Error.Bmp" )
:SaveToPNG( "Error.Bmp", "Error.Png" )
:DeleteImage( hImage )
:Destroy()
END
*/
If File( "Error.Bmp" ) .And. File( "Error.Png" ) //Delete BMP if converted to PNG
FErase( "Error.bmp" )
Endif
If ! ExistDir( AppData:cDataError ) //Create errors folder if not exist
MakeDir( AppData:cDataError )
EndIf
//Copy last Error.Log and Error.Png to errors folder
cFileError:=AppData:cDataError+"Error"+Dtos(Date())+" "+StrTran(Time(),":","")+".Log"
Copy File "Error.Log" To &cFileError
cFileError:=StrTran(cFileError,".Log",".Png")
If File("Error.Png")
Copy File "Error.Png" To &cFileError
Endif
//Delete old Error.Log files
aLogs:=Directory(AppData:cDataError+"*.Log")
aLogs:=Asort(aLogs,,,{|x,y| x[1] < y[1] })
For nLog:=1 to Len(aLogs)-nMaxLogs+1
Ferase(AppData:cDataError+aLogs[nLog,1])
Ferase(AppData:cDataError+StrTran(Upper(aLogs[nLog,1]),".LOG ",".Png"))
Next
CursorArrow()
//__________________________________________________________ ________________________________
//Show error form and options_____________________________________________________ __________
nChoice := ShowError( cMessage, aOptions )
Errorblock( bError )
If !Empty( nChoice )
Do Case
Case aOptions[ nChoice ] == LT( XA_MSG_ERROR_RETRY )
*DestroyWindow(GetActiveWindow())
Return .T.
Case aOptions[ nChoice ] == LT( XA_MSG_ERROR_IGNORE )
Return .F.
Endcase
Endif
Break( oError )
//__________________________________________________________ ________________________________
RETURN .F.
//---------------------------------------------------------- ----------------
FUNCTION ShowError( cMessage, aOptions )
LOCAL nRet
WITH OBJECT TErrorForm()
:cMessage := cMessage
:aOptions := aOptions
:New( Application:oMainForm )
nRet := :ShowModal( , .T. )
END
If nRet == nil
nRet := 1
Endif
RETURN nRet
//---------------------------------------------------------- ----------------
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage
//Start error message
cMessage := Iif( oError:severity > ES_WARNING, LT( XA_MSG_ERROR_ERROR ), LT( XA_MSG_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 Arguments( oError )
LOCAL nArg, cArguments := ""
IF ValType( oError:Args ) == "A"
FOR nArg := 1 TO Len( oError:Args )
cArguments += " " + LT( XA_MSG_ERROR_ARGUMENT, Str( nArg, 2 ), ValType( oError:Args[ nArg ] ), ToString( oError:Args[ nArg ] ) )
NEXT
ENDIF
RETURN cArguments
//---------------------------------------------------------- ----------------
STATIC FUNCTION LogError( oError )
Local n
Local aFiles := Array( 1 ), aSizes:= Array( 1 ), aDates:= Array( 1 ), aTimes:= Array( 1 )
Local aDir := aDir( Application:cFileName , aFiles , aSizes, aDates, aTimes)
Local cProcName
Local nHandle, nCount, nWorkArea := Select()
Local lWorkAreas := .f.
nHandle := FCreate( "Error.log", 0 )
If nHandle >= 3
Try
FWrite( nHandle, Application:oMainform:cText + CRLF + CRLF )
Catch
FWrite( nHandle, "Error de la aplicación" + CRLF + CRLF )
End
FWrite( nHandle, "Ejecutable: "+aFiles[ 1 ]+" Tamaño "+Alltrim(TransForm(aSizes[ 1 ],"@E 999,999,999"))+" Fecha "+Dtoc(aDates[ 1 ])+" "+aTimes[ 1 ]+CRLF+CRLF )
FWrite( nHandle, AppData:cLicence + CRLF + CRLF )
FWrite( nHandle, "Fecha: "+DToC( Date() ) +" Hora: "+Time() + CRLF+ CRLF )
#ifndef __XHARBOUR__
#define hb_PCodeVer() ""
#endif
FWrite( nHandle, PadC( " "+LT( XA_MSG_ERRORLOG_INFOTITLE )+" ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, LT( XA_MSG_ERRORLOG_INFOTEXT, ;
oError:subsystem(), ;
LTrim( ToString( oError:suBcode() ) ), ;
LTrim( ToString( oError:candefault() ) ), ;
oError:description(), ;
oError:operation(), ;
Arguments( oError ), ;
oError:filename(), ;
LTrim( ToString( oError:oscode() ) ) ) )
nCount := 0
// NOTA: Si ProcName y ProcLine vienen ya rellenos, buscarlos en la pila de
// llamadas y continuar a partir de ahi - [JFG]
While ( cProcName := Procname( nCount ),;
!( cProcName == oError:ProcName ) .and. ;
ProcLine( nCount ) != oError:ProcLine .AND. !Empty( cProcName ) )
nCount++
Enddo
IF Empty( cProcName )
nCount := 1
ENDIF
While ( cProcName := Procname( nCount ),;
!Empty( cProcName ) .and. ;
Ascan( ERROR_MODULES, {|v| v $ cProcName } ) > 0 )
nCount++
Enddo
While !Empty( Procname( nCount ) )
FWrite( nHandle, " " + Procname( nCount ) + " (" + LTrim( Str( Procline( nCount ), 20 ) ) + ")" + CRLF )
nCount ++
Enddo
FWrite( nHandle, "" + CRLF )
If ValType( oError:Args ) == "A"
FWrite( nHandle," Argumentos :" +CRLF)
For n = 1 to Len( oError:Args )
FWrite( nHandle, " [" + Str( n, 4 ) + "] = " + ValType( oError:Args[ n ] ) + " " + ;
If(Len(ToString( oError:Args[ n ] ))>255,;
Left(ToString( oError:Args[ n ] ),250)+"....("+Alltrim(Str(Len(ToString( oError:Args[ n ] ))))+")",;
ToString( oError:Args[ n ] ) ) +CRLF)
Next
EndIf
If Application:oActiveForm<>Nil
FWrite( nHandle, " Formulario activo: "+Application:oActiveForm:cText + CRLF + CRLF )
Endif
If Application:oActiveControl<>Nil
FWrite( nHandle, " Control activo: "+Application:oActiveControl:cText + CRLF + CRLF )
Endif
//About Xailer xHb and compìler
FWrite( nHandle, PadC( " "+LT( XA_MSG_ERRORLOG_COMPILERTITLE )+" ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, LT( XA_MSG_ERRORLOG_COMPILERTEXT, ;
XailerVersion(), ;
Version() + " " + hb_PCodeVer(), ;
HB_Compiler(), ;
OsVersion() ) + CRLF )
FClose( nHandle )
Endif
Errorlevel( 1 )
RETURN .F.
//---------------------------------------------------------- ----------------
//PC Caracteristics
Static Function PCConfig()
Local nItem:=1, lForms:=.F., nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle, PadC( " Datos del equipo ", 78, "_" ) + CRLF + CRLF )
FWrite( nHandle, " User Name : "+ NetName(.T.)+ CRLF )
FWrite( nHandle, " Computer Name : "+ NetName()+ CRLF )
FWrite( nHandle, " Local IP : "+LocalIp()[1]+ CRLF+ CRLF)
FWrite( nHandle, " HD Size ( "+Left(Application:cDirectory,2)+" ): "+LTrim( ToString( HB_DiskSpace(Left(Application:cDirectory,2),1 )/1073741824 ))+"Gb Free/"+LTrim( ToString( HB_DiskSpace(Left(Application:cDirectory,2),3 )/1073741824 ))+"Gb Total"+ CRLF )
FWrite( nHandle, " Memory Size : "+LTrim( ToString( Memory( 0 )/1024 ))+"Kb Free/"+LTrim( ToString( Memory( 101 )/1024 ))+"Kb Total/"+LTrim( ToString( Memory( 101 )/1002 ))+"Kb Maximum memory used" + CRLF )
With ObJect tSysver():Create()
If :nProcessorArch>0
FWrite( nHandle, " Procesador: "+{"x86","Intel Itanium","x64 (AMD o Intel)","WOW64 "}[:nProcessorArch] + CRLF )
Endif
End
FWrite( nHandle, CRLF+" Default Printer: "+Printer:cPrintername + CRLF )
FWrite( nHandle, " Monitor pixels : "+Alltrim(Tostring(Screen:aMonitors[1]:nWidth))+"x"+Alltrim(Tostring(Screen:aMonitors[1]:nHeight))+ CRLF )
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ----------------
//Opened Forms
Static Function Forms()
Local nItem:=1, lForms:=.F., nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
For nItem:=1 to Len(Application:aForms)
If !lForms
FWrite( nHandle,CRLF + PadC(" Formularios en uso en la aplicación ",78,"_") + CRLF+ CRLF )
lForms:=.T.
Endif
FWrite( nHandle, " "+StrZero(nItem,2)+" "+Application:aForms[nItem]:cText+CRLF )
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ----------------
//Opened Areas and some information about DBFs
Static Function DbfStatus()
Local aFieldNames := ARRAY(0), aTypes := ARRAY(0),aWidths := ARRAY(0), aDecimals := ARRAY(0)
Local n:=0, j:=0, aRDDs:={}, lIndex:=.F., lRelation:=.F., nTarget:=0
Local nHandle
Local lRdds:=.F., lDbfDataSets:=.F.
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
aRDDs = RddList( 1 )
For n = 1 to Len( aRDDs )
If !lRdds
FWrite( nHandle,CRLF + PadC(" RDDs Linkados en la aplicación ",78,"_") + CRLF+ CRLF )
lRdds:=.T.
Endif
FWrite( nHandle, " " + aRDDs[ n ]+CRLF )
Next
For n = 1 to 255
If ! Empty( Alias( n ) )
If !lDbfDatasets
FWrite( nHandle,CRLF + PadC(" DBF DataSets en uso ",78,"_") + CRLF+ CRLF )
lDbfDataSets:=.T.
Endif
//Database info
FWrite( nHandle, CRLF + CRLF + "Area "+Str( n, 3 ) + ": " + ;
PadR( Alias( n ), 15 ) + ;
If( Select() == n,PadR( "(Area actual)", 23 ), Space(23) ) + ;
"RddName: " + ( Alias( n ) )->( RddName() ) +CRLF+;
" ============================================================ " +CRLF+;
" RecNo RecCount BOF EOF Fields" )
FWrite( nHandle," " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
" " + ToString( ( Alias( n ) )->( BoF() ) ) + ;
" " + ToString( ( Alias( n ) )->( EoF() ) )+ ;
" " + ToString( ( Alias( n ) )->( FCount() ) ) ;
+ CRLF )
//Index info
lIndex:=.F.
For j = 1 to 15
If ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
If !lIndex
FWrite( nHandle,"TagName "+CHR(9)+PadR("Indices del Archivo ") )
EndIf
lIndex:=.T.
FWrite( nHandle, Space( 8 ) + Str(j,2)+" "+Padr(( Alias( n ) )->( OrdName( j ) ),15)+" "+;
If( ( Alias( n ) )->( IndexOrd() ) == j, "En uso=> ", Space(9) ) + ;
( Alias( n ) )->( IndexKey( j ) ) + CRLF )
EndIf
Next
//Relations info
lRelation:=.F.
For j = 1 to 8
If ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
If !lRelation
FWrite( nHandle, CRLF + " Relaciones en uso" + CRLF+;
" =================" )
EndIf
lRelation:=.T.
FWrite( nHandle, Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF )
EndIf
Next
EndIf
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- ------------------//
// Names of all the active Tasks running in Windows
Static Function ActiveTasks()
Local hWnd := GetWindow( GetActiveWindow(), GHW_HWNDFIRST )
Local nTask:=0, cTask, aTasks:={}
Local nHandle
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + PadC(" Tareas activas en curso ",78,"_") + CRLF+ CRLF )
while hWnd != 0
cTask = GetWindowText( hWnd )
If ! Empty(cTask)
If AScan( aTasks, cTask ) == 0
Aadd(aTasks,cTask)
FWrite( nHandle,StrZero(++nTask,2)+" "+cTask+CRLF )
EndIf
EndIf
hWnd = GetWindow( hWnd, GHW_HWNDNEXT )
end
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
// Names of all the active Tasks running in Windows
Static Function AppdataList()
Local nHandle, nItem:=1
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + PadC(" AppDatas y sus valores ",78,"_") + CRLF+ CRLF )
For nItem:=1 to Len(AppData:aProperties)
If Ascan({"CFTPSERVER","CFTPPATH","CFTPUSER","CFTPPSW"},Upper(AppData:aProperties[nItem,1]))=0
FWrite( nHandle,Padr(AppData:aProperties[nItem,1],20)+ToString(AppDa ta:aProperties[nItem,2])+CRLF )
Endif
Next
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
// Finalize Error.log with Copyright
Static Function CopyRight(cCopyRight)
Local nHandle, nItem:=1
nHandle := FOpen( "Error.log", 1 )
Fseek( nHandle, 0, 2)
CursorWait()
FWrite( nHandle,CRLF + CRLF + cCopyRight)
FClose( nHandle )
CursorArrow()
Return Nil
//---------------------------------------------------------- --------------------
* ErrorForm.prg
* Clase TErrorForm()
*
* Copyright 2006 Jose F. Gimenez <jfgimenez@wanadoo.es>
* Copyright 2006 Xailer.com
* All rights reserved
CLASS TErrorForm FROM TForm
COMPONENT oImage
COMPONENT oMemo1
COMPONENT oMemo2
COMPONENT oDetails
COMPONENT oPrint
COMPONENT oFindText
COMPONENT oCopyText
COMPONENT oEmailText
DATA cMessage
DATA aOptions
METHOD CreateForm()
METHOD WMNCLButtonDblClk( nHitTest )
METHOD Details( oSender )
METHOD Print( oSender )
METHOD FindText( oSender )
METHOD CopyText( oSender )
METHOD EmailText( oSender )
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD CreateForm() CLASS TErrorForm
LOCAL i
::nWidth := 600
::nHeight := 130
::nClientHeight:= 107
::oFont:=TFont():Create( "MS Sans Serif", 9 )
Try
::cText := LT( XA_MSG_ERROR_TITLE )+" "+Application:oMainform:cText
Catch
::cText := LT( XA_MSG_ERROR_TITLE )
End
::oIcon := IDI_HAND
::nBorderStyle := bsDIALOG
::lMinimizeBox := .F.
::lAutoScroll := .F.
::Create()
WITH OBJECT ::oImage := TImage():New( Self )
:SetBounds( 2, 8, 32, 32 )
:lTransparent := .T.
:lTabStop := .F.
:nBorderStyle := bvNONE
:oPicture := Application:oIcon
:Create()
END
WITH OBJECT ::oMemo1 := TMemo():New( Self )
:SetBounds( 36, 8, 552, 60 )
:lReadOnly := .T.
:lVScroll := .F.
:nAnchors := akLEFTTOPRIGHT
:cText := ::cMessage
:Create()
END
FOR i := 1 TO Len( ::aOptions )
WITH OBJECT TButton():New( Self )
:SetBounds( ( i - 1 ) * 80 + 5, 75, 75, 25 )
:cText := ::aOptions[ i ]
:nModalResult := i
:Create()
END
NEXT
WITH OBJECT ::oDetails := TButton( Self )
:SetBounds( 512, 75, 75, 25 )
:nAnchors := akTOPRIGHT
:cText := LT( XA_MSG_ERROR_DETAILS ) + " >>>"
:OnClick := "Details"
:Create()
END
WITH OBJECT ::oMemo2 := TRichEdit():New( Self )
:SetBounds( 6, 110, 582, 200 )
:lReadOnly := .T.
:cFileName := "Error.log"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oEmailText := TButton( Self )
:SetBounds( 10, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Enviar error via email"
:OnClick := "EmailText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oCopyText := TButton( Self )
:SetBounds( 160, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Copiar texto del error"
:OnClick := "CopyText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oFindText := TButton( Self )
:SetBounds( 310, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Buscar texto en error"
:OnClick := "FindText"
:lVisible := .F.
:Create()
END
WITH OBJECT ::oPrint := TButton( Self )
:SetBounds( 460, 330, 125, 25 )
:nAnchors := akTOPRIGHT
:cText := "&Imprimir texto del error"
:OnClick := "Print"
:lVisible := .F.
:Create()
END
Try
::oActiveControl := ::aControls[ 3 ]
::oActiveControl:lDefault := .T.
Catch
End
RETURN Self
//---------------------------------------------------------- --------------------
METHOD WMNCLButtonDblClk( nHitTest ) CLASS TErrorForm
/* NOTA: Esto se usa para maximizar la ventana al hacer doble click en el titulo,
aunque sea un dialogo y no tenga boton de maximizar - [JFG]
NOTE: This is used to maximize the window when the user double clicks on the
caption, although it's a dialog and doesn't have a maximize button - [JFG]
*/
IF nHitTest == HTCAPTION
IF IsZoomed( ::Handle )
::Restore()
::oDetails:Enable()
ELSE
IF !( ::oDetails:cText = "<" )
::Details()
ENDIF
::Maximize()
::oDetails:Disable()
ENDIF
::oMemo2:SetBounds( ,, ::nClientWidth - 13, ::nClientHeight - ::oMemo2:nTop - 56 )
::oPrint:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oFindText:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oCopyText:SetBounds( , ::nClientHeight - 50 , 125, 25 )
::oEmailtext:SetBounds( , ::nClientHeight - 50 , 125, 25 )
RETURN 0
ENDIF
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD Details( oSender ) CLASS TErrorForm
If ::oDetails:cText = "<"
::oDetails:cText := LT( XA_MSG_ERROR_DETAILS ) + " >>>"
::oDetails:oParent:nClientHeight := 107
::oMemo2:Hide()
::oPrint:Hide()
::oFindText:Hide()
::oCopyText:Hide()
::oEmailText:Hide()
::oMemo1:SetFocus()
Else
::oDetails:cText := "<<< " + LT( XA_MSG_ERROR_DETAILS )
::oDetails:oParent:nClientHeight := 360
::oMemo2:Show()
::oPrint:Show()
::oFindText:Show()
::oCopyText:Show()
::oEmailText:Show()
If AppData:cErrorMail=Nil .or. Empty(AppData:cErrorMail)
::oEmailText:lEnabled:=.F.
Endif
::oMemo2:SetFocus()
Endif
::lCentered:=.T.
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD Print( oSender ) CLASS TErrorForm
::oMemo2:PrintDlg("Error del sistema")
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD FindText( oSender ) CLASS TErrorForm
::oMemo2:FindDlg()
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD CopyText( oSender ) CLASS TErrorForm
::oMemo2:SelectAll()
::oMemo2:Copy()
::oMemo2:GoToLine(1)
RETURN Nil
//---------------------------------------------------------- ----------------
METHOD EmailText( oSender ) CLASS TErrorForm
If AppData:cErrorMail<>Nil .And. !Empty(AppData:cErrorMail) .And. File("Error.Log")
WITH OBJECT tMapi():New( )
:Create()
If :Logon()
:cFromName := ""
:cFromAddress := ""
:cSubject := "Error de la Aplicación "+AppData:cAppCaption
:cMessage := "Envío de mensaje de error de "+AppData:cAppCaption
:lAskRecipients:=.T.
:aReceipts:={ {AppData:cOwnerName, AppData:cErrorMail, mapiTO } }
:aAttachments := { { "Error.Log", AppData:cAppPath+"Error.Log" } }
If File("Error.Png")
Aadd(:aAttachments,{ "Error.Png", AppData:cAppPath+"Error.Png" })
Endif
If !:Send()
MsgInfo("Error sending Error.Log by email")
Endif
:Logoff()
Endif
End
Endif
RETURN Nil
//---------------------------------------------------------- ----------------
#pragma BEGINDUMP
#include "windows.h"
#include "xailer.h"
#include "winsock2.h"
XA_FUNC( LOCALIP )
{
WSADATA wsa;
char cHost[256];
struct hostent *h;
int nAddr = 0, n = 0;
WSAStartup( MAKEWORD( 2, 0 ), &wsa );
if( gethostname( cHost, 256 ) == 0 )
{
h = gethostbyname( cHost );
if( h )
while( h->h_addr_list[ nAddr ] )
nAddr++;
}
hb_reta( nAddr );
if( nAddr )
while( h->h_addr_list[n] )
{
char cAddr[256];
wsprintf( cAddr, "%d.%d.%d.%d", (BYTE) h->h_addr_list[n][0],
(BYTE) h->h_addr_list[n][1],
(BYTE) h->h_addr_list[n][2],
(BYTE) h->h_addr_list[n][3] );
hb_storc( cAddr, -1, ++n );
}
WSACleanup();
}
#pragma ENDDUMP
Static Function OsVersion(oSender)
Local cVersion
With Object tSysver():Create()
cVersion:= :cSysName+" "
Do Case
Case :lIsWin7
cVersion+=" "+:cCSDVersion
Case :lIsWinVista
cVersion+="Vista "+:cCSDVersion
Case :lIsWinXP
cVersion+="XP "+:cCSDVersion
Case :lIsWinXP64
cVersion+="XP 64bit"+:cCSDVersion
Case :lIsWinServer2003
cVersion+="Server 2003 "+:cCSDVersion
Case :lIsWin2000
cVersion+="2000 "+:cCSDVersion
Case :lIsWinME
cVersion+="Millenium Edition"+:cCSDVersion
Case :lIsWin98
cVersion+="98"+:cCSDVersion
EndCase
End
Return cVersion
--
rutina en caso de errores
Hola,
esta muy interesante esta rutina,
donde se puede conseguir la CaptureBitmap.Lib de J.Lalin???
Gracias
"Bingen Ugaldebere" <bingen@bisoft.es> escribió en el mensaje
news:[email=4df5b925@svctag-j7w3v3j....]4df5b925@svctag-j7w3v3j....[/email]
> Esta es la última versión, aún no he podido hacer que la captura de la
> pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
> librería de conversión GDP
>
> Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
> captura de la pantalla a BMP.
>
>
> Salu2.
>
esta muy interesante esta rutina,
donde se puede conseguir la CaptureBitmap.Lib de J.Lalin???
Gracias
"Bingen Ugaldebere" <bingen@bisoft.es> escribió en el mensaje
news:[email=4df5b925@svctag-j7w3v3j....]4df5b925@svctag-j7w3v3j....[/email]
> Esta es la última versión, aún no he podido hacer que la captura de la
> pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
> librería de conversión GDP
>
> Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
> captura de la pantalla a BMP.
>
>
> Salu2.
>
rutina en caso de errores
Bingen,
> Esta es la última versión, aún no he podido hacer que la captura de la
> pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
> librería de conversión GDP
>
> Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
> captura de la pantalla a BMP.
Muy bueno, y muy completo, ¡enhorabuena!
Respecto al envio del error por email, veo que utilizas MAPI. En mi opinión,
MAPI tiene algunos problemas:
- El usuario tiene que tener algún programa de correo compatible con MAPI y
con alguna cuenta correctamente configurada.
- Saltan avisos de seguridad que el usuario tiene que contestar. Esto
provoca algunas veces que el usuario se asuste innecesariamente.
- Suele quedar una copia del mensaje enviado en el programa de correo.
- El usuario ve la dirección de email a donde se envian los mensajes, y
además queda registrada en el programa de correo. En caso de que el cliente
esté contagiado con malware, te van a "pillar" la cuenta y te la van a
bombardear de spam.
- Está sujeto a las reglas de spam de los servidores de correo, lo que
provocará que en muchos casos no recibas todos los mensajes.
Yo he implementado un sistema muy sencillo, que evita todos esos problemas.
Está basado en un pequeño script PHP en mi servidor web. El mecanismo es el
siguiente: el programa envia el error.log, junto con alguna información
adicional para identificar al cliente, directamente al script PHP por HTTP
normal. Y el script PHP me envía a mí el email con toda la información. El
único requisito para este sistema es tener una página web. Por supuesto, y
para evitar suspicacias, el programa muestra un aviso antes de enviar la
información, y le muestra al cliente qué información va a enviar.
Pero como ves, no se produce ninguno de los problemas de antes: ni hace
falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
problema de spam.
--
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
> Esta es la última versión, aún no he podido hacer que la captura de la
> pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
> librería de conversión GDP
>
> Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
> captura de la pantalla a BMP.
Muy bueno, y muy completo, ¡enhorabuena!
Respecto al envio del error por email, veo que utilizas MAPI. En mi opinión,
MAPI tiene algunos problemas:
- El usuario tiene que tener algún programa de correo compatible con MAPI y
con alguna cuenta correctamente configurada.
- Saltan avisos de seguridad que el usuario tiene que contestar. Esto
provoca algunas veces que el usuario se asuste innecesariamente.
- Suele quedar una copia del mensaje enviado en el programa de correo.
- El usuario ve la dirección de email a donde se envian los mensajes, y
además queda registrada en el programa de correo. En caso de que el cliente
esté contagiado con malware, te van a "pillar" la cuenta y te la van a
bombardear de spam.
- Está sujeto a las reglas de spam de los servidores de correo, lo que
provocará que en muchos casos no recibas todos los mensajes.
Yo he implementado un sistema muy sencillo, que evita todos esos problemas.
Está basado en un pequeño script PHP en mi servidor web. El mecanismo es el
siguiente: el programa envia el error.log, junto con alguna información
adicional para identificar al cliente, directamente al script PHP por HTTP
normal. Y el script PHP me envía a mí el email con toda la información. El
único requisito para este sistema es tener una página web. Por supuesto, y
para evitar suspicacias, el programa muestra un aviso antes de enviar la
información, y le muestra al cliente qué información va a enviar.
Pero como ves, no se produce ninguno de los problemas de antes: ni hace
falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
problema de spam.
--
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
rutina en caso de errores
Bingen lo podrías subir como .rar ya que mi mail lo interpreta como archivo
peligroso ver mensaje
Saludos
Alex
------------------------------------------------------------ --------------------
"Bingen Ugaldebere" escribió en el mensaje de
noticias:[email=4df5b925@svctag-j7w3v3j....]4df5b925@svctag-j7w3v3j....[/email]
Esta es la última versión, aún no he podido hacer que la captura de la
pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
librería de conversión GDP
Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
captura de la pantalla a BMP.
Salu2.
--
Attached files
peligroso ver mensaje
Saludos
Alex
------------------------------------------------------------ --------------------
"Bingen Ugaldebere" escribió en el mensaje de
noticias:[email=4df5b925@svctag-j7w3v3j....]4df5b925@svctag-j7w3v3j....[/email]
Esta es la última versión, aún no he podido hacer que la captura de la
pantalla sea JPG falta un detallito que ha de mirar J.Lalin. en la
librería de conversión GDP
Nota: necesitarás la librería CaptureBitmap.Lib de J.Lalin para la
captura de la pantalla a BMP.
Salu2.
--
Attached files
-
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
rutina en caso de errores
> Respecto al envio del error por email, veo que utilizas MAPI. En mi
> opinión, MAPI tiene algunos problemas:
>
> - El usuario tiene que tener algún programa de correo compatible con
> MAPI y con alguna cuenta correctamente configurada.
Cierto ya me ha dado algún problema.
> - Saltan avisos de seguridad que el usuario tiene que contestar. Esto
> provoca algunas veces que el usuario se asuste innecesariamente.
>
> - Suele quedar una copia del mensaje enviado en el programa de correo.
Esto casi lo prefiero, muestro el correo preparado y el cliente lo envía
por sus medios y queda constancia en su bandeja de salida.
> - El usuario ve la dirección de email a donde se envian los mensajes, y
> además queda registrada en el programa de correo. En caso de que el
> cliente esté contagiado con malware, te van a "pillar" la cuenta y te la
> van a bombardear de spam.
Ostras, hay que pensar en todo.
> - Está sujeto a las reglas de spam de los servidores de correo, lo que
> provocará que en muchos casos no recibas todos los mensajes.
>
>
> Yo he implementado un sistema muy sencillo, que evita todos esos
> problemas. Está basado en un pequeño script PHP en mi servidor web. El
> mecanismo es el siguiente: el programa envia el error.log, junto con
> alguna información adicional para identificar al cliente, directamente
> al script PHP por HTTP normal. Y el script PHP me envía a mí el email
> con toda la información. El único requisito para este sistema es tener
> una página web. Por supuesto, y para evitar suspicacias, el programa
> muestra un aviso antes de enviar la información, y le muestra al cliente
> qué información va a enviar.
Un poco complicado para mi, no tengo ni idea de PHP.
> Pero como ves, no se produce ninguno de los problemas de antes: ni hace
> falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
> correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
> problema de spam.
>
> opinión, MAPI tiene algunos problemas:
>
> - El usuario tiene que tener algún programa de correo compatible con
> MAPI y con alguna cuenta correctamente configurada.
Cierto ya me ha dado algún problema.
> - Saltan avisos de seguridad que el usuario tiene que contestar. Esto
> provoca algunas veces que el usuario se asuste innecesariamente.
>
> - Suele quedar una copia del mensaje enviado en el programa de correo.
Esto casi lo prefiero, muestro el correo preparado y el cliente lo envía
por sus medios y queda constancia en su bandeja de salida.
> - El usuario ve la dirección de email a donde se envian los mensajes, y
> además queda registrada en el programa de correo. En caso de que el
> cliente esté contagiado con malware, te van a "pillar" la cuenta y te la
> van a bombardear de spam.
Ostras, hay que pensar en todo.
> - Está sujeto a las reglas de spam de los servidores de correo, lo que
> provocará que en muchos casos no recibas todos los mensajes.
>
>
> Yo he implementado un sistema muy sencillo, que evita todos esos
> problemas. Está basado en un pequeño script PHP en mi servidor web. El
> mecanismo es el siguiente: el programa envia el error.log, junto con
> alguna información adicional para identificar al cliente, directamente
> al script PHP por HTTP normal. Y el script PHP me envía a mí el email
> con toda la información. El único requisito para este sistema es tener
> una página web. Por supuesto, y para evitar suspicacias, el programa
> muestra un aviso antes de enviar la información, y le muestra al cliente
> qué información va a enviar.
Un poco complicado para mi, no tengo ni idea de PHP.
> Pero como ves, no se produce ninguno de los problemas de antes: ni hace
> falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
> correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
> problema de spam.
>
-
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
- ignacio
- Site Admin
- Mensajes: 9259
- Registrado: Lun Abr 06, 2015 8:00 pm
- Ubicación: Madrid, Spain
- Contactar:
rutina en caso de errores
Bingen Ugaldebere escribió el mié, 15 junio 2011 16:45Un poco complicado para mi, no tengo ni idea de PHP.
Ni falta que te hace, realmente ya está hecho. Busca en Google 'PHP Formmail'.
Saludos
Ni falta que te hace, realmente ya está hecho. Busca en Google 'PHP Formmail'.
Saludos
-
- Mensajes: 1831
- Registrado: Mar Oct 11, 2005 9:53 am
rutina en caso de errores
Yo lo cambie a TBlat, pero ya hace rato que no lo uso y no recuerdo si me
corrio bien...
Saludos.
"Bingen Ugaldebere" escribió en el mensaje de
noticias:4df8c58c$[email=1@svctag-j7w3v3j....]1@svctag-j7w3v3j....[/email]
> Respecto al envio del error por email, veo que utilizas MAPI. En mi
> opinión, MAPI tiene algunos problemas:
>
> - El usuario tiene que tener algún programa de correo compatible con
> MAPI y con alguna cuenta correctamente configurada.
Cierto ya me ha dado algún problema.
> - Saltan avisos de seguridad que el usuario tiene que contestar. Esto
> provoca algunas veces que el usuario se asuste innecesariamente.
>
> - Suele quedar una copia del mensaje enviado en el programa de correo.
Esto casi lo prefiero, muestro el correo preparado y el cliente lo envía
por sus medios y queda constancia en su bandeja de salida.
> - El usuario ve la dirección de email a donde se envian los mensajes, y
> además queda registrada en el programa de correo. En caso de que el
> cliente esté contagiado con malware, te van a "pillar" la cuenta y te la
> van a bombardear de spam.
Ostras, hay que pensar en todo.
> - Está sujeto a las reglas de spam de los servidores de correo, lo que
> provocará que en muchos casos no recibas todos los mensajes.
>
>
> Yo he implementado un sistema muy sencillo, que evita todos esos
> problemas. Está basado en un pequeño script PHP en mi servidor web. El
> mecanismo es el siguiente: el programa envia el error.log, junto con
> alguna información adicional para identificar al cliente, directamente
> al script PHP por HTTP normal. Y el script PHP me envía a mí el email
> con toda la información. El único requisito para este sistema es tener
> una página web. Por supuesto, y para evitar suspicacias, el programa
> muestra un aviso antes de enviar la información, y le muestra al cliente
> qué información va a enviar.
Un poco complicado para mi, no tengo ni idea de PHP.
> Pero como ves, no se produce ninguno de los problemas de antes: ni hace
> falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
> correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
> problema de spam.
>
corrio bien...
Saludos.
"Bingen Ugaldebere" escribió en el mensaje de
noticias:4df8c58c$[email=1@svctag-j7w3v3j....]1@svctag-j7w3v3j....[/email]
> Respecto al envio del error por email, veo que utilizas MAPI. En mi
> opinión, MAPI tiene algunos problemas:
>
> - El usuario tiene que tener algún programa de correo compatible con
> MAPI y con alguna cuenta correctamente configurada.
Cierto ya me ha dado algún problema.
> - Saltan avisos de seguridad que el usuario tiene que contestar. Esto
> provoca algunas veces que el usuario se asuste innecesariamente.
>
> - Suele quedar una copia del mensaje enviado en el programa de correo.
Esto casi lo prefiero, muestro el correo preparado y el cliente lo envía
por sus medios y queda constancia en su bandeja de salida.
> - El usuario ve la dirección de email a donde se envian los mensajes, y
> además queda registrada en el programa de correo. En caso de que el
> cliente esté contagiado con malware, te van a "pillar" la cuenta y te la
> van a bombardear de spam.
Ostras, hay que pensar en todo.
> - Está sujeto a las reglas de spam de los servidores de correo, lo que
> provocará que en muchos casos no recibas todos los mensajes.
>
>
> Yo he implementado un sistema muy sencillo, que evita todos esos
> problemas. Está basado en un pequeño script PHP en mi servidor web. El
> mecanismo es el siguiente: el programa envia el error.log, junto con
> alguna información adicional para identificar al cliente, directamente
> al script PHP por HTTP normal. Y el script PHP me envía a mí el email
> con toda la información. El único requisito para este sistema es tener
> una página web. Por supuesto, y para evitar suspicacias, el programa
> muestra un aviso antes de enviar la información, y le muestra al cliente
> qué información va a enviar.
Un poco complicado para mi, no tengo ni idea de PHP.
> Pero como ves, no se produce ninguno de los problemas de antes: ni hace
> falta ningún programa MAPI, ni que el usuario tenga ninguna cuenta de
> correo, ni nadie ve la cuenta de destino de los mensajes, ni hay ningún
> problema de spam.
>
Ramón Zea
Móvil: 01-993-231-62-29
ramonzea@yahoo.com
zeasoftware@hotmail.com
zeasoft.movil@hotmail.com
http://www.paginasprodigy.com/zeasoftware/
Móvil: 01-993-231-62-29
ramonzea@yahoo.com
zeasoftware@hotmail.com
zeasoft.movil@hotmail.com
http://www.paginasprodigy.com/zeasoftware/
rutina en caso de errores
Bingen,
> Un poco complicado para mi, no tengo ni idea de PHP.
Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
pequeño, y basta con cambiar los datos del email de destino y subirlo a tu
propio servidor web. En cuanto pueda intentaré subirlo al área de descargas.
--
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
> Un poco complicado para mi, no tengo ni idea de PHP.
Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
pequeño, y basta con cambiar los datos del email de destino y subirlo a tu
propio servidor web. En cuanto pueda intentaré subirlo al área de descargas.
--
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
-
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
rutina en caso de errores
Ok. muchisimas gracias.
El 15/06/2011 20:23, Jose F. Gimenez escribió:
> Bingen,
>
>> Un poco complicado para mi, no tengo ni idea de PHP.
>
> Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
> pequeño, y basta con cambiar los datos del email de destino y subirlo a
> tu propio servidor web. En cuanto pueda intentaré subirlo al área de
> descargas.
>
El 15/06/2011 20:23, Jose F. Gimenez escribió:
> Bingen,
>
>> Un poco complicado para mi, no tengo ni idea de PHP.
>
> Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
> pequeño, y basta con cambiar los datos del email de destino y subirlo a
> tu propio servidor web. En cuanto pueda intentaré subirlo al área de
> descargas.
>
rutina en caso de errores
Bingen,
A mi modo de ver no es necesario PHP ni pagina web.
Sólo tienes que utilizar CDOSys para enviar los correos.
Problema que le veo, lo que tu decias: en algún caso puede ser conveniente
dejar copia en la bandeja de salida, y el CDOSys NO deja copia, supongo
porque no es protocolo MAPI.
Saludos
Bingen Ugaldebere escribió en mensaje <4df9abeb$[email=1@svctag-j7w3v3j.]1@svctag-j7w3v3j.[/email]>...
>Ok. muchisimas gracias.
>
>El 15/06/2011 20:23, Jose F. Gimenez escribió:
>> Bingen,
>>
>>> Un poco complicado para mi, no tengo ni idea de PHP.
>>
>> Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
>> pequeño, y basta con cambiar los datos del email de destino y subirlo a
>> tu propio servidor web. En cuanto pueda intentaré subirlo al área de
>> descargas.
>>
A mi modo de ver no es necesario PHP ni pagina web.
Sólo tienes que utilizar CDOSys para enviar los correos.
Problema que le veo, lo que tu decias: en algún caso puede ser conveniente
dejar copia en la bandeja de salida, y el CDOSys NO deja copia, supongo
porque no es protocolo MAPI.
Saludos
Bingen Ugaldebere escribió en mensaje <4df9abeb$[email=1@svctag-j7w3v3j.]1@svctag-j7w3v3j.[/email]>...
>Ok. muchisimas gracias.
>
>El 15/06/2011 20:23, Jose F. Gimenez escribió:
>> Bingen,
>>
>>> Un poco complicado para mi, no tengo ni idea de PHP.
>>
>> Como dice Ignacio, no lo necesitas. Además, el script que hice yo es muy
>> pequeño, y basta con cambiar los datos del email de destino y subirlo a
>> tu propio servidor web. En cuanto pueda intentaré subirlo al área de
>> descargas.
>>
rutina en caso de errores
en errormanager falta "savelog()"
que tengo que tener instalado para que realice la captura de pantalla ?
que tengo que tener instalado para que realice la captura de pantalla ?
-
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
rutina en caso de errores
Perdón, es parte de mi libreria de messages y la había olvidado:
//
// SaveLog()
// Función ......: Saves a activity message in LOG file
// Parameters ...: message to save
// Returns .....: Self
//
Function SaveLog(cLogMsg)
Local
cFile:=StrZero(Year(Date()),4)+StrZero(Month(Date()),2)+StrZ ero(Day(Date()),2)+ ".Log"
Local hFile, aLogFiles, nLogFile:=1
//Check If required
If !Appdata:lSaveLog
Return Nil
Endif
//Create LOG path If necessary
If !ExistDir( Appdata:cDataLog )
MakeDir( Appdata:cDataLog )
Endif
//Delete old LOG files
aLogFiles:=DIRECTORY(Appdata:cDataLog+"*.Log")
FOR nLogFile:=1 TO LEN(aLogFiles)
If aLogFiles[nLogFile,3]<Date()-Appdata:nLogDays
Ferase(Appdata:cDataLog+aLogFiles[nLogFile,1])
Endif
NEXT
//Create or open LOG file and save activities
hFile := If( File( Appdata:cDataLog+cFile ), FOpen(
Appdata:cDataLog+cFile, FO_WRITE ), ;
FCreate(
Appdata:cDataLog+cFile ) )
If hFile >= 0
FSeek( hFile, 0, FS_END )
FWrite( hFile, Time()+" "+PadR(Appdata:cNetName,20)+"
"+Appdata:cLocalIP+" "+cLogMsg+CRLF )
FClose( hFile )
Else
MsgInfo("Error opening activity log file")
Endif
Return Nil
//
// SaveLog()
// Función ......: Saves a activity message in LOG file
// Parameters ...: message to save
// Returns .....: Self
//
Function SaveLog(cLogMsg)
Local
cFile:=StrZero(Year(Date()),4)+StrZero(Month(Date()),2)+StrZ ero(Day(Date()),2)+ ".Log"
Local hFile, aLogFiles, nLogFile:=1
//Check If required
If !Appdata:lSaveLog
Return Nil
Endif
//Create LOG path If necessary
If !ExistDir( Appdata:cDataLog )
MakeDir( Appdata:cDataLog )
Endif
//Delete old LOG files
aLogFiles:=DIRECTORY(Appdata:cDataLog+"*.Log")
FOR nLogFile:=1 TO LEN(aLogFiles)
If aLogFiles[nLogFile,3]<Date()-Appdata:nLogDays
Ferase(Appdata:cDataLog+aLogFiles[nLogFile,1])
Endif
NEXT
//Create or open LOG file and save activities
hFile := If( File( Appdata:cDataLog+cFile ), FOpen(
Appdata:cDataLog+cFile, FO_WRITE ), ;
FCreate(
Appdata:cDataLog+cFile ) )
If hFile >= 0
FSeek( hFile, 0, FS_END )
FWrite( hFile, Time()+" "+PadR(Appdata:cNetName,20)+"
"+Appdata:cLocalIP+" "+cLogMsg+CRLF )
FClose( hFile )
Else
MsgInfo("Error opening activity log file")
Endif
Return Nil
rutina en caso de errores
FO_WRITE y FS_END
faltarian ahora nada mas ?
El 20/06/2011 4:02, Bingen Ugaldebere escribió:
> Perdón, es parte de mi libreria de messages y la había olvidado:
>
> //
> // SaveLog()
> // Función ......: Saves a activity message in LOG file
> // Parameters ...: message to save
> // Returns .....: Self
> //
>
> Function SaveLog(cLogMsg)
> Local
> cFile:=StrZero(Year(Date()),4)+StrZero(Month(Date()),2)+StrZ ero(Day(Date()),2)+ ".Log"
>
> Local hFile, aLogFiles, nLogFile:=1
>
> //Check If required
> If !Appdata:lSaveLog
> Return Nil
> Endif
>
> //Create LOG path If necessary
> If !ExistDir( Appdata:cDataLog )
> MakeDir( Appdata:cDataLog )
> Endif
>
> //Delete old LOG files
> aLogFiles:=DIRECTORY(Appdata:cDataLog+"*.Log")
> FOR nLogFile:=1 TO LEN(aLogFiles)
> If aLogFiles[nLogFile,3]<Date()-Appdata:nLogDays
> Ferase(Appdata:cDataLog+aLogFiles[nLogFile,1])
> Endif
> NEXT
>
>
> //Create or open LOG file and save activities
> hFile := If( File( Appdata:cDataLog+cFile ), FOpen(
> Appdata:cDataLog+cFile, FO_WRITE ), ;
> FCreate( Appdata:cDataLog+cFile ) )
> If hFile >= 0
> FSeek( hFile, 0, FS_END )
> FWrite( hFile, Time()+" "+PadR(Appdata:cNetName,20)+"
> "+Appdata:cLocalIP+" "+cLogMsg+CRLF )
> FClose( hFile )
> Else
> MsgInfo("Error opening activity log file")
> Endif
>
> Return Nil
>
faltarian ahora nada mas ?
El 20/06/2011 4:02, Bingen Ugaldebere escribió:
> Perdón, es parte de mi libreria de messages y la había olvidado:
>
> //
> // SaveLog()
> // Función ......: Saves a activity message in LOG file
> // Parameters ...: message to save
> // Returns .....: Self
> //
>
> Function SaveLog(cLogMsg)
> Local
> cFile:=StrZero(Year(Date()),4)+StrZero(Month(Date()),2)+StrZ ero(Day(Date()),2)+ ".Log"
>
> Local hFile, aLogFiles, nLogFile:=1
>
> //Check If required
> If !Appdata:lSaveLog
> Return Nil
> Endif
>
> //Create LOG path If necessary
> If !ExistDir( Appdata:cDataLog )
> MakeDir( Appdata:cDataLog )
> Endif
>
> //Delete old LOG files
> aLogFiles:=DIRECTORY(Appdata:cDataLog+"*.Log")
> FOR nLogFile:=1 TO LEN(aLogFiles)
> If aLogFiles[nLogFile,3]<Date()-Appdata:nLogDays
> Ferase(Appdata:cDataLog+aLogFiles[nLogFile,1])
> Endif
> NEXT
>
>
> //Create or open LOG file and save activities
> hFile := If( File( Appdata:cDataLog+cFile ), FOpen(
> Appdata:cDataLog+cFile, FO_WRITE ), ;
> FCreate( Appdata:cDataLog+cFile ) )
> If hFile >= 0
> FSeek( hFile, 0, FS_END )
> FWrite( hFile, Time()+" "+PadR(Appdata:cNetName,20)+"
> "+Appdata:cLocalIP+" "+cLogMsg+CRLF )
> FClose( hFile )
> Else
> MsgInfo("Error opening activity log file")
> Endif
>
> Return Nil
>