Hello
I think Errsysw .prg need a visual and functional update like Email sending save error in a database etc
It looks ver yold
Something like copy the Line of the last error into the clipboard or starts a macro with uestudio to goto the line
or why open the error log with notepad
Tx
Errsysw Visual Update ?
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: Errsysw Visual Update ?
Yeang,
Thanks for your feedback,
What visual changes would you propose ?
Thanks for your feedback,
What visual changes would you propose ?
-
yeangpumpeng
- Posts: 21
- Joined: Mon Aug 09, 2010 8:58 am
Re: Errsysw Visual Update ?
In my opinion “Ignore and continue” is very dangerous.
Best regards,
Otto
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
********************************************************************
-
StefanHaupt
- Posts: 824
- Joined: Thu Oct 13, 2005 7:39 am
- Location: Germany
Re: Errsysw Visual Update ?
Antonio,
some years ago I made such a system, it was a modification of the source code of Jose Carlos da Rocha, see the headline in the source. Maybe this can be the startpoint of modern looking errorsystem.
Errors are saved in a dbf, they can be send as email and a picture is taken from the application.
and a sample
some years ago I made such a system, it was a modification of the source code of Jose Carlos da Rocha, see the headline in the source. Maybe this can be the startpoint of modern looking errorsystem.
Errors are saved in a dbf, they can be send as email and a picture is taken from the application.
Code: Select all
// Error handler system adapted to FiveWin
// Modificado por BINGEN - Mungia Informática 1.999-2.002
// Adaptación Clipper 5.2 por WILLIAMS PACHECO 2.003
// Remodelado por Jose Carlos da Rocha - SoHome Informatica Jul-2005
// ErrSysW.prg
// ------------------------------------------------------------------
// Modification and Enhancement by Stefan Haupt, 2007/2008
// - the errorhandler is now independent of any rc-file,
// all dialogs are now coded from source
// - all dialogs now have a modern design (in my opinion)
// the color can be change with #define 'COLOR_DIALOG'
// predefined are COLOR_XP, COLOR_VISTA and COLOR_ALERT
// - SaveBmp() was changed to get rid of the program "nconvert"
// now it uses a freeimage function to save the bitmap as png-file
// - email configuration is read from ini-file
// - function CheckPop3() is no longer needed (still in this file)
// - Sendmail() was changed to read the ini-file
// - ShowerrPic() was corrected to show the whole bitmap
// - all textstrings were translated into german (sorry)
// TODO:
// translate the #defines to support more languages
STATIC lWin2000
#include "error.ch"
#include "dll.ch"
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
#xcommand PRINT [ <oPrint> ] ;
[ <name: NAME, TITLE,DOC> <cDocument> ] ;
[ <user: FROM USER> ] ;
[ <prvw: PREVIEW> [<lmodal: MODAL>] ] ;
[ TO <xModel> ] ;
=> ;
[ <oPrint> := ] PrintBegin( [<cDocument>], <.user.>, <.prvw.>, <xModel>, <.lmodal.> )
#xcommand PRINTER [ <oPrint> ] ;
[ <name: NAME, DOC> <cDocument> ] ;
[ <user: FROM USER> ] ;
[ <prvw: PREVIEW> [<lmodal: MODAL>] ] ;
[ TO <xModel> ] ;
=> ;
[ <oPrint> := ] PrintBegin( [<cDocument>], <.user.>, <.prvw.>, <xModel>, <.lmodal.> )
#xcommand PAGE => PageBegin()
#xcommand ENDPAGE => PageEnd()
#xcommand ENDPRINT => PrintEnd()
#xcommand ENDPRINTER => PrintEnd()
//----------------------------------------------------------------------------//
#define GHW_HWNDFIRST 0
#define GHW_HWNDNEXT 2
#define GWW_HINSTANCE -6
#define SS_SUNKEN 4096
#define NTRIM(n) ( LTrim( Str( n ) ) )
#define DLG_TITLE "FiveWin for xHarbour"
#command QUIT => ( PostQuitMessage( 0 ), __Quit() )
//----------------------------------------------------------------------------//
#define E_INIFILE ".\Email.ini"
#define E_USER 1
#define E_LOGIN 2
#define E_PASS 3
#define E_POP3 4
#define E_SMTP 5
#define E_CONNECT 6
#define E_SAVE 7
#define E_DELETE 8
#define E_FROM 9
#define E_TO 10
// Dialog colors
#define COLOR_XP {nRGB( 3, 56, 147 ),nRGB( 89, 135, 214 )} //RGB( 0, 0, 128)
#define COLOR_VISTA {nRGB( 46, 139, 87) ,nRGB( 0, 250, 154)} //RGB( 0, 139, 69)
#define COLOR_ALERT {nRGB( 178, 34, 34 ), nRGB (255, 228, 255 ) }
#define COLOR_BAR COLOR_VISTA
#define COLOR_TEXT CLR_WHITE
#define _GERMAN
//#define _SPANISH
//#define _ENGLISH
//#define _ITALIAN
//#define _PORTUG
#ifdef _GERMAN
#define dlgPROG "Programm: "
#define dlgTITLE "Programmfehler"
#define errHEADER "Fehlerbeschreibung"
#define errDESC " Beschreibung : "
#define errPROGPATH " Programmpfad : "
#define errPROGSIZE " Dateigröße : "
#define errMAXFILES " Max. Dateien : "
#define errTIME " Laufzeit : "
#define errOCCUR " Fehlerzeitpunkt: "
#define errNETNAME " Computername : "
#define errUSER " Anwender : "
#define errDETAIL "detaillierte Beschreibung des Fehlers"
#define errSTACKLIST "Stack-Liste"
#define errSTACKCALL " Aufruf von "
#define errTASKS "Liste der Windowstasks: "
#define errVARLIST "Liste aller Variablen"
#define errVARIABLE " Name Typ Wert"
#define errRDD "Datenbanktreiber"
#define errOPENDBF "Geöffnete Datenbanken"
#define errINDEX "Indexdateien "
#define errRELATION "Datenbankrelationen"
#define dlgTEXT1 "Leider ist ein Fehler aufgetreten."+CRLF+;
"Bitte informieren Sie den Hersteller der Software über diesen Fehler und "+CRLF+;
"wie er aufgetreten ist."+CRLF+;
"Alle Angaben werden vertraulich behandelt."
#define dlgTEXT2 "Fehlerbeschreibung:"
#define BTN_Header "Fehlerinformation"
#define BTN_View "Fehlerlog im Editor ansehen"
#define BTN_Retry "Erneut versuchen"
#define BTN_Default "Standardwerte"
#define BTN_Send1 "Fehlerbericht senden"
#define BTN_Send2 "Fehlerbericht"
#define BTN_Send3 "Fehlerbericht gesendet"
#define BTN_End "nicht senden / Beenden"
#define BTN_Help "Hilfe"
#define emailADDRESS "info@ibbsh.de"
#define emailKEY "3jfbt72"
#endif
#ifdef _SPANISH
#endif
#ifdef _ENGLISH
#define dlgPROG "Program: "
#define dlgTITLE "Application error"
#define errHEADER "Errordescription"
#define errDESC " Description : "
#define errPROGPATH " App-Path : "
#define errPROGSIZE " Filesize : "
#define errMAXFILES " Max. files : "
#define errTIME " Time from start: "
#define errOCCUR " Occurance : "
#define errNETNAME " Computername : "
#define errUSER " User : "
#define errDETAIL "detailled error description"
#define errSTACKLIST "Stack-List"
#define errSTACKCALL " called by "
#define errTASKS "running tasks: "
#define errVARLIST "Varlist"
#define errVARIABLE " Name Type Value"
#define errRDD "RDD"
#define errOPENDBF "Open dbf´s"
#define errINDEX "Index files "
#define errRELATION "Relations"
#define sysHEADER "Systeminformation"
#define sysWINDOWS
#define sysVERSION
#define dlgTEXT1 "An error occured."+CRLF+;
"Please inform your dealer about this error and "+CRLF+;
"the circumstances it happened."
#define dlgTEXT2 "Errordescription:"
#define BTN_Header "Errorinformation"
#define BTN_View "View errorlog"
#define BTN_Retry "Retry"
#define BTN_Default "Default"
#define BTN_Send1 "Send errorlog"
#define BTN_Send2 "Errorlog"
#define BTN_Send3 "Errorlog sent"
#define BTN_End "do not send / end"
#define BTN_Help "Help"
#define emailADDRESS "yourEmailHere"
#define emailKEY "yourPassHere"
#endif
#ifdef _ITALIAN
#endif
#ifdef _PORTUG
#endif
external _fwGenError // Link FiveWin generic Error Objects Generator
/******************************************************
* ErrorSys()
*
* Note: automatically executes at startup
*******************************************************/
proc ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
return
proc ErrorLink()
return
/****************
* ErrorDialog()
*****************/
STATIC FUNCTION ErrorDialog( e ) // -> logical or quits App.
local oDlg, oFont, oFont1
local lRet // if lRet == nil -> default action: QUIT
local n, j
local oSay, oSay1, oGet//, cTxt1, cTxt2, hLogo
local nButtons := 1, hLogo
local cErrorLog := "", cParam := "", cVariables := "", cStack := ""
LOCAL aStack := {}, cMessage := "", cTxt1 := "", cTxt2 := ""
local aVersions := {}
local aTasks := {}
local aRDDs, nTarget, uValue
local oOldError
local cRelation
local lIsWinNT := IsWinNT()
// local oSystemInfo
local oWnd := WndMain()
local cTitle := IIF (!Empty(oWnd),"Programm: "+oWnd:cTITLE, dlgTITLE)
local hBmp, hDib, cImgFile
local aScreens:=array(0), nScreen, nScreens:=30 //max. 30 Screenshots
local cUser := WNetGetUser ()
local oBtn1, oBtn2, oBtn3, oBtn4, oBtn5
// Definimos cUser por si acaso el sistema no maneja este valor (WP)
cUser := if( ValType( cUser ) <> "C", "N/D", cUser )
// Por defecto la división entre 0 devuelve 0
if ( e:genCode == EG_ZERODIV )
return 0
endif
// for network open error, set NETERR() and subsystem default
if ( e:genCode == EG_OPEN .and. ;
( e:osCode == 32 .or. e:osCode == 5 ) .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
end
// for lock error during APPEND BLANK, set NETERR() and subsystem default
if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
endif
if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
ErrorBlock( {|e| MsgStop( ErrorMessage(e) + " from Errorsys, line:" + ;
Str( ProcLine( 1 ), 3 ) ), __quit() } )
// aTasks := GetTasks()
// aVersions := GetVersion()
/* DESCRIPCIÓN DEL ERROR */
cErrorLog += errHEADER + CRLF
cErrorLog += cTitle + CRLF
cErrorLog += "-----------------------------------------" + CRLF
cErrorLog += errPROGPATH + GetModuleFileName( GetInstance() ) + CRLF
cErrorLog += errPROGSIZE + Transform( FSize( GetModuleFileName( GetInstance() ) ), "9,999,999 bytes" ) + CRLF
cErrorLog += errMAXFILES + Str( SetHandleCount(), 3 ) + CRLF
cErrorlog += errTIME + TimeFromStart () + CRLF
cErrorLog += errOCCUR + DToC( Date() ) + ", " + Time() + CRLF
cErrorLog += errNETNAME + NETNAME(.f.) + CRLF
cErrorLog += errUSER + cUser + CRLF + CRLF
// Error object analysis
cMessage = errDETAIL + CRLF+;
Replicate ("-",Len(errDETAIL)) + CRLF+;
" "+ErrorMessage( e ) + CRLF
cErrorLog += cMessage
if ValType( e:Args ) == "A"
cErrorLog += " Parameter :" + CRLF
for n = 1 to Len( e:Args )
cErrorLog += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
cParam += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
next
endif
cErrorlog += CRLF + errSTACKLIST + CRLF
cErrorlog += Replicate ("-",Len(errSTACKLIST)) + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty(ProcName( n ) )
AAdd( aStack, errSTACKCALL + Trim( ProcName( n ) ) + ;
"(" + NTRIM( ProcLine( n ) ) + ")" )
cStack += ATail( aStack ) + CRLF
endif
n++
end
cErrorlog += cStack
cErrorLog += " CPU type: " + GetCPU() + " " + ;
AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" + CRLF
cErrorLog += " Hardware memory: " + ;
cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
" MB" + CRLF + CRLF
cErrorLog += " Free System resources: " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" + CRLF + ;
" GDI resources: " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" + CRLF + ;
" User resources: " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" + CRLF + CRLF
cErrorLog += " Compiler version: " + Version() + CRLF
aVersions := GetVersion()
cErrorLog += " Windows version: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + ;
" " + aVersions[ 5 ] + CRLF + CRLF
cErrorLog+=CRLF
cErrorLog+=CRLF+ errTASKS + Str( Len (aTasks), 3 )
cErrorLog+=CRLF+ Replicate ("-",Len(errTASKS))
cErrorLog+=CRLF
aTasks = GetTasks()
for n = 1 to Len( aTasks )
cErrorLog += " " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
next
// Warning!!! Keep here this code !!! Or we will be consuming GDI as
// we don't generate the error but we were generating the bitmap
hLogo = FWBitMap()
if e:canRetry
nButtons++
endif
if e:canDefault
nButtons++
endif
cVariables += CRLF + errVARLIST + CRLF + ;
Replicate ("-",Len(errVARLIST)) + CRLF
cVariables += errVARIABLE + CRLF
cVariables += Replicate ("-",Len(errVARIABLE)) + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty( ProcName( n ) ) .AND. ProcName( n )<>"ERRORDIALO"
cVariables += " " + Trim( ProcName( n ) ) + CRLF
for j = 1 to ParamCount( n )
cVariables += " Param " + Str( j, 3 ) + ": " + ;
ValType( GetParam( n, j ) ) + ;
" " + cGetInfo( GetParam( n, j ) ) + CRLF
next
for j = 1 to LocalCount( n )
cVariables += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
next
endif
n++
end
cErrorLog += cVariables
cErrorLog += CRLF + errRDD + CRLF + ;
Replicate ("-",Len(errRDD)) + CRLF
aRDDs = RddList( 1 )
for n = 1 to Len( aRDDs )
cErrorLog += " " + aRDDs[ n ] + CRLF
next
cErrorLog += CRLF + errOPENDBF + CRLF + ;
Replicate ("-",Len(errOPENDBF)) + CRLF
for n = 1 to 255
if ! Empty( Alias( n ) )
cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", " " ) + ;
PadR( Alias( n ), 15 ) + Space( 20 ) + "RddName: " + ;
( Alias( n ) )->( RddName() ) + CRLF
cErrorLog += " ==============================" + CRLF
cErrorLog += " RecNo RecCount BOF EOF" + CRLF
cErrorLog += " " + Transform( ( Alias( n ) )->( RecNo() ), "99999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "99999" ) + ;
" " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
" " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF
if ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
cErrorLog += errINDEX + Space( 23 ) + "TagName" + CRLF
for j = 1 to 15
if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
cErrorLog += Space( 8 ) + ;
If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", " " ) + ;
PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
( Alias( n ) )->( OrdName( j ) ) + ;
CRLF
endif
next
cErrorLog += CRLF + errRELATION + CRLF+;
Replicate ("-",Len(errRELATION))
for j = 1 to 8
if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF
// uValue = ( Alias( n ) )->( DbRelation( j ) )
// cErrorLog += cValToChar( &( uValue ) ) + CRLF
endif
next
ENDIF // ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
endif // !Empty( Alias(n))
next
n = 1
cErrorLog += CRLF + "internal classes" + CRLF
cErrorLog += "----------------" + CRLF
// while ! Empty( __ClassName( n ) )
// cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
// end
#ifndef __XHARBOUR__
while ! Empty( __ClassName( n ) )
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#else
while n <= __ClsCntClasses()
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#endif
cErrorLog += CRLF + "Memory Analysis" + CRLF
cErrorLog += "===============" + CRLF
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Static variables" + ;
CRLF + CRLF
cErrorLog += " Dynamic memory consume:" + CRLF
cErrorLog += " Actual Value: " + Str( MemUsed() ) + " bytes" + CRLF
cErrorLog += " Highest Value: " + Str( MemMax() ) + " bytes" + CRLF
/* GRABAR FICHERO DEL ERROR*/
// BEGIN SEQUENCE
// oOldError = ErrorBlock( { || DoBreak() } )
MemoWrit( "Error.log", cErrorLog )
// END SEQUENCE
// ErrorBlock( oOldError )
cTxt1 := dlgTEXT1
cTxt2 := dlgTEXT2+CRLF+ErrorMessage( e )+CRLF+cParam+CRLF+cStack
/*
bDone := nil //{|| oWnd:SetMsg( "Email wird versandt..." ) }
*/
/* Errordialog */
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10
DEFINE FONT oFont1 NAME "Arial" SIZE 0, -18 BOLD
DEFINE DIALOG oDlg SIZE 420,322 TITLE cTitle PIXEL TRANSPARENT
@ 2,2 SAY oSay PROMPT BTN_Header OF oDlg SIZE 211,27 ;
FONT oFont1 PIXEL
@ 30,2 SAY oSay1 PROMPT cTxt1 OF oDlg SIZE 207,32 PIXEL
oSay1:nStyle := nOR( oSay:nStyle, SS_SUNKEN )
@ 65,2 GET oGet VAR cTxt2 OF oDlg MEMO SIZE 206,50 PIXEL
oGet:SetPos(0,0)
@ 122,2 BUTTON oBtn3 PROMPT BTN_View SIZE 80,10 ;
ACTION WAITRUN("NOTEPAD ERROR.LOG");
PIXEL
@ 122,85 BUTTON oBtn4 PROMPT BTN_Retry SIZE 50,10 ;
ACTION (lRet := .t., oDlg:End() ) ;
PIXEL
@ 122,138 BUTTON oBtn5 PROMPT BTN_Default SIZE 50,10;
ACTION (lRet := .f., oDlg:End() );
PIXEL
@ 136,2 BUTTON oBtn1 PROMPT BTN_Send1 OF oDlg SIZE 80,10 ;
ACTION (CursorWait (),;
SendEmail (BTN_Send2, cErrorlog,, oDlg ),;
CursorArrow (),;
oDlg:oMsgbar:cMsgDef := BTN_Send3, oDlg:oMsgbar:Refresh() ) ;
PIXEL
// CheckPop3(cPop3Host, cUser, cPass, bDone, oWnd ) PIXEL
// {|o| If( SubStr( o:cStatus, 1, 3 ) == "+OK",MsgInfo("OK"),MsgInfo("Fehler") )},oWnd );
@ 136,85 BUTTON oBtn2 PROMPT BTN_End OF oDlg SIZE 80,10 ;
ACTION oDlg:End() DEFAULT PIXEL
@ 136,168 BUTTON BTN_Help OF oDlg SIZE 30,10 PIXEL ACTION MsgInfo (BTN_Help)
//IF !e:CanRetry; oBtn4:Disable (); ENDIF
//IF !e:CanDefault; oBtn5:Disable (); ENDIF
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oDlg:oMsgBar := TMsgBar():New(oDlg, BTN_Header,.F.,.F.,.F.,.F.,,,,),;
iif(e:CanRetry,oBtn4:Enable(),oBtn4:Disable()),;
iif(e:CanDefault,oBtn5:Enable(),oBtn5:Disable()) );
ON PAINT (oBtn2:Setfocus(), Degrade (oDlg:hDC, {1,1,57,422},COLOR_BAR[2],COLOR_BAR[1] ) );
VALID (oFont:End(), oFont1:End(),.t.)
if lRet == nil .or. ( !LWRunning() .and. lRet )
BEGIN SEQUENCE
oOldError = ErrorBlock( { || DoBreak() } )
/* CONTROL PERSONALIZADO DE ERRORES */
if !lIsDir( "ERRORS" ) //CREAR CARPETA DE ERRORES DEL PROGRAMA
lMkDir( "ERRORS" )
endif
// IF cUser <> "DPD" //NO SE GRABAN SI SOMOS NOSOTROS
IF !FILE("ERRORS\ERRORS.DBF")
DbCreate("ERRORS\ERRORS.DBF",;
{{"Comp","C",11,0},{"Date","D",8,0},;
{"Time","C",8,0},{"Error","C",76,0},;
{"Descript","M",10,0},{"Picture","C",30,0} })
ENDIF
SET PRINTER OFF
SET CONSOLE ON
USE "ERRORS\ERRORS.DBF" SHARED
APPEND BLANK
REPLACE Comp WITH NETNAME()
REPLACE Date WITH DATE()
REPLACE Time WITH TIME()
REPLACE Error WITH STRTRAN(ErrorMessage( e ),CRLF," ")
REPLACE Descript WITH cERRORLOG
hBmp := WndBitmap( oWnd:hWnd )
hDib := DibFromBitmap( hBmp )
cImgFile := "Err" + StrZero( RecNo(), 5 )
aScreens:=DIRECTORY("ERRORS\*.png")
aScreens:=ASORT(aScreens,,, { |x, y| x[1] < y[1] })
FOR nScreen:=1 TO LEN(aScreens)-nScreens
DELETE FILE ("ERRORS\"+aScreens[nScreen,1]) // delete all files more than 30
NEXT
REPLACE Picture WITH SaveBmp( hDib, cImgFile, "png" )
COMMIT
// ENDIF
END SEQUENCE
ErrorBlock( oOldError )
/* CERRAR MDICHILD FICHEROS Y RECURSOS Y SALIR */
// if TYPE( "oMainWnd" ) = "O"
// oWnd:CLOSEALL()
// endif
DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
return lRet
//-------------------------------------------------------------------------------
static function SendEmail (cSubject, cBody, cMsg, oWnd)
LOCAL oInit, oMail, aSet, i, lOk := .f.
LOCAL lReceipt := .f.
LOCAL lAuth := .f.
LOCAL cFrom
DEFAULT cMsg := nil //HTML Email
aSet := ReadIni ()
cFrom := TRIM (aSet[E_USER])+" <"+TRIM (aSet[E_FROM])+">"
FOR i := 1 TO Len (aSet)
lOk := !Empty (aSet[i])
//? aSet[i]
NEXT
IF ! lOk
MsgAlert ("Email-Einstellungen fehlerhaft","Email versenden")
RETURN (nil)
ENDIF
FErase ("Smtp.log") // delete old logfile
oInit := TSmtp():New( aSet [E_SMTP] )
oMail := TSmtp():New( aSet [E_SMTP], , lAuth, aSet [E_LOGIN], aSet [E_PASS] ) // [jlalin], IBTC
oMail:cReplyTo := "" //aSet [E_REPLYTO] //cReplyTo
oMail:nGMT := 1 // 8 = Pacific Standard Time (GMT -08:00) - Adjust this to your own Time Zone!
oMail:lTxtAsAttach := .F. // uncomment to force txt, log and htm files as inline as opposed to attachement
oMail:nDelay := 2
oMail:oSocket:lDebug := .T. // uncomment to create log file
oMail:oSocket:cLogFile := "smtp.log"
oMail:bConnecting := {||MsgRun( "Connecting to " + aSet [E_SMTP] + " (" + oMail:cIPServer + ") and waiting for response...") }
oMail:bConnected := {||MsgRun ("Email wird versandt...") }
// oMail:bConnecting := {|| oWnd:SetMsg( "Connecting to " + cSmtpHost + " (" + oMail:cIPServer + ") and waiting for response..." ) }
// oMail:bConnected := {|| oWnd:SetMsg( "Email wird versandt..." ) }
oMail:SendMail( ;
cFrom, ; // from/de
{ aSet[E_TO] }, ; // to/para (arreglo) - I use cSender here also because it's an "autotest". Actually you would type a different address here
cBody,; // Body/Mensaje
cSubject,; // Subject/Asunto
{ "error.log" }, ; // Array of filenames to attach/Arreglo de nombres de archivos a agregar
{ }, ; // aCC
{ }, ; // aBCC
lReceipt, ; // Return Receipt/acuse de recibo
cMsg ) // msg in HTML format/mensaje en HTML
oInit:end()
return (nil)
// ---------------------------------------------------------------------------------- //
Static Function CheckPop3( cPOP3Host, cUser, cPass, bxDone, oWnd )
LOCAL lRet
LOCAL oInit, oPop
LOCAL bDone := {|o| IIF ( SubStr( o:cStatus, 1, 3 ) == "+OK", MsgInfo("OK"),MsgInfo ("Fehler")) }
// initialize sockets (or nothing will happen) - it's a quirk in GetHostByName(), not TSmtp
oInit := TSmtp():New( cPOP3Host )
oPop := TPOP3():New( cPOP3Host, , cUser, cPass )
oPop:bConnecting := {||MsgRun( "Connecting to " + cPop3Host + " (" + oPop:cIPServer + ") and waiting for response...") }
oPop:bConnected := {||MsgRun ("Checking for email messages...") }
// oPop:bConnecting := {|| oWnd:SetMsg( "Connecting to " + cPOP3Host + " (" + oPop:cIPServer + ") and waiting for response..." ) }
// oPop:bConnected := {|| oWnd:SetMsg( "Checking for email messages..." ) }
oPop:bDone := {|o|MsgInfo (o:cStatus)}
oPop:oSocket:lDebug := .T. // uncomment to create log file
oPop:oSocket:cLogFile := "pop3.log"
oPop:GetMail( .T. ) // nur prüfen, ob Pop-server erreichbar ist
oInit:end()
Return (lRet)
//----------------------------------------------------------------------------//
static function DoBreak()
BREAK
return nil
//----------------------------------------------------------------------------//
static func ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Warning " ),;
"(DOS Error " + NTRIM(e:osCode) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C",;
e:SubSystem() ,;
"???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N",;
"/" + NTRIM( e:SubCode ) ,;
"/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
// returns extended info for a certain variable type
STATIC FUNCTION cGetInfo( uVal )
local cType := ValType( uVal )
do case
case cType == "C"
return '"' + cValToChar( uVal ) + '"'
case cType == "O"
return "Class: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
/*********************************************************
* PARA VISUALIZAR LOS ERRORES GRABADOS EN ERRORSYS
**********************************************************/
FUNCTION ViewErrors ()
LOCAL oFONT,oDLG, oSay, oGet, oBtn1, oBtn2, oBtn3
LOCAL cError := ""
if !FILE("ERRORS\ERRORS.DBF")
MSGWAIT("Die Fehlerprotokolldatei fehlt","Fehlerprotokolles")
RETURN NIL
endif
USE "ERRORS\ERRORS.DBF" ALIAS "ERRORS" SHARED
RLOCK()
cError := "Datum des Fehlers : "+DTOC(ERRORS->Date)+" Uhrzeit "+ERRORS->Time+CRLF+;
"Fehlerbeschreibung : "+ERRORS->Descript+CRLF+;
"Nutzer/PC : "+ERRORS->Comp+CRLF+;
"Grafik : "+Errors->Picture
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10
DEFINE DIALOG oDlg SIZE 450, 350 TITLE "Fehlerprotokolle ansehen" FONT oFont TRANSPARENT
// SetBkMode (oDlg:hDC, 1)
// DrawTextEx (oDlg:hDC, cError,{0,1,72,451},0)
@ 4, 1 SAY oSay PROMPT errTIME+DTOC(ERRORS->Date)+" Uhrzeit "+ERRORS->Time+CRLF+;
errDESC+ERRORS->Error+CRLF+;
"Nutzer/PC : "+ERRORS->Comp+CRLF+;
"Grafik : "+Errors->Picture OF oDlg FONT oFont SIZE 230, 35 ;
PIXEL UPDATE COLOR COLOR_TEXT, COLOR_BAR[2]
@ 37 ,1 GET oGET VAR ERRORS->Descript OF oDLG MULTILINE READONLY SIZE 225, 112 PIXEL UPDATE
@ 157, 5 BUTTON oBTN1 PROMPT " |< " SIZE 20,12 PIXEL OF oDLG ACTION ( DBGOTOP(),RLOCK(),oDLG:UPDATE(),oDlg:Refresh() )
@ 157, 27 BUTTON oBTN1 PROMPT " < " SIZE 20,12 PIXEL OF oDLG ACTION ( DBSKIP(-1),IF(BOF(),(MSGINFO("Dateianfang"),DBSKIP(1)),(RLOCK(),oDLG:UPDATE(),oDlg:Refresh())) )
@ 157, 49 BUTTON oBTN1 PROMPT " > " SIZE 20,12 PIXEL OF oDLG ACTION ( DBSKIP(1),IF(EOF(),(MSGINFO("Dateiende"),DBSKIP(-1)),(RLOCK(),oDLG:UPDATE(),oDlg:Refresh())) )
@ 157, 71 BUTTON oBTN1 PROMPT " >| " SIZE 20,12 PIXEL OF oDLG ACTION ( DBGOBOTTOM(),RLOCK(),oDLG:UPDATE(),oDlg:Refresh() )
@ 157, 97 BUTTON oBTN1 PROMPT "Fehlergrafik" SIZE 38,12 PIXEL OF oDLG ACTION ShowErrPic (oDlg) WHEN !Empty(Errors->Picture)
@ 157, 137 BUTTON oBTN2 PROMPT "Drucken" SIZE 38,12 PIXEL OF oDLG ACTION PRINTERRORS()
@ 157, 182 BUTTON oBTN3 PROMPT "Schließen" SIZE 38,12 PIXEL OF oDLG ACTION oDlg:End() DEFAULT
ACTIVATE DIALOG oDlg CENTERED ;
ON PAINT Degrade (oDlg:hDC, {0,1,72,451}, COLOR_BAR[2],COLOR_BAR[1] )
oFont:End()
ERRORS->(DBCLOSEAREA())
RETURN NIL
//---------------------------------------------------------------------
FUNCTION PrintErrors() //IMPRESION DE ERRORES
LOCAL oPRN,oFONT, cError, nLin, nLinea
PRINTER oPRN PREVIEW
DEFINE FONT oFont NAME "COURIER NEW" SIZE 0,-10 OF oPrn
PAGE
cERROR:=ERRORS->Descript
nLIN:=1
FOR nLINEA=1 TO MLCOUNT(cERROR,100)
CURSORWAIT()
oPrn:CmSay(nLIN:=nLIN+.4, 1.5, MEMOLINE(cERROR,100,nLINEA),oFONT)
if nLIN>25
nLIN=1
ENDPAGE
PAGE
endif
NEXT
ENDPAGE
ENDPRINT
oFont:End()
RETURN NIL
//---------------------------------------------------------------------
FUNCTION ShowErrPic()
LOCAL oDlg, oSay, oImage, nPos, cImgFile
// Leemos las coordenadas de la pantalla actual y definimos la resolucion (WP)
local oWnd := WndMain()
local aCoord := GetWndRect( oWnd:hWnd ), WWidth, WHeight, nFactor
LOCAL aPoint1 := {aCoord[1], aCoord[2]}, aPoint2 := {aCoord[3], aCoord[4]}
LOCAL nHeight, nWidth, aImgSize := {}
// LOCAL aT := AClone (aCoord)
ClientToScreen( oWnd:hWnd, @aPoint1 ) // convert both point coordinates
ClientToScreen( oWnd:hWnd, @aPoint2 )
WWidth := aPoint2[2] - aPoint1[2] // Breite
WHeight := aPoint2[1] - aPoint1[1] // Höhe
// ? aT[1],aT[2],aT[3],aT[4],"-----",aPoint1[1], aPoint1[2],aPoint2[1],aPoint2[2]
nPos := FieldPos ("Picture")
cImgFile := FieldGet( nPos )
cImgFile := IIF( !Empty(cImgFile), "ERRORS\" + cImgFile, "" )
if FILE (cImgFile)
aImgSize := FISize (cImgFile)
nFactor := Max ((WWidth-27)/aImgSize[1],(WHeight)/aImgSize[2])
nWidth := nFactor * aImgSize[1]
nHeight := nFactor * aImgSize[2]
// ? WWidth, WHeight,"----",aImgSize[1],aImgSize[2],"---",nWidth,nHeight
DEFINE DIALOG oDlg TITLE "Fehlergrafik" PIXEL SIZE WWidth*1.1,(WHeight+30)*1.1 //TRANSPARENT
@ 3,1 SAY oSay PROMPT CRLF+Alltrim(ERRORS->Error) OF oDlg SIZE WWidth*1.1, 27 ;
COLOR COLOR_TEXT, COLOR_BAR[1] PIXEL
// if !Empty( cImgFile )
@ 28,0 IMAGE oImage FILE cImgFile PIXEL OF oDlg;
SIZE nWidth,nHeight
// endif
ACTIVATE DIALOG oDlg CENTER//;
// ON PAINT Degrade (oDlg:hDC, {0,0,Abs(WHeight-nHeight),WWidth*1.1}, COLOR_BAR[2],COLOR_BAR[1] )
else
MSGINFO("Keine Grafik vorhanden","Fehlergrafik")
endif
// Clipper 5.2
if File( "ERRTMP.JPG" )
DELETE FILE ERRTMP.JPG
endif
RETURN NIL
// Returns an array with the names of all the active Tasks running in Windows
//----------------------------------------------------------------------------//
/*function GetTasks()
local hWnd := GetWindow( GetActiveWindow(), GHW_HWNDFIRST )
local aTasks := {}
local cTask,oLdGetTasks:=.T.,hLib32:=0,RetByte:=0,BufTask
// Verify if the API exist if not it's Windows 95 or Less
// or Windows NT with SP2 or less so we will use the old technique
if ABS(hLib32:=Loadlib32("USER32.DLL")) > 32 // Can be Windows 3.11 or Lower
if substr(Getproc32(hLib32,"GetWindowModuleFileNameA",.T.,LONG,),1,4)<> CHR(0)+CHR(0)+CHR(0)+CHR(0)
oLdGetTasks:=.f.
BufTask:=space(200)
endif
Freelib32(hLib32)
endif
while hWnd != 0
if oLdGetTasks
#ifdef __CLIPPER__
cTask = GetModuleFileName( GetWindowWord( hWnd, GWW_HINSTANCE ) )
#else
// cTask = GetModuleFileName( GetWindowLong( hWnd, GWW_HINSTANCE ) )
cTask = GetWindowText( hWnd ) // The above does now work :-(
#endif
else
Retbyte:=GetWModFileName( hWnd, BufTask, 200 )
cTask:=left(BufTask,Retbyte)
endif
if ! Empty(cTask)
if AScan( aTasks, cTask ) == 0
AAdd( aTasks, cTask )
endif
endif
hWnd = GetWindow( hWnd, GHW_HWNDNEXT )
end
return aTasks
//----------------------------------------------------------------------------//
DLL32 FUNCTION GetWModFileName( hWnd AS LONG, cBuf AS LPSTR, nLong AS LONG ) ;
AS LONG PASCAL FROM "GetWindowModuleFileNameA" LIB "USER32.DLL"
*/
//--------------------------------------------------------------------
// Reemplazo a SalvaraBMP
// Original de Williams Pacheco 2003 + Bingen 2003
//--------------------------------------------------------------------
function SaveBmp( hDib, cBmpFile, cFormat )
LOCAL acFormat := {"png","gif","jpg","tiff"}, anFormat := {13,25,2,18}
LOCAL nFormat := anFormat[AScan(acFormat,Lower(cFormat))]
local cRetVal := "ERRORS\" + cBmpFile + ".BMP"
LOCAL cDestImg := "ERRORS\" + cBmpFile + "."+cFormat
LOCAL lOk := .f.
CURSORWAIT()
DibWrite( cRetVal, hDib )
IF UPPER(cFormat) <> "BMP"
lOk := FISaveImg (cRetval, cDestImg, nFormat)
FErase (cRetVal)
cRetVal := IIF (lOk, cDestImg, "")
ENDIF
// IF UPPER(cFormat) = "JPG" .and. File( "NCONVERT.EXE" )
// WaitRun( "nconvert -out jpeg " + " -D " + ".\ERRORS\" + cBmpFile +".BMP" , 0 )
// ENDIF
CursorArrow()
//return IF(UPPER(cFormat) = "PNG",cFileName( STRTRAN(cRetVal,".BMP",".PNG" )),cFileName( cRetVal ))
RETURN (cFileName (cRetVal))
//------------------------------------------------------------------
STATIC FUNCTION ReadIni ()
LOCAL oIni, aSet :=Array(10)
LOCAL cKey := emailKEY
INI oIni FILE E_INIFILE
GET aSet[E_USER] SECTION "Email" ENTRY "User" DEFAULT "" OF oIni
GET aSet[E_LOGIN] SECTION "Email" ENTRY "Login" DEFAULT "" OF oIni
GET aSet[E_PASS] SECTION "Email" ENTRY "Pass" DEFAULT "" OF oIni
GET aSet[E_POP3] SECTION "Email" ENTRY "Pop-Host" DEFAULT "" OF oIni
GET aSet[E_SMTP] SECTION "Email" ENTRY "Smpt-Host" DEFAULT "" OF oIni
GET aSet[E_CONNECT] SECTION "Email" ENTRY "Leasedline" DEFAULT .F. OF oIni
GET aSet[E_SAVE] SECTION "Email" ENTRY "Autosave" DEFAULT .T. OF oIni
GET aSet[E_DELETE] SECTION "Email" ENTRY "Maildelete" DEFAULT .T. OF oIni
GET aSet[E_FROM] SECTION "Email" ENTRY "ReplyTo" DEFAULT "" OF oIni
GET aSet[E_TO] SECTION "Email" ENTRY "MailTo" DEFAULT emailADDRESS OF oIni
// GET aSet[E_] SECTION "Email" ENTRY "Leasedline" DEFAULT .F. OF oIni
ENDINI
aSet[E_PASS] := Crypt(aSet[E_PASS],cKey)
RETURN (aSet)
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
function GetCPU()
local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
"HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
.f. )
local cCpu := oReg:Get( "ProcessorNameString" )
oReg:Close()
return cCpu
//-----------------------------------------------------------------//
STATIC FUNCTION Degrade ( hDC, aRect, nColor, nColorTo )
//LOCAL aRect := GETCLIENTRECT( oWnd:hWnd )
LOCAL nStep , nStepY /// 256
LOCAL oBrush
LOCAL i, r,g,b
LOCAL r0,g0,b0
LOCAL r1, g1, b1
LOCAL rD, gD, bD
DEFAULT nColorTo := nRGB (250,250,250)
//nColor := nRGB (255,0,0)
nStep := ( aRect[ 3 ] - aRect[ 1 ] )
nStepY := ( aRect[ 3 ] - aRect[ 1 ] ) / nStep
aRect[ 3 ] = aRect[ 1 ] + nStepY
r0 := nRGBRed (nColor)
g0 := nRGBGreen (nColor)
b0 := nRGBBlue (nColor)
r1 := nRGBRed (nColorTo)
g1 := nRGBGreen (nColorTo)
b1 := nRGBBlue (nColorTo)
rD := r1-r0
gD := g1-g0
bD := b1-b0
r := 256*rD/Max(nStep,1)
g := 256*gD/Max(nStep,1)
b := 256*bD/Max(nStep,1)
r0*=256
g0*=256
b0*=256
// ? R + G*256 + B*256*256, nColor
// ? rD, gD, bD, "---",r, g, b
FOR i = 0 TO nStep-1 STEP nStepY
r0 += r
g0 += g
b0 += b
DEFINE BRUSH oBrush COLOR nRGB( r0/256, g0/256, b0/256 )
FILLRECT( hDC, aRect, oBrush:hBrush )
RELEASE BRUSH oBrush
// ? r0/256, g0/256,b0/256, nRGB( r0/256, g0/256, b0/256 ),aRect[1], aRect[3]
aRect[ 1 ] += nStepY
aRect[ 3 ] += nStepY
NEXT
RETURN (nil)
Code: Select all
#include "Fivewin.ch"
#define SS_SUNKEN 4096
REQUEST DBFFPT
REQUEST ordKeyGoTo
Function Main ()
local oWnd
LOCAL a := 1,;
b := "Hallo"
REQUEST DBFCDX
REQUEST DBFFPT
REQUEST ordKeyGoTo
RDDSETDEFAULT ("DBFCDX")
SET AUTOPEN OFF
define window oWnd from 1,1 to 20,60 title "Test"
@ 100,60 BUTTON "&Test" OF oWnd ACTION ErrTest (a,b) ;
SIZE 40, 20 PIXEL
@ 140,60 BUTTON "&View" OF oWnd ACTION ViewErrors (); //ErrDlg (a,b) ;
SIZE 60, 20 PIXEL
DEFINE MESSAGE OF oWnd PROMPT "Messagebar"
Activate Window oWnd //on Paint Err(a,b)
RETURN (nil)
function Errtest (a,b)
// ? "Test Errorsys", IIF (Empty(WndMain()),"nil","object")
? b / a
return (nil)kind regards
Stefan
Stefan
Re: Errsysw Visual Update ?
Stefan,
I thought I would try your example code but there are a couple of functions missing.
fisize
fisaveimg
Do you have code for these functions?
Thanks
I thought I would try your example code but there are a couple of functions missing.
fisize
fisaveimg
Do you have code for these functions?
Thanks
-
StefanHaupt
- Posts: 824
- Joined: Thu Oct 13, 2005 7:39 am
- Location: Germany
Re: Errsysw Visual Update ?
Gale,
I used a modified image.prg. here it is
I used a modified image.prg. here it is
Code: Select all
// 16.09.05 Konvertieren von 32bit bmp zu 24bit beim Speichern als jpeg
#include "FiveWin.ch"
#include "Constant.ch"
#include "Inkey.ch"
#define GW_CHILD 5
#define GW_HWNDNEXT 2
#define RT_BITMAP 2
#define MB_ICONEXCLAMATION 48
#ifdef __XPP__
#define New _New
#define Super ::TBitmap
#endif
STATIC hLib
//----------------------------------------------------------------------------//
CLASS TImage FROM TBitmap
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, cResName, cBmpFile, lNoBorder,;
oWnd, bLClicked, bRClicked, lScroll, lStretch, oCursor,;
cMsg, lUpdate, bWhen, lPixel, bValid, lDesign ) CONSTRUCTOR
METHOD Define( cResName, cBmpFile, oWnd ) CONSTRUCTOR
METHOD LoadImage( cResName, cBmpFile )
METHOD Progress (lProgress)
METHOD SaveImage( cFile, nFormat, nFlag )
METHOD GetHeight (hBmp)
METHOD GetWidth (hBmp)
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, cResName, cBmpFile, lNoBorder,;
oWnd, bLClicked, bRClicked, lScroll, lStretch, oCursor,;
cMsg, lUpdate, bWhen, lPixel, bValid, lDesign ) CLASS TImage
#ifdef __XPP__
::lRegistered = .f.
#endif
Super:New( nTop, nLeft, nWidth, nHeight, cResName, cBmpFile, lNoBorder, ;
oWnd, bLClicked, bRClicked, lScroll, lStretch, oCursor, ;
cMsg, lUpdate, bWhen, lPixel, bValid, lDesign )
return Self
//----------------------------------------------------------------------------//
// This method does not create a control, it just creates a bitmap object to
// be used somewhere else.
METHOD Define( cResName, cBmpFile, oWnd ) CLASS TImage
local aBmpPal
DEFAULT oWnd := GetWndDefault()
::oWnd = oWnd
::nZoom = 1
::hWnd = 0
::hBitmap = 0
::hPalette = 0
if ! Empty( cResName )
aBmpPal = PalBmpLoad( cResName )
::hBitmap = aBmpPal[ 1 ]
::hPalette = aBmpPal[ 2 ]
cBmpFile = nil
endif
if ! Empty( cBmpFile ) .and. File( cBmpFile )
::cBmpFile = cBmpFile
::hBitmap = FILoadImg( AllTrim( cBmpFile ) )
endif
if ::hBitmap != 0
PalBmpNew( 0, ::hBitmap, ::hPalette )
endif
return Self
//----------------------------------------------------------------------------//
METHOD LoadImage( cResName, cBmpFile ) CLASS TImage
local lChanged := .f.
local hOldBmp := ::hBitmap
local hOldPal := ::hPalette
local aBmpPal
DEFAULT cResName := ::cResName, cBmpFile := ::cBmpFile
if ! Empty( cResName )
aBmpPal = PalBmpLoad( cResName )
::hBitmap = aBmpPal[ 1 ]
::hPalette = aBmpPal[ 2 ]
lChanged = .t.
cBmpFile = nil
elseif File( cBmpFile )
::hBitmap = FILoadImg( AllTrim( cBmpFile ) )
lChanged := .t.
cResName := nil
endif
if lChanged
::cResName = cResName
::cBmpFile = cBmpFile
if ! Empty( hOldBmp )
PalBmpFree( hOldBmp, hOldPal )
endif
PalBmpNew( ::hWnd, ::hBitmap, ::hPalette )
endif
return lChanged
//----------------------------------------------------------------------------//
METHOD Progress( lProgress ) CLASS TImage
if ValType( lProgress ) == "L"
if lProgress
::nProgress = 1
else
::nProgress = 0
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD SaveImage( cFile, nFormat, nFlag ) CLASS TImage
// 0 -> Bmp
// 2 -> Jpg
// 13 -> Png
return (FISaveImg( ::cBmpFile, cFile, nFormat, nFlag ))
//----------------------------------------------------------------------------//
METHOD GetHeight (cFile)
LOCAL nRet := 0
nRet := FISize(cFile)[1]
RETURN (nRet)
//----------------------------------------------------------------------------//
METHOD GetWidth (cFile)
LOCAL nRet := 0
nRet := FISize(cFile)[2]
RETURN (nRet)
#define CBM_INIT 4
#define DIB_RGB_COLORS 0
//----------------------------------------------------------------------------//
FUNCTION FILoadImg( cFile )
LOCAL nFormat, hDib, hInfoH, hInfo, hBits, hWnd, hDC, hBmp
#ifdef __CLIPPER__
hLib = LOADLIB32( "freeimage.dll" )
#else
hLib = LOADLIBRARY( "freeimage.dll" )
#endif
if hLib <= 32
MsgStop( "Cannot load FreeImage.dll" )
return 0
endif
nFormat = FIGETFILETYPE( cFile, 0 )
hDib = FILOAD( nFormat, cFile, 0 )
hInfoH = FIGETINFOHEADER( hDib )
hInfo = FIGETINFO( hDib )
hBits = FIGETBITS( hDib )
hWnd = GETDESKTOPWINDOW()
#ifdef __CLIPPER__
hDC = GETDC32( hWnd )
#else
hDC = GETDC( hWnd )
#endif
hBmp = CREATEDIBITMAP( hDC, hInfoH, CBM_INIT, hBits, hInfo, DIB_RGB_COLORS )
#ifdef __CLIPPER__
RELEASEDC32( hWnd, hDC )
#else
RELEASEDC( hWnd, hDC )
#endif
FIUNLOAD( hDib )
#ifdef __CLIPPER__
FREELIB32( hLib )
#else
FREELIBRARY( hLib )
#endif
#ifdef __CLIPPER__
hBmp = NLOWORD( WOWHANDLE16( hBmp, 8 ) )
#endif
RETURN (hBmp)
//-----------------------------------------------------------------------------
FUNCTION FISaveImg ( cSrcFile, cDstFile, nDstFormat )
LOCAL nSrcFormat, hDib, lOk
#ifdef __CLIPPER__
hLib = LOADLIB32( "freeimage.dll" )
#else
hLib = LOADLIBRARY( "freeimage.dll" )
#endif
nSrcFormat = FIGETFILETYPE( cSrcFile, 0 )
hDib = FILoad( nSrcFormat, cSrcFile, 0 )
// ? cSrcFile, nSrcformat, hDib, cDstFile
lOk = FISave( nDstFormat, hDib, cDstFile, 0 )
#ifdef __CLIPPER__
FREELIB32( hLib )
#else
FREELIBRARY( hLib )
#endif
RETURN (lOk)
/*
Bingo! You can convert your bitmap to 24 bit using:
FUNCTION FISAVEIMG( cSrcFile, cDstFile, nDstFormat )
LOCAL nSrcFormat, hDib, hDib2, lOk
#ifdef __CLIPPER__
hLib = LOADLIB32( "freeimage.dll" )
#else
hLib = LOADLIBRARY( "freeimage.dll" )
#endif
nSrcFormat = FIGETFILETYPE( cSrcFile, 0 )
hDib = FILOAD( nSrcFormat, cSrcFile, 0 )
hDib2 = FICNV24( hDib )
lOk = FISAVE( nDstFormat, hDib2, cDstFile, 0 )
FIUNLOAD( hDib )
FIUNLOAD( hDib2 )
#ifdef __CLIPPER__
FREELIB32( hLib )
#else
FREELIBRARY( hLib )
#endif
RETURN lOk
*/
//---------------------------------------------------------------------------//
FUNCTION FIAdjustBright ( hDib, nBright )
FIAdjustBrightness (hDib, nBright)
RETURN (nil)
FUNCTION FISize (cFile)
LOCAL nRet := 0, hDib, nFormat
LOCAL nWidth, nHeight
hLib = LoadLibrary ( "freeimage.dll" )
nFormat = FIGETFILETYPE( cFile, 0 )
hDib := FILoad (nFormat,cFile,0)
nHeight := FIGetHeight(hDib)
nWidth := FIGetWidth (hDib)
FIUnload (hDib)
FreeLibrary ( hLib )
RETURN ({nWidth,nHeight})
//----------------------------------------------------------------------------//
DLL32 STATIC FUNCTION FIGETFILETYPE( cFileName AS LPSTR, nSize AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetFileType@8" LIB hLib
DLL32 STATIC FUNCTION FILOAD( nFormat AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_Load@12" LIB hLib
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL;
PASCAL FROM "_FreeImage_Save@16" LIB hLib
DLL32 STATIC FUNCTION FIUNLOAD( hDib AS LONG ) AS VOID;
PASCAL FROM "_FreeImage_Unload@4" LIB hLib
DLL32 STATIC FUNCTION FIGETINFOHEADER( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfoHeader@4" LIB hLib
DLL32 STATIC FUNCTION FIGETINFO( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfo@4" LIB hLib
DLL32 STATIC FUNCTION FIGETBITS( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetBits@4" LIB hLib
DLL32 STATIC FUNCTION FICNV24( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_ConvertTo24Bits@4" LIB hLib
DLL32 STATIC FUNCTION FIADJUSTBRIGHTNESS( hDib AS LONG, nPercent AS _DOUBLE ) AS BOOL;
PASCAL FROM "_FreeImage_AdjustBrightness@12" LIB hLib
DLL32 STATIC FUNCTION FIADJUSTContrast( hDib AS LONG, nPercent AS _DOUBLE ) AS BOOL;
PASCAL FROM "_FreeImage_AdjustContrast@12" LIB hLib
DLL32 STATIC FUNCTION FIInitialise( lLoadPlug AS LONG) AS VOID;
PASCAL FROM "_FreeImage_Initialise@4" LIB hLib
DLL32 STATIC FUNCTION FIDeInitialise( ) AS VOID;
PASCAL FROM "_FreeImage_DeInitialise@0" LIB hLib
DLL32 STATIC FUNCTION FIGetVersion ( ) AS LPSTR;
PASCAL FROM "_FreeImage_GetVersion@0" LIB hLib
DLL32 STATIC FUNCTION FIGetCopyright ( ) AS LPSTR;
PASCAL FROM "_FreeImage_GetCopyrightMessage@0" LIB hLib
DLL32 STATIC FUNCTION FIGetWidth ( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetWidth@4" LIB hLib
DLL32 STATIC FUNCTION FIGetHeight ( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetHeight@4" LIB hLib
DLL32 STATIC FUNCTION FIRotate ( hDib AS LONG, nAngle AS _DOUBLE ) AS LONG;
PASCAL FROM "_FreeImage_RotateClassic@12" LIB hLib
DLL32 STATIC FUNCTION FIRotateEX ( hDib AS LONG, nAngle AS _DOUBLE, x_Shift AS _DOUBLE,y_Shift AS _DOUBLE,;
x_Orig AS _DOUBLE, y_Orig AS _DOUBLE, lMask AS BOOL ) AS LONG;
PASCAL FROM "_FreeImage_RotateEx@48" LIB hLib
DLL32 STATIC FUNCTION GETDC32( hWnd AS LONG ) AS LONG;
PASCAL FROM "GetDC" LIB "user32.dll"
DLL32 STATIC FUNCTION RELEASEDC32( hWnd AS LONG ) AS LONG;
PASCAL FROM "ReleaseDC" LIB "user32.dll"
DLL32 STATIC FUNCTION CREATEDIBITMAP( hDC AS LONG, hInfoH AS LONG, nFlags AS LONG, hBits AS LONG, hInfo AS LONG, nUsage AS LONG ) AS LONG;
PASCAL FROM "CreateDIBitmap" LIB "gdi32.dll"
//----------------------------------------------------------------------------//kind regards
Stefan
Stefan
Re: Errsysw Visual Update ?
Thanks,
Since I left that request, I found most of what I needed.
I like this ErrSysW as a replacement.
I did make a few changes though.
Changed it so that English or German on the buttons and other places that were hard coded German before.
I also replaces some routines that are built into Fivewin now like FIConvertImageFile()
I also added the image as an attachment to the email.
Since I left that request, I found most of what I needed.
I like this ErrSysW as a replacement.
I did make a few changes though.
Changed it so that English or German on the buttons and other places that were hard coded German before.
I also replaces some routines that are built into Fivewin now like FIConvertImageFile()
I also added the image as an attachment to the email.
-
yeangpumpeng
- Posts: 21
- Joined: Mon Aug 09, 2010 8:58 am
Re: Errsysw Visual Update ?
want to post a screenshot ?
-
StefanHaupt
- Posts: 824
- Joined: Thu Oct 13, 2005 7:39 am
- Location: Germany
Re: Errsysw Visual Update ?
Gale,
very good news
Maybe we had to compare the errorhandler, too, to see if something has changed in the last four years. These functions are new and have to be impelemented to get full compatibility: SetErrorPath(), SetErrorFileName() and SetPostErrorAction().
If you post the changed source, I can do this.
very good news
Maybe we had to compare the errorhandler, too, to see if something has changed in the last four years. These functions are new and have to be impelemented to get full compatibility: SetErrorPath(), SetErrorFileName() and SetPostErrorAction().
If you post the changed source, I can do this.
kind regards
Stefan
Stefan
Re: Errsysw Visual Update ?
Here is my modified ErrSysW.prg
Code: Select all
// Error handler system adapted to FiveWin
// Modificado por BINGEN - Mungia Informática 1.999-2.002
// Adaptación Clipper 5.2 por WILLIAMS PACHECO 2.003
// Remodelado por Jose Carlos da Rocha - SoHome Informatica Jul-2005
// ErrSysW.prg
// ------------------------------------------------------------------
// Modification and Enhancement by Stefan Haupt, 2007/2008
// - the errorhandler is now independent of any rc-file,
// all dialogs are now coded from source
// - all dialogs now have a modern design (in my opinion)
// the color can be change with #define 'COLOR_DIALOG'
// predefined are COLOR_XP, COLOR_VISTA and COLOR_ALERT
// - SaveBmp() was changed to get rid of the program "nconvert"
// now it uses a freeimage function to save the bitmap as png-file
// - email configuration is read from ini-file
// - function CheckPop3() is no longer needed (still in this file)
// - Sendmail() was changed to read the ini-file
// - ShowerrPic() was corrected to show the whole bitmap
// - all textstrings were translated into german (sorry)
// ------------------------------------------------------------------
// Modification and Enhancement by Gale Ford, 2011
// - Added #define for all text and buttons that were still hardcoded.
// - English and German should be correct for all text.
// - Changed screen image creation to before the error dialog is shown
// so it could be added to the email as an attachment.
// - FISaveImg() replaced with with built in
// Fivewin function FIConvertImageFile()
// - Changed Error dialog to use Red
// and the View dialog to use Green.
// - Added 2 fields to errors.dbf,
// User = gete('USERNAME') and WholeName = gete('WHOLE_NAME')
// If you alread have an errors.dbf then it gets renamed to errors.sav
// so the new errors.dbf can be created.
// - Added #define emailDOMAIN so that "user", "from", and other can be
// put together with emailDOMAIN to better automate email notification.
// TODO:
// translate the #defines to support more languages
STATIC lWin2000
#include "error.ch"
#include "dll.ch"
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
#xcommand PRINT [ <oPrint> ] ;
[ <name: NAME, TITLE,DOC> <cDocument> ] ;
[ <user: FROM USER> ] ;
[ <prvw: PREVIEW> [<lmodal: MODAL>] ] ;
[ TO <xModel> ] ;
=> ;
[ <oPrint> := ] PrintBegin( [<cDocument>], <.user.>, <.prvw.>, <xModel>, <.lmodal.> )
#xcommand PRINTER [ <oPrint> ] ;
[ <name: NAME, DOC> <cDocument> ] ;
[ <user: FROM USER> ] ;
[ <prvw: PREVIEW> [<lmodal: MODAL>] ] ;
[ TO <xModel> ] ;
=> ;
[ <oPrint> := ] PrintBegin( [<cDocument>], <.user.>, <.prvw.>, <xModel>, <.lmodal.> )
#xcommand PAGE => PageBegin()
#xcommand ENDPAGE => PageEnd()
#xcommand ENDPRINT => PrintEnd()
#xcommand ENDPRINTER => PrintEnd()
//----------------------------------------------------------------------------//
#define GHW_HWNDFIRST 0
#define GHW_HWNDNEXT 2
#define GWW_HINSTANCE -6
#define SS_SUNKEN 4096
#define NTRIM(n) ( LTrim( Str( n ) ) )
#define DLG_TITLE "FiveWin for xHarbour"
#command QUIT => ( PostQuitMessage( 0 ), __Quit() )
#define sysERRORSDIR "ERRORS\"
//----------------------------------------------------------------------------//
#define E_INIFILE ".\Email.ini"
#define E_USER 1
#define E_LOGIN 2
#define E_PASS 3
#define E_POP3 4
#define E_SMTP 5
#define E_CONNECT 6
#define E_SAVE 7
#define E_DELETE 8
#define E_FROM 9
#define E_TO 10
// Dialog colors
#define COLOR_XP {nRGB( 3, 56, 147 ),nRGB( 89, 135, 214 )} //RGB( 0, 0, 128)
#define COLOR_VISTA {nRGB( 46, 139, 87) ,nRGB( 0, 250, 154)} //RGB( 0, 139, 69)
#define COLOR_ALERT {nRGB( 178, 34, 34 ), nRGB (255, 116, 132 ) }
//#define COLOR_ALERT {nRGB( 178, 34, 34 ), nRGB (255, 228, 255 ) }
#define COLOR_BAR COLOR_VISTA
#define COLOR_TEXT CLR_WHITE
//#define _GERMAN
//#define _SPANISH
#define _ENGLISH
//#define _ITALIAN
//#define _PORTUG
#ifdef _GERMAN
#define dlgPROG "Programm: "
#define dlgTITLE "Programmfehler"
#define errHEADER "Fehlerbeschreibung"
#define errDESC " Beschreibung : "
#define errPROGPATH " Programmpfad : "
#define errPROGSIZE " Dateigröße : "
#define errMAXFILES " Max. Dateien : "
#define errTIME " Laufzeit : "
#define errOCCUR " Fehlerzeitpunkt: "
#define errNETNAME " Computername : "
#define errUSER " Anwender : "
#define errDETAIL "detaillierte Beschreibung des Fehlers"
#define errSTACKLIST "Stack-Liste"
#define errSTACKCALL " Aufruf von "
#define errTASKS "Liste der Windowstasks: "
#define errVARLIST "Liste aller Variablen"
#define errVARIABLE " Name Typ Wert"
#define errRDD "Datenbanktreiber"
#define errOPENDBF "Geöffnete Datenbanken"
#define errINDEX "Indexdateien "
#define errRELATION "Datenbankrelationen"
#define dlgTEXT1 "Leider ist ein Fehler aufgetreten."+CRLF+;
"Bitte informieren Sie den Hersteller der Software über diesen Fehler und "+CRLF+;
"wie er aufgetreten ist."+CRLF+;
"Alle Angaben werden vertraulich behandelt."
#define dlgTEXT2 "Fehlerbeschreibung:"
#define BTN_Header "Fehlerinformation"
#define BTN_View "Fehlerlog im Editor ansehen"
#define BTN_Retry "Erneut versuchen"
#define BTN_Default "Standardwerte"
#define BTN_Send1 "Fehlerbericht senden"
#define BTN_Send2 "Fehlerbericht"
#define BTN_Send3 "Fehlerbericht gesendet"
#define BTN_End "nicht senden / Beenden"
#define BTN_Help "Hilfe"
#define emailADDRESS "info@ibbsh.de"
#define emailKEY "3jfbt72"
#define emailDOMAIN "ibbsh.de"
#define emailALERT1 "Email-Einstellungen fehlerhaft"
#define emailALERT2 "Email versenden"
#define emailCONNECTING1 "Anschließen an "
#define emailCONNECTING2 "und wartet auf Antwort..."
#define emailCONNECTED "Email wird versandt..."
#define emailCONNECTEDPOP "Suchen nach E-Mails ..."
#define viewALERT1 "Die Fehlerprotokolldatei fehlt"
#define viewALERT2 "Fehlerprotokolles"
#define viewERRORTitle "Fehlerprotokolle ansehen"
#define viewERROR1 "Datum des Fehlers "
#define viewERROR2 " Uhrzeit "
#define viewERROR3 "Fehlerbeschreibung"
#define viewERROR4 "Benutzer/PC "
#define viewERROR5 "Fehler "
#define viewBTNImg "Fehlergrafik"
#define viewBTNPrint "Drucken"
#define viewBTNClose "Schließen"
#define showPICTitle "Fehlergrafik"
#define showPICERROR1 "Keine Grafik vorhanden"
#define showPICERROR2 "Fehlergrafik"
#endif
#ifdef _SPANISH
#endif
#ifdef _ENGLISH
#define dlgPROG "Program: "
#define dlgTITLE "Application error"
#define errHEADER "Errordescription"
#define errDESC " Description : "
#define errPROGPATH " App-Path : "
#define errPROGSIZE " Filesize : "
#define errMAXFILES " Max. files : "
#define errTIME " Time from start: "
#define errOCCUR " Occurance : "
#define errNETNAME " Computername : "
#define errUSER " User : "
#define errDETAIL "detailled error description"
#define errSTACKLIST "Stack-List"
#define errSTACKCALL " called by "
#define errTASKS "running tasks: "
#define errVARLIST "Varlist"
#define errVARIABLE " Name Type Value"
#define errRDD "RDD"
#define errOPENDBF "Open dbf´s"
#define errINDEX "Index files "
#define errRELATION "Relations"
#define sysHEADER "Systeminformation"
#define sysWINDOWS
#define sysVERSION
#define dlgTEXT1 "Please contact your dealer or computer support department"+CRLF+;
"about this error and the circumstances it happened."+CRLF+CRLF+;
[Email error report by clicking "Send errorlog" button]
#define dlgTEXT2 "Error Description:"
#define BTN_Header "An Error Has Occurred"
#define BTN_View "View errorlog"
#define BTN_Retry "Retry"
#define BTN_Default "Default"
#define BTN_Send1 "Send errorlog"
#define BTN_Send2 "Errorlog"
#define BTN_Send3 "Errorlog sent"
#define BTN_End "do not send / end"
#define BTN_Help "Help"
#define emailDOMAIN "usersdomain.com"
#define emailADDRESS "help.desk@helpdomain.com"
#define emailKEY "3jfbt72"
#define emailALERT1 "Email settings are incorrect"
#define emailALERT2 "Email Settings"
#define emailCONNECTING1 "Connecting to "
#define emailCONNECTING2 "and waiting for response..."
#define emailCONNECTED "Sending Email..."
#define emailCONNECTEDPOP "Checking for email messages..."
#define viewALERT1 "The error log file is missing"
#define viewALERT2 "error Log"
#define viewERRORTitle "View Error Logs"
#define viewERROR1 "Date of the error "
#define viewERROR2 " time "
#define viewERROR3 "Error description "
#define viewERROR4 "User/PC "
#define viewERROR5 "Error Image "
#define viewBTNImg "View Image"
#define viewBTNPrint "Print"
#define viewBTNClose "Close"
#define showPICTitle "Graphic Error"
#define showPICERROR1 "No Graphics Available"
#define showPICERROR2 "Graphic Error"
#endif
#ifdef _ITALIAN
#endif
#ifdef _PORTUG
#endif
external _fwGenError // Link FiveWin generic Error Objects Generator
/******************************************************
* ErrorSys()
*
* Note: automatically executes at startup
*******************************************************/
proc ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
return
proc ErrorLink()
return
/****************
* ErrorDialog()
*****************/
STATIC FUNCTION ErrorDialog( e ) // -> logical or quits App.
local oDlg, oFont, oFont1
//local lRet // if lRet == nil -> default action: QUIT
local nArea := select()
local n, j
local oSay, oSay1, oGet//, cTxt1, cTxt2, hLogo
local nButtons := 1, hLogo
local cErrorLog := "", cParam := "", cVariables := "", cStack := ""
LOCAL aStack := {}, cMessage := "", cTxt1 := "", cTxt2 := ""
local aVersions := {}
local aTasks := {}
local aRDDs, nTarget, uValue
local oOldError
local cRelation
local lIsWinNT := IsWinNT()
// local oSystemInfo
local oWnd := WndMain()
local cTitle := IIF (!Empty(oWnd),"Programm: "+oWnd:cTITLE, dlgTITLE)
local hBmp, hDib, cImgFile
local aScreens:=array(0), nScreen, nScreens:=30 //max. 30 Screenshots
local cUser := WNetGetUser ()
local oBtn1, oBtn2, oBtn3, oBtn4, oBtn5
static lRet
// Definimos cUser por si acaso el sistema no maneja este valor (WP)
cUser := if( ValType( cUser ) <> "C", "N/D", cUser )
// Por defecto la división entre 0 devuelve 0
if ( e:genCode == EG_ZERODIV )
return 0
endif
// for network open error, set NETERR() and subsystem default
if ( e:genCode == EG_OPEN .and. ;
( e:osCode == 32 .or. e:osCode == 5 ) .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
end
// for lock error during APPEND BLANK, set NETERR() and subsystem default
if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
NetErr( .t. )
return .f. // OJO SALIDA
endif
if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
ErrorBlock( {|e| MsgStop( ErrorMessage(e) + " from Errorsys, line:" + ;
Str( ProcLine( 1 ), 3 ) ), __quit() } )
// aTasks := GetTasks()
// aVersions := GetVersion()
/* DESCRIPCIÓN DEL ERROR */
cErrorLog += errHEADER + CRLF
cErrorLog += cTitle + CRLF
cErrorLog += "-----------------------------------------" + CRLF
cErrorLog += errPROGPATH + GetModuleFileName( GetInstance() ) + CRLF
cErrorLog += errPROGSIZE + Transform( FSize( GetModuleFileName( GetInstance() ) ), "9,999,999 bytes" ) + CRLF
cErrorLog += errMAXFILES + Str( SetHandleCount(), 3 ) + CRLF
cErrorlog += errTIME + TimeFromStart () + CRLF
cErrorLog += errOCCUR + DToC( Date() ) + ", " + Time() + CRLF
cErrorLog += errNETNAME + NETNAME(.f.) + CRLF
cErrorLog += errUSER + cUser + CRLF + CRLF
// Error object analysis
cMessage = errDETAIL + CRLF+;
Replicate ("-",Len(errDETAIL)) + CRLF+;
" "+ErrorMessage( e ) + CRLF
cErrorLog += cMessage
if ValType( e:Args ) == "A"
cErrorLog += " Parameter :" + CRLF
for n = 1 to Len( e:Args )
cErrorLog += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
cParam += " [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
" " + cValToChar( e:Args[ n ] ) + CRLF
next
endif
cErrorlog += CRLF + errSTACKLIST + CRLF
cErrorlog += Replicate ("-",Len(errSTACKLIST)) + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty(ProcName( n ) )
AAdd( aStack, errSTACKCALL + Trim( ProcName( n ) ) + ;
"(" + NTRIM( ProcLine( n ) ) + ")" )
cStack += ATail( aStack ) + CRLF
endif
n++
end
cErrorlog += cStack
cErrorLog += " CPU type: " + GetCPU() + " " + ;
AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" + CRLF
cErrorLog += " Hardware memory: " + ;
cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
" MB" + CRLF + CRLF
cErrorLog += " Free System resources: " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" + CRLF + ;
" GDI resources: " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" + CRLF + ;
" User resources: " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" + CRLF + CRLF
cErrorLog += " Compiler version: " + Version() + CRLF
aVersions := GetVersion()
cErrorLog += " Windows version: " + ;
AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
AllTrim( Str( aVersions[ 3 ] ) ) + ;
" " + aVersions[ 5 ] + CRLF + CRLF
cErrorLog+=CRLF
cErrorLog+=CRLF+ errTASKS + Str( Len (aTasks), 3 )
cErrorLog+=CRLF+ Replicate ("-",Len(errTASKS))
cErrorLog+=CRLF
aTasks = GetTasks()
for n = 1 to Len( aTasks )
cErrorLog += " " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
next
// Warning!!! Keep here this code !!! Or we will be consuming GDI as
// we don't generate the error but we were generating the bitmap
hLogo = FWBitMap()
if e:canRetry
nButtons++
endif
if e:canDefault
nButtons++
endif
cVariables += CRLF + errVARLIST + CRLF + ;
Replicate ("-",Len(errVARLIST)) + CRLF
cVariables += errVARIABLE + CRLF
cVariables += Replicate ("-",Len(errVARIABLE)) + CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty( ProcName( n ) ) .AND. ProcName( n )<>"ERRORDIALO"
cVariables += " " + Trim( ProcName( n ) ) + CRLF
for j = 1 to ParamCount( n )
cVariables += " Param " + Str( j, 3 ) + ": " + ;
ValType( GetParam( n, j ) ) + ;
" " + cGetInfo( GetParam( n, j ) ) + CRLF
next
for j = 1 to LocalCount( n )
cVariables += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
next
endif
n++
end
cErrorLog += cVariables
cErrorLog += CRLF + errRDD + CRLF + ;
Replicate ("-",Len(errRDD)) + CRLF
aRDDs = RddList( 1 )
for n = 1 to Len( aRDDs )
cErrorLog += " " + aRDDs[ n ] + CRLF
next
cErrorLog += CRLF + errOPENDBF + CRLF + ;
Replicate ("-",Len(errOPENDBF)) + CRLF
for n = 1 to 255
if ! Empty( Alias( n ) )
cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", " " ) + ;
PadR( Alias( n ), 15 ) + Space( 20 ) + "RddName: " + ;
( Alias( n ) )->( RddName() ) + CRLF
cErrorLog += " ==============================" + CRLF
cErrorLog += " RecNo RecCount BOF EOF" + CRLF
cErrorLog += " " + Transform( ( Alias( n ) )->( RecNo() ), "99999" ) + ;
" " + Transform( ( Alias( n ) )->( RecCount() ), "99999" ) + ;
" " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
" " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF
if ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
cErrorLog += errINDEX + Space( 23 ) + "TagName" + CRLF
for j = 1 to 15
if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
cErrorLog += Space( 8 ) + ;
If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", " " ) + ;
PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
( Alias( n ) )->( OrdName( j ) ) + ;
CRLF
endif
next
cErrorLog += CRLF + errRELATION + CRLF+;
Replicate ("-",Len(errRELATION))
for j = 1 to 8
if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
"TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
" INTO " + Alias( nTarget ) + CRLF
// uValue = ( Alias( n ) )->( DbRelation( j ) )
// cErrorLog += cValToChar( &( uValue ) ) + CRLF
endif
next
ENDIF // ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
endif // !Empty( Alias(n))
next
n = 1
cErrorLog += CRLF + "internal classes" + CRLF
cErrorLog += "----------------" + CRLF
// while ! Empty( __ClassName( n ) )
// cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
// end
#ifndef __XHARBOUR__
while ! Empty( __ClassName( n ) )
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#else
while n <= __ClsCntClasses()
cErrorLog += " " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
end
#endif
cErrorLog += CRLF + "Memory Analysis" + CRLF
cErrorLog += "===============" + CRLF
cErrorLog += " " + LTrim( Str( nStatics() ) ) + " Static variables" + ;
CRLF + CRLF
cErrorLog += " Dynamic memory consume:" + CRLF
cErrorLog += " Actual Value: " + Str( MemUsed() ) + " bytes" + CRLF
cErrorLog += " Highest Value: " + Str( MemMax() ) + " bytes" + CRLF
/* GRABAR FICHERO DEL ERROR*/
// BEGIN SEQUENCE
// oOldError = ErrorBlock( { || DoBreak() } )
MemoWrit( "Error.log", cErrorLog )
// END SEQUENCE
// ErrorBlock( oOldError )
cTxt1 := dlgTEXT1
cTxt2 := dlgTEXT2+CRLF+ErrorMessage( e )+CRLF+cParam+CRLF+cStack
/*
bDone := nil //{|| oWnd:SetMsg( "Email wird versandt..." ) }
*/
if lRet == nil .or. ( !LWRunning() .and. lRet )
BEGIN SEQUENCE
oOldError = ErrorBlock( { || DoBreak() } )
/* CONTROL PERSONALIZADO DE ERRORES */
if !lIsDir( "ERRORS" ) //CREAR CARPETA DE ERRORES DEL PROGRAMA
lMkDir( "ERRORS" )
endif
// Check if new fields User and WholeName in this version
// If not then rename it so new version can be created
IF FILE(sysERRORSDIR+"ERRORS.DBF")
select 0
USE ( sysERRORSDIR+"ERRORS.DBF" ) SHARED
IF type("errors->user") != "C"
use
frename( sysERRORSDIR+"ERRORS.DBF", sysERRORSDIR+"ERRORS.SAV" )
ELSE
use
ENDIF
ENDIF
IF !FILE(sysERRORSDIR+"ERRORS.DBF")
DbCreate(sysERRORSDIR+"ERRORS.DBF",;
{{"Comp","C",11,0},{"Date","D",8,0},;
{"Time","C",8,0},{"Error","C",76,0},;
{"User","C",15,0},{"WholeName","C",76,0},;
{"Descript","M",10,0},{"Picture","C",30,0} })
ENDIF
SET PRINTER OFF
SET CONSOLE ON
select 0
USE ( sysERRORSDIR+"ERRORS.DBF" ) SHARED
APPEND BLANK
REPLACE Comp WITH NETNAME()
REPLACE Date WITH DATE()
REPLACE Time WITH TIME()
REPLACE Error WITH STRTRAN(ErrorMessage( e ),CRLF," ")
REPLACE Descript WITH cERRORLOG
REPLACE User WITH gete('USERNAME')
REPLACE WholeName WITH gete('WHOLE_NAME')
hBmp := WndBitmap( oWnd:hWnd )
hDib := DibFromBitmap( hBmp )
cImgFile := "Err" + StrZero( RecNo(), 5 )
aScreens:=DIRECTORY(sysERRORSDIR+"*.png")
aScreens:=ASORT(aScreens,,, { |x, y| x[1] < y[1] })
FOR nScreen:=1 TO LEN(aScreens)-nScreens
DELETE FILE (sysERRORSDIR+aScreens[nScreen,1]) // delete all files more than 30
NEXT
cImgFile := SaveBmp( hDib, cImgFile, "png" )
REPLACE Picture WITH cImgFile
COMMIT
END SEQUENCE
ErrorBlock( oOldError )
endif
/* Errordialog */
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10
DEFINE FONT oFont1 NAME "Arial" SIZE 0, -18 BOLD
DEFINE DIALOG oDlg SIZE 420,322 TITLE cTitle PIXEL TRANSPARENT
@ 2,2 SAY oSay PROMPT BTN_Header OF oDlg SIZE 211,27 ;
FONT oFont1 PIXEL
@ 30,2 SAY oSay1 PROMPT cTxt1 OF oDlg SIZE 207,32 PIXEL
oSay1:nStyle := nOR( oSay:nStyle, SS_SUNKEN )
@ 65,2 GET oGet VAR cTxt2 OF oDlg MEMO SIZE 206,50 PIXEL
oGet:SetPos(0,0)
@ 122,2 BUTTON oBtn3 PROMPT BTN_View SIZE 80,10 ;
ACTION WAITRUN("NOTEPAD ERROR.LOG");
PIXEL
@ 122,85 BUTTON oBtn4 PROMPT BTN_Retry SIZE 50,10 ;
ACTION (lRet := .t., oDlg:End() ) ;
PIXEL
@ 122,138 BUTTON oBtn5 PROMPT BTN_Default SIZE 50,10;
ACTION (lRet := .f., oDlg:End() );
PIXEL
@ 136,2 BUTTON oBtn1 PROMPT BTN_Send1 OF oDlg SIZE 80,10 ;
ACTION (CursorWait (),;
SendEmail(BTN_Send2, cErrorlog,, oDlg, sysERRORSDIR+cImgFile ),;
CursorArrow (),;
oDlg:oMsgbar:cMsgDef := BTN_Send3, oDlg:oMsgbar:Refresh() ) ;
PIXEL
// CheckPop3(cPop3Host, cUser, cPass, bDone, oWnd ) PIXEL
// {|o| If( SubStr( o:cStatus, 1, 3 ) == "+OK",MsgInfo("OK"),MsgInfo("Fehler") )},oWnd );
@ 136,85 BUTTON oBtn2 PROMPT BTN_End OF oDlg SIZE 80,10 ;
ACTION oDlg:End() DEFAULT PIXEL
@ 136,168 BUTTON BTN_Help OF oDlg SIZE 30,10 PIXEL ACTION MsgInfo (BTN_Help)
//IF !e:CanRetry; oBtn4:Disable (); ENDIF
//IF !e:CanDefault; oBtn5:Disable (); ENDIF
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oDlg:oMsgBar := TMsgBar():New(oDlg, BTN_Header,.F.,.F.,.F.,.F.,,,,),;
iif(e:CanRetry,oBtn4:Enable(),oBtn4:Disable()),;
iif(e:CanDefault,oBtn5:Enable(),oBtn5:Disable()) );
ON PAINT (oBtn2:Setfocus(), Degrade (oDlg:hDC, {1,1,57,422},COLOR_ALERT[2],COLOR_ALERT[1] ) );
VALID (oFont:End(), oFont1:End(),.t.)
/* CERRAR MDICHILD FICHEROS Y RECURSOS Y SALIR */
// if TYPE( "oMainWnd" ) = "O"
// oWnd:CLOSEALL()
// endif
if alias() = 'ERRORS'
use
endif
dbselectarea( nArea )
if lRet == nil .or. ( !LWRunning() .and. lRet )
// DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
return lRet
//-------------------------------------------------------------------------------
static function SendEmail (cSubject, cBody, cMsg, oWnd, cImgFile)
LOCAL oInit, oMail, aSet, i, lOk := .f.
LOCAL lReceipt := .f.
LOCAL lAuth := .f.
LOCAL cFrom
LOCAL aAttach
DEFAULT cMsg := nil //HTML Email
aSet := ReadIni ()
cFrom := TRIM (aSet[E_USER])+" <"+TRIM (aSet[E_FROM])+">"
FOR i := 1 TO Len (aSet)
lOk := !Empty (aSet[i])
//? aSet[i]
NEXT
IF ! lOk
MsgAlert ( emailALERT1, emailALERT2)
RETURN (nil)
ENDIF
FErase ("Smtp.log") // delete old logfile
if file( cImgFile )
aAttach := { "error.log", cImgFile }
else
aAttach := { "error.log" }
endif
oInit := TSmtp():New( aSet [E_SMTP] )
oMail := TSmtp():New( aSet [E_SMTP], , lAuth, aSet [E_LOGIN], aSet [E_PASS] ) // [jlalin], IBTC
oMail:cReplyTo := aSet[E_FROM] //aSet [E_REPLYTO] //cReplyTo
oMail:nGMT := 1 // 8 = Pacific Standard Time (GMT -08:00) - Adjust this to your own Time Zone!
oMail:lTxtAsAttach := .F. // uncomment to force txt, log and htm files as inline as opposed to attachement
oMail:nDelay := 2
oMail:oSocket:lDebug := .T. // uncomment to create log file
oMail:oSocket:cLogFile := "smtp.log"
oMail:bConnecting := {||MsgRun( emailCONNECTING1 + aSet [E_SMTP] + " (" + oMail:cIPServer + ") "+emailCONNECTING2) }
oMail:bConnected := {||MsgRun ( emailCONNECTED ) }
oMail:SendMail( ;
cFrom, ; // from/de
{ aSet[E_TO] }, ; // to/para (arreglo) - I use cSender here also because it's an "autotest". Actually you would type a different address here
cBody,; // Body/Mensaje
cSubject,; // Subject/Asunto
aAttach, ; // Array of filenames to attach/Arreglo de nombres de archivos a agregar
{ }, ; // aCC
{ }, ; // aBCC
lReceipt, ; // Return Receipt/acuse de recibo
cMsg ) // msg in HTML format/mensaje en HTML
oInit:end()
return (nil)
// ---------------------------------------------------------------------------------- //
Static Function CheckPop3( cPOP3Host, cUser, cPass, bxDone, oWnd )
LOCAL lRet
LOCAL oInit, oPop
LOCAL bDone := {|o| IIF ( SubStr( o:cStatus, 1, 3 ) == "+OK", MsgInfo("OK"),MsgInfo ("Fehler")) }
// initialize sockets (or nothing will happen) - it's a quirk in GetHostByName(), not TSmtp
oInit := TSmtp():New( cPOP3Host )
oPop := TPOP3():New( cPOP3Host, , cUser, cPass )
oPop:bConnecting := {||MsgRun( emailCONNECTING1 + cPop3Host + " (" + oPop:cIPServer + ") "+emailCONNECTING2) }
oPop:bConnected := {||MsgRun ( emailCONNECTEDPOP ) }
oPop:bDone := {|o|MsgInfo (o:cStatus)}
oPop:oSocket:lDebug := .T. // uncomment to create log file
oPop:oSocket:cLogFile := "pop3.log"
oPop:GetMail( .T. ) // nur prüfen, ob Pop-server erreichbar ist
oInit:end()
Return (lRet)
//----------------------------------------------------------------------------//
static function DoBreak()
BREAK
return nil
//----------------------------------------------------------------------------//
static func ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Warning " ),;
"(DOS Error " + NTRIM(e:osCode) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C",;
e:SubSystem() ,;
"???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N",;
"/" + NTRIM( e:SubCode ) ,;
"/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
// returns extended info for a certain variable type
STATIC FUNCTION cGetInfo( uVal )
local cType := ValType( uVal )
do case
case cType == "C"
return '"' + cValToChar( uVal ) + '"'
case cType == "O"
return "Class: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
/*********************************************************
* PARA VISUALIZAR LOS ERRORES GRABADOS EN ERRORSYS
**********************************************************/
FUNCTION ViewErrors ()
LOCAL oFONT,oDLG, oSay, oGet, oBtn1, oBtn2, oBtn3
LOCAL cError := ""
if !FILE(sysERRORSDIR+"ERRORS.DBF")
MSGWAIT(viewALERT1,viewALERT2)
RETURN NIL
endif
USE ( sysERRORSDIR+"ERRORS.DBF" ) ALIAS "ERRORS" SHARED
RLOCK()
cError := viewERROR1+" : "+DTOC(ERRORS->Date)+viewERROR2+ERRORS->Time+CRLF+;
viewERROR3+" : "+ERRORS->Descript+CRLF+;
viewERROR4+" : "+trim(ERRORS->User)+'/'+ERRORS->Comp+CRLF+;
viewERROR5+" : "+Errors->Picture
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10
DEFINE DIALOG oDlg SIZE 450, 350 TITLE viewERRORTitle FONT oFont TRANSPARENT
@ 4, 1 SAY oSay PROMPT viewERROR1+" : "+DTOC(ERRORS->Date)+viewERROR2+ERRORS->Time+CRLF+;
viewERROR3+" : "+ERRORS->Error+CRLF+;
viewERROR4+" : "+trim(ERRORS->User)+'/'+ERRORS->Comp+CRLF+;
viewERROR5+" : "+Errors->Picture OF oDlg FONT oFont SIZE 230, 35 ;
PIXEL UPDATE COLOR COLOR_TEXT, COLOR_BAR[2]
@ 37 ,1 GET oGET VAR ERRORS->Descript OF oDLG MULTILINE READONLY SIZE 225, 112 PIXEL UPDATE
@ 157, 5 BUTTON oBTN1 PROMPT " |< " SIZE 20,12 PIXEL OF oDLG ACTION ( DBGOTOP(),RLOCK(),oDLG:UPDATE(),oDlg:Refresh() )
@ 157, 27 BUTTON oBTN1 PROMPT " < " SIZE 20,12 PIXEL OF oDLG ACTION ( DBSKIP(-1),IF(BOF(),(MSGINFO("Beginning of File"),DBSKIP(1)),(RLOCK(),oDLG:UPDATE(),oDlg:Refresh())) )
@ 157, 49 BUTTON oBTN1 PROMPT " > " SIZE 20,12 PIXEL OF oDLG ACTION ( DBSKIP(1),IF(EOF(),(MSGINFO("End of File"),DBSKIP(-1)),(RLOCK(),oDLG:UPDATE(),oDlg:Refresh())) )
@ 157, 71 BUTTON oBTN1 PROMPT " >| " SIZE 20,12 PIXEL OF oDLG ACTION ( DBGOBOTTOM(),RLOCK(),oDLG:UPDATE(),oDlg:Refresh() )
@ 157, 97 BUTTON oBTN1 PROMPT viewBTNImg SIZE 38,12 PIXEL OF oDLG ACTION ShowErrPic(oDlg) WHEN !Empty(Errors->Picture)
@ 157, 137 BUTTON oBTN2 PROMPT viewBTNPrint SIZE 38,12 PIXEL OF oDLG ACTION PRINTERRORS()
@ 157, 182 BUTTON oBTN3 PROMPT viewBTNClose SIZE 38,12 PIXEL OF oDLG ACTION oDlg:End() DEFAULT
ACTIVATE DIALOG oDlg CENTERED ;
ON PAINT Degrade (oDlg:hDC, {0,1,72,451}, COLOR_BAR[2],COLOR_BAR[1] )
oFont:End()
ERRORS->(DBCLOSEAREA())
RETURN NIL
//---------------------------------------------------------------------
FUNCTION PrintErrors() //IMPRESION DE ERRORES
LOCAL oPRN,oFONT, cError, nLin, nLinea
PRINTER oPRN PREVIEW
DEFINE FONT oFont NAME "COURIER NEW" SIZE 0,-10 OF oPrn
PAGE
cERROR:=ERRORS->Descript
nLIN:=1
FOR nLINEA=1 TO MLCOUNT(cERROR,100)
CURSORWAIT()
oPrn:CmSay(nLIN:=nLIN+.4, 1.5, MEMOLINE(cERROR,100,nLINEA),oFONT)
if nLIN>25
nLIN=1
ENDPAGE
PAGE
endif
NEXT
ENDPAGE
ENDPRINT
oFont:End()
RETURN NIL
//---------------------------------------------------------------------
FUNCTION ShowErrPic()
LOCAL oDlg, oSay, oImage, nPos, cImgFile
// Leemos las coordenadas de la pantalla actual y definimos la resolucion (WP)
local oWnd := WndMain()
local aCoord := GetWndRect( oWnd:hWnd ), WWidth, WHeight, nFactor
LOCAL aPoint1 := {aCoord[1], aCoord[2]}, aPoint2 := {aCoord[3], aCoord[4]}
LOCAL nHeight, nWidth, aImgSize := {}
// LOCAL aT := AClone (aCoord)
ClientToScreen( oWnd:hWnd, @aPoint1 ) // convert both point coordinates
ClientToScreen( oWnd:hWnd, @aPoint2 )
WWidth := aPoint2[2] - aPoint1[2] - 65 // Breite
WHeight := aPoint2[1] - aPoint1[1] - 65 // Höhe
// ? aT[1],aT[2],aT[3],aT[4],"-----",aPoint1[1], aPoint1[2],aPoint2[1],aPoint2[2]
nPos := FieldPos ("Picture")
cImgFile := FieldGet( nPos )
cImgFile := IIF( !Empty(cImgFile), sysERRORSDIR + cImgFile, "" )
if FILE (cImgFile)
aImgSize := FISize (cImgFile)
//aImgSize := {WWidth,WHeight}
nFactor := Max ((WWidth-27)/aImgSize[1],(WHeight)/aImgSize[2])
nWidth := nFactor * aImgSize[1]
nHeight := nFactor * aImgSize[2]
// ? WWidth, WHeight,"----",aImgSize[1],aImgSize[2],"---",nWidth,nHeight
DEFINE DIALOG oDlg TITLE showPICTitle PIXEL SIZE WWidth,WHeight of oWnd//TRANSPARENT
@ 3,1 SAY oSay PROMPT CRLF+Alltrim(ERRORS->Error) OF oDlg SIZE WWidth*1.1, 27 ;
COLOR COLOR_TEXT, COLOR_BAR[1] PIXEL
// if !Empty( cImgFile )
@ 28,0 IMAGE oImage FILE cImgFile PIXEL OF oDlg;
SIZE nWidth,nHeight
// endif
ACTIVATE DIALOG oDlg CENTER //;
// ON PAINT Degrade (oDlg:hDC, {0,0,Abs(WHeight-nHeight),WWidth*1.1}, COLOR_BAR[2],COLOR_BAR[1] )
else
MSGINFO(showPICERROR1,showPICERROR2)
endif
// Clipper 5.2
if File( "ERRTMP.JPG" )
DELETE FILE ERRTMP.JPG
endif
RETURN NIL
// Returns an array with the names of all the active Tasks running in Windows
//----------------------------------------------------------------------------//
/*function GetTasks()
local hWnd := GetWindow( GetActiveWindow(), GHW_HWNDFIRST )
local aTasks := {}
local cTask,oLdGetTasks:=.T.,hLib32:=0,RetByte:=0,BufTask
// Verify if the API exist if not it's Windows 95 or Less
// or Windows NT with SP2 or less so we will use the old technique
if ABS(hLib32:=Loadlib32("USER32.DLL")) > 32 // Can be Windows 3.11 or Lower
if substr(Getproc32(hLib32,"GetWindowModuleFileNameA",.T.,LONG,),1,4)<> CHR(0)+CHR(0)+CHR(0)+CHR(0)
oLdGetTasks:=.f.
BufTask:=space(200)
endif
Freelib32(hLib32)
endif
while hWnd != 0
if oLdGetTasks
#ifdef __CLIPPER__
cTask = GetModuleFileName( GetWindowWord( hWnd, GWW_HINSTANCE ) )
#else
// cTask = GetModuleFileName( GetWindowLong( hWnd, GWW_HINSTANCE ) )
cTask = GetWindowText( hWnd ) // The above does now work :-(
#endif
else
Retbyte:=GetWModFileName( hWnd, BufTask, 200 )
cTask:=left(BufTask,Retbyte)
endif
if ! Empty(cTask)
if AScan( aTasks, cTask ) == 0
AAdd( aTasks, cTask )
endif
endif
hWnd = GetWindow( hWnd, GHW_HWNDNEXT )
end
return aTasks
//----------------------------------------------------------------------------//
DLL32 FUNCTION GetWModFileName( hWnd AS LONG, cBuf AS LPSTR, nLong AS LONG ) ;
AS LONG PASCAL FROM "GetWindowModuleFileNameA" LIB "USER32.DLL"
*/
//--------------------------------------------------------------------
// Reemplazo a SalvaraBMP
// Original de Williams Pacheco 2003 + Bingen 2003
//--------------------------------------------------------------------
function SaveBmp( hDib, cBmpFile, cFormat )
LOCAL acFormat := {"png","gif","jpg","tiff"}, anFormat := {13,25,2,18}
LOCAL nFormat := anFormat[AScan(acFormat,Lower(cFormat))]
local cRetVal := sysERRORSDIR + cBmpFile + ".BMP"
LOCAL cDestImg := sysERRORSDIR + cBmpFile + "."+cFormat
LOCAL lOk := .f.
CURSORWAIT()
DibWrite( cRetVal, hDib )
IF UPPER(cFormat) <> "BMP"
// lOk := FISaveImg(cRetval, cDestImg, nFormat)
lOk := FIConvertImageFile( cRetval, cDestImg, nFormat, 0 )
FErase (cRetVal)
cRetVal := IIF (lOk, cDestImg, "")
ENDIF
// IF UPPER(cFormat) = "JPG" .and. File( "NCONVERT.EXE" )
// WaitRun( "nconvert -out jpeg " + " -D " + ".\ERRORS\" + cBmpFile +".BMP" , 0 )
// ENDIF
CursorArrow()
//return IF(UPPER(cFormat) = "PNG",cFileName( STRTRAN(cRetVal,".BMP",".PNG" )),cFileName( cRetVal ))
RETURN (cFileName (cRetVal))
//------------------------------------------------------------------
STATIC FUNCTION ReadIni ()
LOCAL oIni, aSet :=Array(10)
LOCAL cKey := emailKEY
INI oIni FILE E_INIFILE
GET aSet[E_USER] SECTION "Email" ENTRY "User" DEFAULT "" OF oIni
GET aSet[E_LOGIN] SECTION "Email" ENTRY "Login" DEFAULT "user@"+emailDOMAIN OF oIni
GET aSet[E_PASS] SECTION "Email" ENTRY "Pass" DEFAULT "" OF oIni
GET aSet[E_POP3] SECTION "Email" ENTRY "Pop-Host" DEFAULT "pop3."+emailDOMAIN OF oIni
GET aSet[E_SMTP] SECTION "Email" ENTRY "Smpt-Host" DEFAULT "smtp."+emailDOMAIN OF oIni
GET aSet[E_CONNECT] SECTION "Email" ENTRY "Leasedline" DEFAULT .F. OF oIni
GET aSet[E_SAVE] SECTION "Email" ENTRY "Autosave" DEFAULT .T. OF oIni
GET aSet[E_DELETE] SECTION "Email" ENTRY "Maildelete" DEFAULT .T. OF oIni
GET aSet[E_FROM] SECTION "Email" ENTRY "ReplyTo" DEFAULT "" OF oIni
GET aSet[E_TO] SECTION "Email" ENTRY "MailTo" DEFAULT emailADDRESS OF oIni
// GET aSet[E_] SECTION "Email" ENTRY "Leasedline" DEFAULT .F. OF oIni
ENDINI
if empty( aSet[E_USER] )
aSet[E_USER] := gete("WHOLE_NAME")
endif
if empty( aSet[E_FROM] )
aSet[E_FROM] := gete("USERNAME")+"@"+emailDOMAIN
endif
aSet[E_PASS] := Crypt(aSet[E_PASS],cKey)
RETURN (aSet)
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
function GetCPU()
local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
"HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
.f. )
local cCpu := oReg:Get( "ProcessorNameString" )
oReg:Close()
return cCpu
//-----------------------------------------------------------------//
STATIC FUNCTION Degrade ( hDC, aRect, nColor, nColorTo )
//LOCAL aRect := GETCLIENTRECT( oWnd:hWnd )
LOCAL nStep , nStepY /// 256
LOCAL oBrush
LOCAL i, r,g,b
LOCAL r0,g0,b0
LOCAL r1, g1, b1
LOCAL rD, gD, bD
DEFAULT nColorTo := nRGB (250,250,250)
//nColor := nRGB (255,0,0)
nStep := ( aRect[ 3 ] - aRect[ 1 ] )
nStepY := ( aRect[ 3 ] - aRect[ 1 ] ) / nStep
aRect[ 3 ] = aRect[ 1 ] + nStepY
r0 := nRGBRed (nColor)
g0 := nRGBGreen (nColor)
b0 := nRGBBlue (nColor)
r1 := nRGBRed (nColorTo)
g1 := nRGBGreen (nColorTo)
b1 := nRGBBlue (nColorTo)
rD := r1-r0
gD := g1-g0
bD := b1-b0
r := 256*rD/Max(nStep,1)
g := 256*gD/Max(nStep,1)
b := 256*bD/Max(nStep,1)
r0*=256
g0*=256
b0*=256
// ? R + G*256 + B*256*256, nColor
// ? rD, gD, bD, "---",r, g, b
FOR i = 0 TO nStep-1 STEP nStepY
r0 += r
g0 += g
b0 += b
DEFINE BRUSH oBrush COLOR nRGB( r0/256, g0/256, b0/256 )
FILLRECT( hDC, aRect, oBrush:hBrush )
RELEASE BRUSH oBrush
// ? r0/256, g0/256,b0/256, nRGB( r0/256, g0/256, b0/256 ),aRect[1], aRect[3]
aRect[ 1 ] += nStepY
aRect[ 3 ] += nStepY
NEXT
RETURN (nil)
// If image.prg does not have this function then you can uncomment the code below
/*
function fisize( cImgFile )
local oBmp, aReturn
if file( cImgFile )
DEFINE IMAGE oBMP FILENAME cImgFile
aReturn := {oBMP:nWidth(), oBMP:nHeight()}
else
aReturn := {0,0}
endif
oBMP
return( aReturn )
*/
Re: Errsysw Visual Update ?
Gale
Very interesting your ErrSysW. I have a couple of concerns:
1) Could give more details on setting up to send email.
2) Could update the code to the latest version of FWH ErrSysW.prg.
Saludos
Fernando Espinoza
Very interesting your ErrSysW. I have a couple of concerns:
1) Could give more details on setting up to send email.
2) Could update the code to the latest version of FWH ErrSysW.prg.
Saludos
Fernando Espinoza
Saludos
Fernando Espinoza
Fernando Espinoza
Re: Errsysw Visual Update ?
There are a couple of #defines in the ErrSysW.prg but usually you can just edit the email.ini that gets created the first time an error gets emailed.
In order to send the email you need a minimum of 4 things:
Login, Pass, Smtp-Host, and MailTo
Login = username to log into mail server.
Pass = password to use along with username
Smtp-Host = address of the Smtp mail server
MailTo = address you want to send the error email to
Because of security and other issues, you may have to provide more information.
Does you server require Pop before login to Smtp?
Can you relay through you server? If not then the Login may need to be the same as the ReplyTo (From).
This is the contents of my email.ini (with wrong password
)
[Email]
User=
Login=Web@wwrowland.com
Pass=mypassword
Pop-Host=mail.wwrowland.com
Smpt-Host=mail.wwrowland.com
Leasedline=.F.
Autosave=.T.
Maildelete=.T.
ReplyTo=
MailTo=help.desk@wwrowland.com
In order to send the email you need a minimum of 4 things:
Login, Pass, Smtp-Host, and MailTo
Login = username to log into mail server.
Pass = password to use along with username
Smtp-Host = address of the Smtp mail server
MailTo = address you want to send the error email to
Because of security and other issues, you may have to provide more information.
Does you server require Pop before login to Smtp?
Can you relay through you server? If not then the Login may need to be the same as the ReplyTo (From).
This is the contents of my email.ini (with wrong password
)[Email]
User=
Login=Web@wwrowland.com
Pass=mypassword
Pop-Host=mail.wwrowland.com
Smpt-Host=mail.wwrowland.com
Leasedline=.F.
Autosave=.T.
Maildelete=.T.
ReplyTo=
MailTo=help.desk@wwrowland.com
-
StefanHaupt
- Posts: 824
- Joined: Thu Oct 13, 2005 7:39 am
- Location: Germany
Re: Errsysw Visual Update ?
Antonio,
I have included the last changes from fwh1109, so it should be compatible now. May I publish the the missing functions I included from fwh 1109 ?
Here is a screenshot from the errordialog
You can view all errors ever occured from the database
I have included the last changes from fwh1109, so it should be compatible now. May I publish the the missing functions I included from fwh 1109 ?
Here is a screenshot from the errordialog
You can view all errors ever occured from the database
kind regards
Stefan
Stefan
-
StefanHaupt
- Posts: 824
- Joined: Thu Oct 13, 2005 7:39 am
- Location: Germany
Re: Errsysw Visual Update ?
BTW, I need some help to include more languages in this error handler. At the moment we have german and english.
I would be happy, if someone can translate it into spanish, portuguese and other languages
Thanks
I would be happy, if someone can translate it into spanish, portuguese and other languages
Code: Select all
#ifdef _ENGLISH
#define dlgPROG "Program: "
#define dlgTITLE "Application error"
#define errHEADER "Errordescription"
#define errDESC " Description : "
#define errPROGPATH " App-Path : "
#define errPROGSIZE " Filesize : "
#define errMAXFILES " Max. files : "
#define errTIME " Time from start: "
#define errOCCUR " Occurance : "
#define errNETNAME " Computername : "
#define errUSER " User : "
#define errDETAIL "detailled error description"
#define errSTACKLIST "Stack-List"
#define errSTACKCALL " called by "
#define errTASKS "running tasks: "
#define errVARLIST "Varlist"
#define errVARIABLE " Name Type Value"
#define errRDD "RDD"
#define errOPENDBF "Open dbf´s"
#define errINDEX "Index files "
#define errRELATION "Relations"
#define sysHEADER "Systeminformation"
#define sysWINDOWS
#define sysVERSION
#define dlgTEXT1 "Please contact your dealer or computer support department"+CRLF+;
"about this error and the circumstances it happened."+CRLF+CRLF+;
[Email error report by clicking "Send errorlog" button]
#define dlgTEXT2 "Error Description:"
#define BTN_Header "An Error Has Occurred"
#define BTN_View "View errorlog"
#define BTN_Retry "Retry"
#define BTN_Default "Default"
#define BTN_Send1 "Send errorlog"
#define BTN_Send2 "Errorlog"
#define BTN_Send3 "Errorlog sent"
#define BTN_End "do not send / end"
#define BTN_Help "Help"
#define emailDOMAIN "usersdomain.com"
#define emailADDRESS "help.desk@helpdomain.com"
#define emailKEY "3jfbt72"
#define emailALERT1 "Email settings are incorrect"
#define emailALERT2 "Email Settings"
#define emailCONNECTING1 "Connecting to "
#define emailCONNECTING2 "and waiting for response..."
#define emailCONNECTED "Sending Email..."
#define emailCONNECTEDPOP "Checking for email messages..."
#define viewALERT1 "The error log file is missing"
#define viewALERT2 "error Log"
#define viewERRORTitle "View Error Logs"
#define viewERROR1 "Date of the error "
#define viewERROR2 " time "
#define viewERROR3 "Error description "
#define viewERROR4 "User/PC "
#define viewERROR5 "Error Image "
#define viewBTNImg "View Image"
#define viewBTNPrint "Print"
#define viewBTNClose "Close"
#define showPICTitle "Graphic Error"
#define showPICERROR1 "No Graphics Available"
#define showPICERROR2 "Graphic Error"
#endif
#ifdef _SPANISH
#endif
#ifdef _PORTUG
#endif
#ifdef _ITALIAN
#endif
kind regards
Stefan
Stefan