ErrorSys.PRG

[Alex]

En Clipper podiamos incluir en nuestra compilación el archivo
ErrorSys.prg para manipular algunos errores a nuestras necesidades.
Si es posible hacerlo en Xailer, donde encuentró este archivo
(ErrorSys.prg) para modificarlo e integrarlo a mi aplicación.
Gracias
Alex

[zeasoftware]

En los fuentes de xailer existe igual un archivo con el mismo nombre.
Saludos.
--
Ramón Zea
01.993.231-62-29
http://www.paginasprodigy.com/zeasoftware/
zeasoftware@prodigy.net.mx
zeasoftware@hotmail.com
ramonzea@yahoo.com
zeasoft.movil@hotmail.com

[Bingen Ugaldebere]

/*
* 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
*
* Para que funcione hay que añadir el siguiente código
* en cualquier sitio del form principal de la aplicación
*
* PROCEDURE ErrorSys()
* Errorblock( { | oError | ErrorManager( oError ) } )
* RETURN
*
*/
#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
//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 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 )
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(), ;
Os() ) + 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" + 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
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"
:cFontName := "Courier New"
: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()
If AppData:lSaveLog
SaveLog(" Error sending Error.Log by email")
Endif
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
--

[Alex]

El 31/01/2010 15:34, Ramón Zea escribió:
> En los fuentes de xailer existe igual un archivo con el mismo nombre.
>
> Saludos.
Gracias
Solucionado
Alex

[Alex]

El 01/02/2010 0:39, Bingen Ugaldebere escribió:
> Por supuesto que si, aqui te adjunto por ejemplo mi versión del
> controlador de errores, lee bien las primeras lí­neas para implementarlo.
>
> Hay una parte que es la captura gráfica de la pantalla que no acaba de
> funcionar al 100%, estoy esperando una respuesta de Lalí­n para rematarla.
>
> Salu2.
>
> El 31/01/2010 20:01, Alex escribió:
>> En Clipper podiamos incluir en nuestra compilación el archivo
>> ErrorSys.prg para manipular algunos errores a nuestras necesidades.
>> Si es posible hacerlo en Xailer, donde encuentró este archivo
>> (ErrorSys.prg) para modificarlo e integrarlo a mi aplicación.
>>
>> Gracias
>>
>> Alex
Gracias
Alex

[Martin Del Angel]

Hola Bingen:
Probando el modulo de errores cuando enlazas te marca un error :
Error: Unresolved external '_HB_FUN_SAVELOG' referenced from
Algo que haya faltado por ahi ?
Saludos

[Bingen Ugaldebere]

> Probando el modulo de errores cuando enlazas te marca un error :
>
> Error: Unresolved external '_HB_FUN_SAVELOG' referenced from
>
>
> Algo que haya faltado por ahi ?
>
Perdón lo tenia en otro PRG que incluyo siempre y se me pasó
//
// 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

[Bingen Ugaldebere]

> Error: Unresolved external '_HB_FUN_SAVELOG' referenced from
También podrí­as sustituirlo por algo más sencillo como esto que es lo
que yo he hecho
If !:Send()
MsgInfo("Error sending Error.Log by email")
Endif

[Martin Del Angel]

GRBingen Ugaldebere wrote:
>> Error: Unresolved external '_HB_FUN_SAVELOG' referenced from
>
> También podrí­as sustituirlo por algo más sencillo como esto que es lo
> que yo he hecho
>
> If !:Send()
> MsgInfo("Error sending Error.Log by email")
> Endif
Gracias Bingen lo probare.
Saludos...