/*
* 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
--