FiveTech Software tech support forums

by **yeangpumpeng** » Tue Oct 18, 2011 7:43 am

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

by **Antonio Linares** » Tue Oct 18, 2011 9:37 am

Yeang,

Thanks for your feedback,

What visual changes would you propose ?

by **yeangpumpeng** » Tue Oct 18, 2011 11:11 am

http://www.everythingaccess.com/vbwatch ... ction2.jpg

http://www.everythingaccess.com/vbwatch ... nError.gif

as idea

by **Otto** » Tue Oct 18, 2011 11:48 am

In my opinion “Ignore and continue” is very dangerous.
Best regards,
Otto

by **StefanHaupt** » Tue Oct 18, 2011 1:25 pm

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.

Code: Select all Expand view: // 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)

and a sample

Code: Select all Expand view: #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)

by **Gale FORd** » Tue Oct 18, 2011 1:55 pm

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

by **StefanHaupt** » Tue Oct 18, 2011 3:20 pm

Gale,

I used a modified image.prg. here it is

Code: Select all Expand view: // 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" //----------------------------------------------------------------------------//

by **Gale FORd** » Tue Oct 18, 2011 7:27 pm

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.

by **yeangpumpeng** » Wed Oct 19, 2011 7:49 am

want to post a screenshot ?

by **StefanHaupt** » Wed Oct 19, 2011 11:17 am

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.

by **Gale FORd** » Wed Oct 19, 2011 4:42 pm

Here is my modified ErrSysW.prg

Code: Select all Expand view: // 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 ) */

by **fespinoza** » Thu Oct 20, 2011 2:36 pm

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

by **Gale FORd** » Thu Oct 20, 2011 10:12 pm

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

by **StefanHaupt** » Fri Oct 21, 2011 9:56 am

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

by **StefanHaupt** » Fri Oct 21, 2011 10:04 am

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

Code: Select all Expand view: #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

Thanks

FiveTech Software tech support forums

Errsysw Visual Update ?

Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Re: Errsysw Visual Update ?

Who is online