Clipper On Line • Ver Tópico - A tela da ErrorSys assusta? então use esta.

A tela da ErrorSys assusta? então use esta.

Discussão sobre a biblioteca Fivewin - O Clipper para Windows.

Moderador: Moderadores

 

A tela da ErrorSys assusta? então use esta.

Mensagempor rochinha » 16 Jul 2005 01:34

Amiguinhos

Fiz uma modificação na ErrorSys do Fivewin de forma a não apresentar aquela tela de erros padrão e sim uma tela com as caracteristicas da mensagem de erros do Internet Explorer 6 que pede para enviar um relatório e tudo mais.

Codigo .RC do Dialogo principal

dlgMSRel DIALOG 20, 28, 245, 138
STYLE 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME
CAPTION "Mensagem de Erro"
FONT 8, "MS Sans Serif"
{
CONTROL "", 100, "static", SS_WHITERECT | WS_CHILD | WS_VISIBLE, -8, -1, 261, 30
ICON "icon_info", -1, 4, 3, 18, 20
LTEXT "Evento de detecção de erros", 99, 28, 3, 224, 24
PUSHBUTTON "&Enviar relatório de erros", 1, 4, 121, 114, 14, NOT WS_TABSTOP
DEFPUSHBUTTON "&Não enviar", 2, 120, 121, 52, 14, BS_DEFPUSHBUTTON | NOT WS_TABSTOP
CONTROL "", -1, "BorShade", BSS_HDIP | BSS_LEFT | WS_CHILD | WS_VISIBLE, -3, 29, 254, 5
LTEXT "O programa não responde.", -1, 4, 35, 247, 9
LTEXT "Informe este problema à Empresa X.", -1, 5, 52, 247, 9
LTEXT "Foi criado um relatório detalhando o erro ocorrido que voce pode nos enviar para ajudar a melhorar o meu sistema. Esse relatório será considerado confidencial e anônimo.", -1, 5, 66, 241, 29
LTEXT "Para visualizar os dados contidos neste relatório de erros.", -1, 5, 99, 181, 9
PUSHBUTTON "Clique aqui.", 3, 188, 96, 43, 14
CONTROL "", -1, "BorShade", BSS_HDIP | BSS_LEFT | WS_CHILD | WS_VISIBLE, 3, 116, 240, 3
PUSHBUTTON "&Denovo", 4, 173, 121, 34, 14, WS_DISABLED | WS_TABSTOP
PUSHBUTTON "&Padrão", 5, 209, 121, 34, 14, WS_DISABLED | WS_TABSTOP
}



Codigo da ErrorSys completo.

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

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

external _fwGenError   // Link FiveWin generic Error Objects Generator

#define NTRIM(n)    ( LTrim( Str( n ) ) )

/*************
*       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, oLbx, oFont
    local lRet    // if lRet == nil -> default action: QUIT
    local n, j, cMessage, aStack := {}
    local oSay, hLogo
    local nButtons  := 1
    local cErrorLog := ""
    local aVersions := {}
    local aTasks    := {}
    local aRDDs, nTarget, uValue
    local oOldError
    local cRelation
    local lIsWinNT := .f.
    local oSystemInfo
    local oWnd     := WndMain()
    local hBmp, hDib, cImgFile
    local aScreens:=array(0), nScreens:=30        //Hasta 30 pantallas guardadas

    // Definimos cUser por si acaso el sistema no maneja este valor  (WP)
    cUser := if( Type( "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

    aTasks    := GetTasks()
    lIsWinNT  := IsWinNT()
    aVersions := GetVersion()

    /* DESCRIPCIÓN DEL ERROR */
    cErrorLog += "Dados do erro causado pela aplicacao" + CRLF
    cErrorLog += oWnd:cTITLE + CRLF
    cErrorLog += "-----------------------------------------" + CRLF
    cErrorLog += "   Caminho      : " + GetModuleFileName( GetInstance() ) + CRLF
    cErrorLog += "   Tamanho      : " + Transform( FSize( GetModuleFileName( GetInstance() ) ), "9,999,999 bytes" ) + CRLF
    cErrorLog += "   Max files    : " + Str( SetHandleCount(), 3 ) + CRLF
    cErrorLog += "   Data e Hora  : " + DToC( Date() ) + ", " + Time() + CRLF
    cErrorLog += "   Estacao      : " + NETNAME() + CRLF+ CRLF

    // Error object analysis
    cMessage   = "Descricao do erro produzido" + CRLF+;
                 "-------------------------------" + CRLF+;
                 "   "+ErrorMessage( e ) + CRLF

    cErrorLog += cMessage

    if ValType( e:Args ) == "A"
        cErrorLog += "   Argumentos   :" + CRLF
        for n = 1 to Len( e:Args )
            cErrorLog += "     [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
                         "   " + cValToChar( e:Args[ n ] ) + CRLF
        next
    endif

    cErrorLog += CRLF + "Chamadas ao Stack" + CRLF
    cErrorLog +=        "-----------------" + CRLF

    n := 2    // we don't disscard any info again !
    while ( n < 74 )
        if ! Empty(ProcName( n ) )
            AAdd( aStack, "   Called from " + Trim( ProcName( n ) ) + ;
                          "(" + NTRIM( ProcLine( n ) ) + ")" )
            cErrorLog += ATail( aStack ) + CRLF
        endif
        n++
    end

    oSystemInfo:=TSystemInfo():New()

    cErrorLog+=CRLF+ "Informacao do sistema."
    cErrorLog+=CRLF+ "------------------------"
    cErrorLog+=CRLF+ "   Versao do Windows = " + oSystemInfo:WinVer()
    cErrorLog+=CRLF+ "   Numero da versao  = " + oSystemInfo:VerNum()
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "Processador do sistema."
    cErrorLog+=CRLF+ "-----------------------"
    cErrorLog+=CRLF+ "   "+oSystemInfo:CPUVendor()+ "   "+oSystemInfo:CPUIdentifier()
    cErrorLog+=CRLF+ "   Tipo "+oSystemInfo:CPU()+" o Superior"
    cErrorLog+=CRLF+ "   Velocidade " + IF(oSystemInfo:SpeedCPU()>0,LTrim(Str(oSystemInfo:SpeedCPU()))+" MHz","No determinada")
    if oSystemInfo:IsDualCPU()
        cErrorLog+=CRLF+ "   Placa Base Multiprocesador "
    endif
    cErrorLog+=CRLF+ "   BIOS "+oSystemInfo:NameSystemBios()+"  "+oSystemInfo:DateSystemBios()
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "Informacao da Memoria"
    cErrorLog+=CRLF+ "-------------------------"
    cErrorLog+=CRLF+ "   Memoria RAM          :"+LTrim(Str(oSystemInfo:Memory(1),6,0))+" MB"+;
                     "   Disponivel           : "+LTrim(Str(oSystemInfo:Memory(2),6,0))+" MB"
    cErrorLog+=CRLF+ "   Memoria Virtual      : "+ LTrim(Str(oSystemInfo:Memory(5),6,0))+" MB"+;
                     "   Disponivel           : "+LTrim(Str(oSystemInfo:Memory(6),6,0))+" MB"
    cErrorLog+=CRLF+ "   Paginacao de arquivos: " + LTrim(Str(oSystemInfo:Memory(3),6,0))+" MB"+;
                     "   Disponivel           :"+LTrim(Str(oSystemInfo:Memory(4),6,0))+" MB"
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "   Memoria estatica:"
    cErrorLog+=CRLF+ "      Segmento de dados :   64k"
    cErrorLog+=CRLF+ "      Tamanho inicial   :  " + LTrim( Str( nInitDSSize() ) ) + ;
                            " bytes  (SYMP=" + LTrim( Str( nSymPSize() ) ) + ;
                            ", Stack=" + LTrim( Str( nStackSize() ) ) + ;
                            ", Heap=" + LTrim( Str( nHeapSize() ) ) + ")"
    cErrorLog+=CRLF+ "      Stack do Programa :  " + LTrim( Str( 65535 - ( nStatics() * 14 ) - nInitDSSize() ) ) + " bytes"
    cErrorLog+=CRLF+ "      " + LTrim( Str( nStatics() ) ) + " Variables estáticas : " +LTrim( Str( nStatics() * 14 ) ) + " bytes"
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "   Consumo de memoria dinámica:"
    cErrorLog+=CRLF+ "      Valor atual       : " + Str( MemUsed() ) + " bytes"
    cErrorLog+=CRLF+ "      Maior possivel    : " + Str( MemMax() ) + " bytes"
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "   Recursos do Sistema " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) +" %"+ ;
                     "   GDI " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) +" %"+;
                     "   Usuario " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) +" %"
    cErrorLog+=CRLF
    cErrorLog+=CRLF+ "Total de aplicacoes Windows em ejecucao: " + Str( GetNumTasks(), 3 )
    cErrorLog+=CRLF+ "--------------------------------------------------"
    cErrorLog+=CRLF

    for n = 1 to Len( aTasks )
        cErrorLog += "    " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
    next

    if ProcName( 7 ) == "ERRORDIALO"   // recursive error !!!
       SET RESOURCES TO
       ErrorLevel( 1 )
       QUIT              // must be QUIT !!!
    endif

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

    cErrorLog += CRLF + "Variables em uso" + CRLF + ;
                        "----------------" + CRLF
    cErrorLog += "   Procedure     Tipo   Valor" + CRLF
    cErrorLog += "   ==========================" + CRLF

    n := 2    // we don't disscard any info again !
    while ( n < 74 )

        if ! Empty( ProcName( n ) ) .AND. ProcName( n )<>"ERRORDIALO"
            cErrorLog += "   " + Trim( ProcName( n ) ) + CRLF
            for j = 1 to ParamCount( n )
                cErrorLog += "     Param " + Str( j, 3 ) + ":    " + ;
                             ValType( GetParam( n, j ) ) + ;
                             "    " + cGetInfo( GetParam( n, j ) ) + CRLF
            next
            for j = 1 to LocalCount( n )
                cErrorLog += "     Local " + Str( j, 3 ) + ":    " + ;
                             ValType( GetLocal( n, j ) ) + ;
                             "    " + cGetInfo( GetLocal( n, j ) ) + CRLF
            next
        endif

        n++
    end

    cErrorLog += CRLF + "RDDs Linkados" + CRLF + ;
                        "-------------" + CRLF
    aRDDs = RddList( 1 )
    for n = 1 to Len( aRDDs )
       cErrorLog += "   " + aRDDs[ n ] + CRLF
    next

    cErrorLog += CRLF + "DataBases em uso" + CRLF + ;
                        "----------------" + 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
          cErrorLog += "     Indices em uso " + 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 + "     Relaciones em uso" + CRLF+;
                              "     ================="
          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
    next

    n = 1
    cErrorLog += CRLF + "Clases em uso" + CRLF
    cErrorLog +=        "-------------" + CRLF
    while ! Empty( __ClassNam( n ) )
       cErrorLog += "   " + Str( n, 3 ) + " " + __ClassNam( n++ ) + CRLF
    end

    /* GRABAR FICHERO DEL ERROR*/
    MemoWrit( "Error.log", cErrorLog )

    /* PANTALLA DE CONTROL DEL ERROR */
    DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10

    DEFINE DIALOG oDlg RESOURCE "dlgMSRel"
    REDEFINE SAY oSay VAR "O seguinte erro foi encontrado:"+CRLF+ErrorMessage( e ) ID  99 OF oDlg COLOR RGB(000,000,000),RGB(255,255,255)
    REDEFINE SAY oSay ID 100 OF oDlg COLOR RGB(255,255,255),RGB(000,000,000)

    REDEFINE BUTTON oBtn1 ID 1 OF oDlg ACTION (;
       CheckPop3( 'pop.sao.terra.com.br', 'jscrocha', 'claudete',;
                 { |o| If( SubStr( o:cStatus, 1, 3 ) == "+OK",;
                           SendEmailRel( cEmail, cMensagem, cHost, cReplyTo, cSubject, cMsg, lReceipt, lAuth, cUser, cPass, lPop3, cPOP3Host ), MsgStop( "Login POP3 falhou." ) ) } ), oDlg:End())
    REDEFINE BUTTON oBtn2 ID 2 OF oDlg ACTION oDlg:End()
    REDEFINE BUTTON oBtn3 ID 3 OF oDlg ACTION WAITRUN("NOTEPAD ERROR.LOG") NOBORDER
    REDEFINE BUTTON oBtn4 ID 4 OF oDlg ACTION ( lRet  := .t., oDlg:End() ) // Retry
    REDEFINE BUTTON oBtn5 ID 5 OF oDlg ACTION ( lRet  := .f., oDlg:End() ) // Default

    ACTIVATE DIALOG oDlg CENTERED ON INIT ( iif(e:CanRetry,oBtn4:Enable(),oBtn4:Disable()), iif(e:CanDefault,oBtn4:Enable(),oBtn4:Disable()) )

    /*
    DEFINE DIALOG oDlg ;
       SIZE 300, 260 + If( lIsWinNT, 50, 0 ) ;
       TITLE "Control de errores del programa" ;
       FONT oFont

    @ 0, 0 SAY oSay PROMPT  "O seguinte erro foi encontrado:"+CRLF+ErrorMessage( e )  ;
       CENTERED OF oDlg FONT oFont SIZE 149, 45

    oSay:nStyle   = nOR( oSay:nStyle, 128 )   // SS_NOPREFIX
    oSay:nTop     =   3
    oSay:nLeft    =  22
    oSay:nBottom  =  25
    oSay:nRight   = 148

    @ 34,  6 SAY "&Lista do Stack" OF oDlg FONT oFont PIXEL
    @ 34, 90 SAY "Veja no arquivo Error.log" OF oDlg FONT oFont PIXEL

    n = aStack[ 1 ]

    @ 43, 3 LISTBOX oLbx VAR n ITEMS aStack OF oDlg ;
       SIZE 145, 60 + If( lIsWinNT, 18, 0 ) PIXEL

    if nButtons == 1 .or. nButtons == 3
       @ 100 + If( lIsWinNT, 24, 0 ), 60 BUTTON "&Sair" OF oDlg ACTION oDlg:End() ;
          SIZE 30, 12 PIXEL FONT oFont DEFAULT
    else
       @ 100 + If( lIsWinNT, 24, 0 ), 37 BUTTON "&Sair" OF oDlg ACTION oDlg:End() ;
          SIZE 30, 12 PIXEL FONT oFont
    endif

    if e:CanRetry
       @ 100 + If( lIsWinNT, 24, 0 ), If( nButtons == 2, 82, 13 ) BUTTON "&Denovo" ;
          OF oDlg ACTION ( lRet  := .t., oDlg:End() ) ;
          SIZE 30, 12 FONT oFont PIXEL
    endif

    if e:CanDefault
       @ 100 + If( lIsWinNT, 24, 0 ), 108 BUTTON "&Default"  OF oDlg ;
          ACTION ( lRet  := .f., oDlg:End() ) ;
          SIZE 30, 12 FONT oFont PIXEL
    endif

    @ 115 + If( lIsWinNT, 24, 0 ), 40 BUTTON "&Enviar Relatorio"  OF oDlg ;
        ACTION ( oDlg:End(),SendRel() ) ;
        SIZE 70, 12 FONT oFont PIXEL
    //@ 115 + If( lIsWinNT, 24, 0 ), 40 BUTTON "&Ver/Imprimir Error.log"  OF oDlg ;
    //    ACTION ( oDlg:End(),WAITRUN("NOTEPAD ERROR.LOG") ) ;
    //    SIZE 70, 12 FONT oFont PIXEL

    ACTIVATE DIALOG oDlg CENTERED ;
       ON PAINT DrawBitmap( hDC, hLogo, 6, 6 )

    DeleteObject( hLogo )
    */

    oFont:End()

    if lRet == nil .or. ( !LWRunning() .and. lRet )

    BEGIN SEQUENCE
        oOldError = ErrorBlock( { || DoBreak() } )

        /*  CONTROL PERSONALIZADO DE ERRORES */
        if !lIsDir( "ERRORES" )    //CREAR CARPETA DE ERRORES DEL PROGRAMA
         lMkDir( "ERRORES" )
        endif

        IF cUser <> "DPD"                //NO SE GRABAN SI SOMOS NOSOTROS

            IF !FILE("ERRORES\ERRORES.DBF")
                DbCreate("ERRORES\ERRORES.DBF",;
                          {{"Usuario","C",11,0},{"Fecha","D",8,0},;
                           {"Hora","C",8,0},{"Descripcio","C",76,0},;
                           {"Trazo","M",10,0},{"Pantalla","C",30,0} })
            ENDIF

            SET PRINTER OFF
            SET CONSOLE ON
            USE "ERRORES\ERRORES.DBF" SHARED
            APPEND BLANK
            REPLACE USUARIO    WITH NETNAME()
            REPLACE FECHA      WITH DATE()
            REPLACE HORA       WITH TIME()
            REPLACE DESCRIPCIO WITH STRTRAN(ErrorMessage( e ),CRLF," ")
            REPLACE TRAZO      WITH cERRORLOG

            // Funcion de reemplazo para guardar la imagen (WP)
            hBmp := WndBitmap( oWnd:hWnd )
            hDib := DibFromBitmap( hBmp )
            cImgFile := "ERR" + StrZero( RecNo(), 5 )

            //Borrar exceso de pantallas
            aScreens:=DIRECTORY("ERRORES\*.JPG")
            aScreens:=ASORT(aScreens,,, { |x, y| x[1] < y[1] })
            FOR nScreen:=1 TO LEN(aScreens)-nScreens
             DELETE FILE ("ERRORES\"+aScreens[nScreen,1])
            NEXT
            REPLACE PANTALLA WITH SalvarBmp( hDib, cImgFile, "JPG" )
            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 SendRel()
   local oDlg, oGet101, oGet102, cEmail:=SPACE(100), cMensagem:=SPACE(300), lSave := .f.
   SET _3DLOOK ON
   DEFINE DIALOG oDlg RESOURCE "ErrorSys"
   REDEFINE GET oGet101 VAR cEmail         ID 101 OF oDlg
   REDEFINE GET oGet102 VAR cMensagem MEMO ID 102 OF oDlg
   REDEFINE BUTTON oBtn1 ID 1 OF oDlg ACTION (;
      CheckPop3( 'pop.sao.terra.com.br', 'jscrocha', 'claudete',;
                 { |o| If( SubStr( o:cStatus, 1, 3 ) == "+OK",;
                           SendEmailRel( cEmail, cMensagem, cHost, cReplyTo, cSubject, cMsg, lReceipt, lAuth, cUser, cPass, lPop3, cPOP3Host ), MsgStop( "Login POP3 falhou." ) ) } ), oDlg:End())
   REDEFINE BUTTON oBtn2 ID 2 OF oDlg ACTION oDlg:End()
   REDEFINE BUTTON oBtn3 ID 3 OF oDlg ACTION WAITRUN("NOTEPAD ERROR.LOG") NOBORDER
   ACTIVATE DIALOG oDlg CENTERED
   return .t.

static function SendEmailRel( cSender, cBody, cHost, cReplyTo, cSubject, cMsg, lReceipt, lAuth, cUser, cPass, lPop3, cPOP3Host )
   LOCAL oInit
   DEFAULT cHost     := 'smtp.sao.terra.com.br'    ,;
           cPOP3Host := 'pop.sao.terra.com.br'     ,;
           cSender   := 'seulogin@terra.com.br'    ,;
           cReplyTo  := 'seulogin@terra.com.br'    ,;
           lReceipt  := .t.                        ,;
           lAuth     := .t.                        ,;
           lPop3     := .t.                        ,;
           cSubject  := '*** CONTROLE DE ERROS ***',;
           cMsg      := cBody                      ,;
           cUser     := 'seuUserName'                 ,;
           cPass     := 'suaSenha'
   oInit := TSmtp():New( cHost )
   oMail := TSmtp():New( cHost, , lAuth, cUser, cPass ) // [jlalin], IBTC
   oMail:cReplyTo         := cReplyTo
   oMail:nGMT             := 8   // 8 = Pacific Standard Time (GMT -08:00) - Adjust this to your own Time Zone!
   oMail:nDelay           := 1
   *oMail:lTxtAsAttach    := .F.         // uncomment to force txt, log and htm files as inline as opposed to attachement
   oMail:oSocket:lDebug   := .T.         // uncomment to create log file
   oMail:oSocket:cLogFile := "smtp.log"
   oMail:bConnecting      := {|| oWnd:SetMsg( "Conectando a " + cHost + " (" + oMail:cIPServer + ") a aguardando resposta..." ) }
   oMail:bConnected       := {|| oWnd:SetMsg( "Conectado e enviando email e anexos..." ) }
   oMail:SendMail( ;
      'seuUserName@terra.com.br', ;      // from/de
      { 'seuUserName@terra.com.br' }, ;  // to/para (arreglo) - I use cSender here also because it's an "autotest". Actually you would type a different address here
      cMsg,;                          // Body/Mensaje
      cSubject,;                      // Subject/Asunto
      { "error.log" }, ;              //  Array of filenames to attach/Arreglo de nombres de archivos a agregar
      { }, ;                          // aCC
      { cSender }, ;                  // aBCC
      lReceipt, ;                     // Return Receipt/acuse de recibo
      cBody )                          // msg in HTML format/mensaje en HTML
   oInit:end()
   Msgstop( "EMAIL enviado com sucesso!" )
   return nil

// ---------------------------------------------------------------------------------- //
Static Function CheckPop3( cPOP3Host, cUser, cPass, bDone )
   LOCAL oInit
   // 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 := {|| oWnd:SetMsg( "Connecting to " + cPOP3Host + " (" + oPop:cIPServer + ") and waiting for response..." ) }
   oPop:bConnected  := {|| oWnd:SetMsg( "Checking for email messages..." ) }
   oPop:bDone       := bDone
   oPop:oSocket:lDebug   := .T.         // uncomment to create log file
   oPop:oSocket:cLogFile := "pop3.log"
   oPop:GetMail( .T. )
   oInit:end()
   Return Nil

//----------------------------------------------------------------------------//
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 VIEWERRORES()

LOCAL oFONT,oDLG
    if !FILE("ERRORES\ERRORES.DBF")
     MSGWAIT("No se ha encontrado fichero de grabación de ERRORES","Sin errores")
     RETURN NIL
    endif

    USE "ERRORES\ERRORES.DBF" ALIAS "ERRORES" SHARED
    RLOCK()

    DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -10

    DEFINE DIALOG oDlg SIZE 450, 350 TITLE "Visualización de errores del programa" FONT oFont

    @ 1, 1 SAY oSay PROMPT  "DATOS DEL ERROR PRODUCIDO EL DÍA   "+DTOC(ERRORES->FECHA)+"   HORA   "+ERRORES->HORA+CRLF+CRLF+;
                            "Descripción del Error: "+ERRORES->DESCRIPCIO+CRLF+CRLF+;
                            "Desde el Usuario : "+ERRORES->USUARIO  OF oDlg FONT oFont SIZE 220, 50 PIXEL UPDATE

    @ 40 ,1 GET oGET VAR ERRORES->TRAZO OF oDLG MULTILINE READONLY SIZE 220, 100 PIXEL UPDATE

    @ 150, 10 BUTTON oBTN1 PROMPT "  |< " SIZE 20,15 PIXEL OF oDLG ACTION ( DBGOTOP(),RLOCK(),oDLG:UPDATE() )

    @ 150, 35 BUTTON oBTN1 PROMPT "  <  " SIZE 20,15 PIXEL OF oDLG ACTION ( DBSKIP(-1),IF(BOF(),(MSGINFO("NO HAY MAS ERRORES"),DBSKIP(1)),(RLOCK(),oDLG:UPDATE())) )

    @ 150, 60 BUTTON oBTN1 PROMPT "  >  " SIZE 20,15 PIXEL OF oDLG ACTION ( DBSKIP(1),IF(EOF(),(MSGINFO("NO HAY MAS ERRORES"),DBSKIP(-1)),(RLOCK(),oDLG:UPDATE())) )

    @ 150, 85 BUTTON oBTN1 PROMPT "  >| " SIZE 20,15 PIXEL OF oDLG ACTION ( DBGOBOTTOM(),RLOCK(),oDLG:UPDATE() )

    @ 150, 110 BUTTON oBTN1 PROMPT "Ver pantalla" SIZE 40,15 PIXEL OF oDLG ACTION VERPANTAERR()

    @ 150, 160 BUTTON oBTN1 PROMPT "Imprimir"     SIZE 40,15 PIXEL OF oDLG ACTION PRINTERRORES()

    ACTIVATE DIALOG oDlg CENTERED

    oFont:End()

    ERRORES->(DBCLOSEAREA())

RETURN NIL

FUNCTION PRINTERRORES()  //IMPRESION DE ERRORES
LOCAL oPRN,oFONT

PRINTER oPRN PREVIEW

DEFINE FONT oFont NAME "COURIER NEW" SIZE 0,-10 OF oPrn

PAGE
  cERROR:=ERRORES->TRAZO
  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 VERPANTAERR()
    LOCAL oIMAGE,nPOS,cImgFile

    // Leemos las coordenadas de la pantalla actual y definimos la resolucion (WP)
    local oWnd   := WndMain()
    local aCoord := GetWndRect( oWnd:hWnd ), WYRES, WXRES
    ClientToScreen( oWnd:hWnd, @aCoord )
    WYRES := aCoord[4]-aCoord[2]
    WXRES := aCoord[3] - aCoord[1]

    nPOS:=FIELDPOS("PANTALLA")

    cImgFile := FieldGet( nPos )
    cImgFile := if( !Empty(cImgFile), "ERRORES\" + cImgFile, "" )

    if FILE(cImgFile)
        DEFINE DIALOG oDlg TITLE ALLTRIM(ERRORES->DESCRIPCIO) SIZE WYRES*.9,WXRES*.9

        if !Empty( cImgFile )
            @ 0,0 IMAGE oIMAGE FILE cImgFile PIXEL ADJUST OF oDLG SIZE WYRES*.45,WXRES*.45
        endif

        ACTIVATE DIALOG oDLG on init oDlg:Center()

    else
        MSGINFO("No hay imagen grabada de este error","SIN IMAGEN")
    endif

    // Adaptación para 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"

//------------------------------------------------------------------------
#include "struct.ch"
#include "DLL.CH"

#define  HKEY_CURRENT_USER       2147483649        // 0x80000001
#define  HKEY_LOCAL_MACHINE      2147483650        // 0x80000002

#DEFINE MEM_TotalPhys            1
#DEFINE MEM_AvailPhys            2
#DEFINE MEM_TotalPageFile        3
#DEFINE MEM_AvailPageFile        4
#DEFINE MEM_TotalVirtual         5
#DEFINE MEM_AvailVirtual         6

CLASS TSystemInfo

    DATA nOsVer, nMajor, nMinor, nBuild, nPlatform, cSP
    DATA wSerPackM, wSerPacki, wSteMask, wProdType, wRes
    DATA TSIVersion

    METHOD New( lTest )

    METHOD WinVer()
    METHOD VerNum()           INLINE LTrim( Str( ::nMajor ) ) + "." +;
                                     LTrim( Str( ::nMinor ) ) + "." +;
                                     LTrim( Str( ::nBuild ) ) +;
                                     RTrim( " " + ::cSP )  // added by LKM
    METHOD WhichNT()
    METHOD TimeZone()
    METHOD DateSystemBios()
    METHOD NameSystemBios()
    METHOD DateVideoBios()
    METHOD NameVideoBios()
    METHOD ComputerName()
    METHOD IEStartPage()
    METHOD IEVersion()
    METHOD DTWallpaper()
    METHOD DirectxVersion()
    METHOD Ass4Ext(cExt) // Associated programme for this extention
    METHOD BootDir()
    METHOD GetColors()

    METHOD SpeedCPU(nCPU)
    METHOD CPU()              INLINE GetCPU()
    METHOD IsDualCPU()        INLINE ::SpeedCPU(2)>0
    METHOD CPUVendor(nCPU)
    METHOD CPUIdentifier(nCPU)

    METHOD IsWin95()          INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=0  .AND. ::nBuild=950
    METHOD IsWin95SP1()       INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=0  .AND. ::nBuild<=1080
    METHOD IsWin95OSR2()      INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor<10 .AND. ::nBuild>1080
    METHOD IsWin98()          INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild=1998
    METHOD IsWin98SP1()       INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild>1998 .AND. ::nBuild<2183
    METHOD IsWin98SE()        INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=10 .AND. ::nBuild>2183
    METHOD IsWinME()          INLINE ::nPlatform<2 .AND. ::nMajor=4 .AND. ::nMinor=90 .AND. ::nBuild>2183
    METHOD IsWinNT31()        INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=10
    METHOD IsWinNT35()        INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=50
    METHOD IsWinNT351()       INLINE ::nPlatform=2 .AND. ::nMajor=3 .AND. ::nMinor=51
    METHOD IsWinNT4()         INLINE ::nPlatform=2 .AND. ::nMajor=4
    METHOD IsWin2000()        INLINE lWin2000
    METHOD IsWinXP()          INLINE ::nPlatform=2 .AND. ::nMajor=5 .AND. ::nMinor=1
    METHOD ServicePack()      INLINE If(lWin2000,"Service pack "+Ltrim(Str(::wSerPackM)),"")
    METHOD IsNTPreWin2K()     INLINE ::nPlatform=2 .AND. ::nMajor<=4

    METHOD IsNTWorkstation()  INLINE ::IsNTPreWin2K() .AND. Upper(::WhichNT())="WINNT"
    METHOD IsNTServer()       INLINE ::IsNTPreWin2K() .AND. Upper(::WhichNT())="SERVERNT"

    METHOD IsWin2000Prof()    INLINE lWin2000 .AND. Upper(::WhichNT())="WINNT"
    METHOD IsWin2000Server()  INLINE lWin2000 .AND. ( Upper(::WhichNT())="SERVERNT" .OR. Upper(::WhichNT())="LANMANNT")

    METHOD Memory(n)

ENDCLASS

//-----------------------------------
METHOD New( lTest ) CLASS TSystemInfo
LOCAL buffer, sInfo

::TSIVersion:="1.04"

if Valtype( lTest )#"L"
    lTest:=.f.
endif

lWin2000:=IsWin2K()

STRUCT sInfo
MEMBER nLOsVer    AS DWORD          // Size of the structure
MEMBER nLMajor    AS DWORD          // Major windows Version
MEMBER nLMinor    AS DWORD          // Minor Windows Version
MEMBER nLBuild    AS DWORD          // Build Number
MEMBER nLPlatform AS DWORD          // Wich Platform
MEMBER cLSP       AS STRING LEN 128 // Service Pack (Nt/2000)

if lWin2000
    MEMBER wLSerPackM AS WORD
    MEMBER wLSerPacki AS WORD
    MEMBER wLSteMask  AS WORD
    MEMBER wLProdType AS BYTE
    MEMBER wLRes      AS BYTE
endif

ENDSTRUCT

sInfo:Setmember(1,sInfo:Sizeof())
buffer:=sInfo:cBuffer

if GetVerExA(@buffer) <> 1
  MsgInfo("Error on Calling GetVersionExA")
  return self
endif

sInfo:cBuffer:=buffer

::nOSVer   :=nLoWord(sInfo:nLOSVer)
::nMajor   :=nLoWord(sInfo:nLMajor)
::nMinor   :=nLoWord(sInfo:nLMinor)
::nBuild   :=nLoWord(sInfo:nLBuild)
::nPlatform:=nLoWord(sInfo:nLPlatform)
::cSP      :=Alltrim(psz(sInfo:cLSP))

if lWin2000
    ::wSerPackM:=nLoWord(sInfo:wLSerPackM)
    ::wSerPacki:=nLoWord(sInfo:wLSerPacki)
    ::wSteMask :=nLoWord(sInfo:wLSteMask)
    ::wProdType:=sInfo:wLProdType
    ::wRes     :=sInfo:wLRes
endif

if lTest

    MsgInfo("nOsVers = "   +LTrim(Str(::nOsVer))        +CRLF+;
            "nMajor = "    +LTrim(Str(::nMajor))        +CRLF+;
            "nMinor = "    +LTrim(Str(::nMinor))        +CRLF+;
            "nBuild = "    +LTrim(Str(::nBuild))        +CRLF+;
            "sPlatform = " +LTrim(Str(::nPlatform))     +CRLF+;
            "cSP = "       +  AllTrim(::cSP))

    if lWin2000
       MsgInfo("wSerPackM = " +LTrim(Str(::wSerPackM))+CRLF+;
               "wSerPacki = " +LTrim(Str(::wSerPacki))+CRLF+;
               "wSteMask = "  +LTrim(Str(::wSteMask ))+CRLF+;
               "wProdType = " +LTrim(Str(::wProdType))+CRLF+;
               "wRes = "      +LTrim(Str(::wRes     ))+CRLF,"Windows2000 Info")
    endif

endif

return Self

//--------------------------------------------------------------------
Function IsWin2K()
LOCAL sInfo, buffer

STRUCT sInfo
MEMBER OsVer    AS DWORD          // Size of the structure
MEMBER Major    AS DWORD          // Major windows Version
MEMBER Minor    AS DWORD          // Minor Windows Version
MEMBER Build    AS DWORD          // Build Number
MEMBER Platform AS DWORD          // Wich Platform
MEMBER SP       AS STRING LEN 128 // Service Pack (Nt/2000)
ENDSTRUCT
sInfo:Setmember(1,sInfo:Sizeof())
buffer:=sInfo:cBuffer
if GetVerExA(@buffer) <> 1
  MsgInfo("Error on Calling GetVersionExA")
  return .f.
endif
sInfo:cBuffer:=buffer

RETURN (sInfo:Platform=2 .AND. sInfo:Major=5 .AND. sInfo:Minor=0)

//--------------------------------------------------------------------
METHOD WinVer( ) CLASS TSystemInfo
LOCAL cVersion:=""
DO CASE
    CASE ::IsWin95()      ; cVersion:="Windows 95"
    CASE ::IsWin95SP1()   ; cVersion:="Windows 95 Service pack 1"
    CASE ::IsWin95OSR2()  ; cVersion:="Windows 95 OSR2"
    CASE ::IsWin98()      ; cVersion:="Windows 98"
    CASE ::IsWin98SP1()   ; cVersion:="Windows 98 Service pack 1"
    CASE ::IsWin98SE()    ; cVersion:="Windows 98 Second Edition"
    CASE ::IsWinME()      ; cVersion:="Windows ME"
    CASE ::IsWinNT31()    ; cVersion:="Windows NT 3.1"
    CASE ::IsWinNT35()    ; cVersion:="Windows NT 3.5"
    CASE ::IsWinNT351()   ; cVersion:="Windows NT 3.51"
    CASE ::IsWinNT4()     ; cVersion:="Windows NT 4"
    CASE ::IsWin2000()    ; cVersion:="Windows 2000 "+If(::IsWin2000Prof,"Professional","Server")+" "+AllTrim(::cSP)+" build "+LTrim(Str(::nBuild))
    CASE ::IsWinXP()      ; cVersion:="Windows XP build "+LTrim(Str(::nBuild))+" "+::cSP
    OTHER                 ; cVersion:="Unknown Windows version"
ENDCASE

RETURN cVersion

//--------------------------------------------------------------------
METHOD WhichNT() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"System\CurrentControlSet\Control\ProductOptions",.f.)
uVar := oReg:Get("ProductType","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD DateSystemBios() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := oReg:Get("SystemBiosdate","")
oReg:Close()

if Empty(uVar)
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,"Enum\Root\*PNP0C01\0000",.f.)
    uVar := oReg:Get("Biosdate","")
    oReg:Close()
endif

RETURN uVar

//--------------------------------------------------------------------
METHOD NameSystemBios() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := RTrim( Remove0( oReg:Get("SystemBiosVersion","") ) )
oReg:Close()

if Empty(uVar)
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,"Enum\Root\*PNP0C01\0000",.f.)
    uVar := Remove0( oReg:Get("BiosName","")+" "+oReg:Get("BiosVersion","") )
    oReg:Close()
endif

RETURN uVar

//--------------------------------------------------------------------
METHOD DateVideoBios() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := oReg:Get("VideoBiosdate","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD NameVideoBios() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System",.f.)
uVar := RTrim( Remove0( oReg:Get("VideoBiosVersion","") ) )
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD Computername() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName",.f.)
uVar := oReg:Get("Computername","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD TimeZOne() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\TimeZoneInformation",.f.)
uVar := oReg:Get("StandardName","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD IEStartPage() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\Main",.f.)
uVar := oReg:Get("Start Page","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD IEVersion() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Internet Explorer",.f.)
uVar := oReg:Get("Version","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD DTWallpaper() CLASS TSystemInfo //DesktopWallpaper
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\Desktop\General",.f.)
uVar := oReg:Get("Wallpaper","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD SpeedCPU(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar

if ValType(nCPU)#"N"
    nCPU:=1
endif

if ::nPlatform<2 //Win95-98-ME
    uVar:=0
else
    oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
    uVar := oReg:Get("~Mhz",0)
    oReg:Close()
    uVar:=Round(uVar/10,0)*10
endif

RETURN uVar

//--------------------------------------------------------------------
METHOD CPUVendor(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar

if ValType(nCPU)#"N"
    nCPU:=1
endif

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := oReg:Get("VendorIdentifier","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD CPUIdentifier(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar

if ValType(nCPU)#"N"
    nCPU:=1
endif

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := oReg:Get("Identifier","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD DirectXVersion() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\DirectX",.f.)
uVar := oReg:Get("Version","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD Ass4Ext(cExt) CLASS TSystemInfo
LOCAL oReg, uVar

if ValType(cExt)#"C"
    RETURN ""
endif

if Left(cExt,1)#"."
    cExt:="."+cExt
endif

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions",.f.)
uVar := oReg:Get(cExt,"")
oReg:Close()

RETURN SubStr(uVar,1,Len(uVar)-(Len(cExt)+2))

//--------------------------------------------------------------------
METHOD BootDir() CLASS TSystemInfo
LOCAL oReg, uVar

oReg := TReg32():New(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\Setup",.f.)
uVar := oReg:Get("BootDir","")
oReg:Close()

RETURN uVar

//--------------------------------------------------------------------
METHOD Memory(n) CLASS TSystemInfo
LOCAL nRetu

#ifdef __HARBOUR__
    #pragma BEGINDUMP
       #include "windows.h"
    #pragma ENDDUMP

    nRetu := HB_INLINE( n )
    {
       MEMORYSTATUS mst;
       long n = hb_parnl(1);

       mst.dwLength = sizeof( MEMORYSTATUS );
       GlobalMemoryStatus( &mst );

       switch( n )
       {
          case 1:  hb_retnl( mst.dwTotalPhys     / (1024*1024) ) ; break;
          case 2:  hb_retnl( mst.dwAvailPhys     / (1024*1024) ) ; break;
          case 3:  hb_retnl( mst.dwTotalPageFile / (1024*1024) ) ; break;
          case 4:  hb_retnl( mst.dwAvailPageFile / (1024*1024) ) ; break;
          case 5:  hb_retnl( mst.dwTotalVirtual  / (1024*1024) ) ; break;
          case 6:  hb_retnl( mst.dwAvailVirtual  / (1024*1024) ) ; break;
          default: hb_retnl( 0 ) ;
       }
    }

#else

     LOCAL oMemory

     STRUCT oMemory
        MEMBER m1 AS LONG  // nSize
        MEMBER m2 AS LONG  // Memory Load
        MEMBER m3 AS LONG  // Total Physical
        MEMBER m4 AS LONG  // Available Physical
        MEMBER m5 AS LONG  // Total Page File
        MEMBER m6 AS LONG  // Available Page File
        MEMBER m7 AS LONG  // Total Virtual
        MEMBER m8 AS LONG  // Available Virtual
     ENDSTRUCT

     oMemory:m1 = oMemory:SizeOf()
     MemStat( oMemory:cBuffer )

     DO CASE
        CASE n=1 ; nRetu:=Round( oMemory:m3 / (1024*1024) ,0 )
        CASE n=2 ; nRetu:=Round( oMemory:m4 / (1024*1024) ,0 )
        CASE n=3 ; nRetu:=Round( oMemory:m5 / (1024*1024) ,0 )
        CASE n=4 ; nRetu:=Round( oMemory:m6 / (1024*1024) ,0 )
        CASE n=5 ; nRetu:=Round( oMemory:m7 / (1024*1024) ,0 )
        CASE n=6 ; nRetu:=Round( oMemory:m8 / (1024*1024) ,0 )
        OTHERWISE; nRetu:=0
     ENDCASE

#endif

RETURN nRetu

#ifndef __HARBOUR__
    DLL32 STATIC FUNCTION MemStat( pMEMORY AS LPSTR ) AS VOID;
          PASCAL FROM "GlobalMemoryStatus" LIB "KERNEL32.DLL"
#endif
//--------------------------------------------------------------------

//--------------------------------------------------------------------
METHOD GetColors() CLASS TSystemInfo
LOCAL hDC, nPlanes, nBitsPixel

hDC       := CreateDC("DISPLAY", "", "")
nPlanes   := GetDeviceCaps(hDC, 14)
nBitsPixel:= GetDeviceCaps(hDC, 12)
DeleteDC(hDc)

RETURN Int(2^(nPlanes*nBitsPixel))

//--------------------------------------------------------------------
DLL32 FUNCTION GetVerExA( @lpVersionInformation AS LPSTR );
       AS LONG PASCAL FROM "GetVersionExA" LIB "KERNEL32.DLL"

STATIC Function psz( c ) ; RETURN substr( c, 1, At( Chr(0), c ) - 1 )
STATIC Function Remove0( c ) ; RETURN StrTran( c, Chr(0), " " )

#ifdef __HARBOUR__
    #pragma BEGINDUMP
       static void hb_retnl( LONG l )
       {
          hb_itemPutNL( &hb_stack.Return, l );
       }
    #pragma ENDDUMP
#endif

//--------------------------------------------------------------------
// Reemplazo a SalvaraBMP
// Original de Williams Pacheco 2003 + Bingen 2003
//--------------------------------------------------------------------
function SalvarBmp( hDib, cBmpFile, cFormat )
local cRetVal := "ERRORES\" + cBmpFile + ".BMP"

    CURSORWAIT()
    DibWrite( cRetVal, hDib )
    CURSORWAIT()
    IF UPPER(cFormat) = "JPG" .and. File( "NCONVERT.EXE" )
       WaitRun( "nconvert -out jpeg " + " -D " + ".\ERRORES\" + cBmpFile +".BMP" , 0 )
    ENDIF
    CURSORWAIT()

return IF(UPPER(cFormat) = "JPG",cFileName( STRTRAN(cRetVal,".BMP",".JPG" )),cFileName( cRetVal ))


O código deve ser agregado ao seu .RMK para ser gerado o .OBJ e o .OBJ ligado ao seu .LNK para fazer parte do seu sistema.

O .RC deve ser acrescentado às diálogos de seu sistema para ser ligada no momento da compilação.

Ficou Show de bola. Só não garanto que o envio da mensagem de erro via email saia uma beleza mas a idéia é boa.

O intuito é o usuario ser informado de forma mais profissional sobre uma ocorrencia de erro, ser acalmado e ter o arquivo enviado ao email do suporte ou desenvolvimento.

@braços :?)
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 07 Ago 2014 10:37

Rochinha, adorei esta idéia. Obrigado.

abs,
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor evertonlb » 07 Ago 2014 11:20

Caro Amiguinho Rochinha...
Cara, nunca usei arquivos .RC antes..
Se me permite segue algumas dúvidas.

Posso dar qualquer nome ao arquivo RC?
O "código da ErrorSys Completo" posso grava-lo com outro nome este PRG e só compilar junto?
Uso o xHb 99.71 e Fw 6.12. Compilei e deu um erro na linha 1190 - Undefined symbol 'HB_Stack' in function HB_Retnl.
Será que nesta minha configuração de "versões" roda?

Obrigado
Att.
Everton
evertonlb
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 9
Data de registro: 01 Fev 2010 15:48
Cidade/Estado: Chapecó - SC
Curtiu: 1 vez
Mens.Curtidas: 0 vez

A tela da ErrorSys assusta? então use esta.

Mensagempor rochinha » 07 Ago 2014 14:07

Amiguinho,

O problema reside em que o Harbour desta versão, justamente na função em questão não contempla esta variável.

O trecho do código onde contém o Method Memory() pode ser modificado:
//--------------------------------------------------------------------
METHOD Memory(n) CLASS TSystemInfo
     LOCAL nRetu
     LOCAL oMemory
     STRUCT oMemory
        MEMBER m1 AS LONG  // nSize
        MEMBER m2 AS LONG  // Memory Load
        MEMBER m3 AS LONG  // Total Physical
        MEMBER m4 AS LONG  // Available Physical
        MEMBER m5 AS LONG  // Total Page File
        MEMBER m6 AS LONG  // Available Page File
        MEMBER m7 AS LONG  // Total Virtual
        MEMBER m8 AS LONG  // Available Virtual
     ENDSTRUCT
     oMemory:m1 = oMemory:SizeOf()
     MemStat( oMemory:cBuffer )
     DO CASE
        CASE n=1 ; nRetu:=Round( oMemory:m3 / (1024*1024) ,0 )
        CASE n=2 ; nRetu:=Round( oMemory:m4 / (1024*1024) ,0 )
        CASE n=3 ; nRetu:=Round( oMemory:m5 / (1024*1024) ,0 )
        CASE n=4 ; nRetu:=Round( oMemory:m6 / (1024*1024) ,0 )
        CASE n=5 ; nRetu:=Round( oMemory:m7 / (1024*1024) ,0 )
        CASE n=6 ; nRetu:=Round( oMemory:m8 / (1024*1024) ,0 )
        OTHERWISE; nRetu:=0
     ENDCASE
RETURN nRetu


Quanto aos nomes de arquivos coloque os que melhor lhe aprouver pois não terão efeito se modificadas.

Como praxe, os arquivos .RC podem ter o mesmo nome do .PRG principal de seus exemplos, exemplo: TESTE.PRG e TESTE.RC, PROGRAMA.PRG e PROGRAMA.RC.

Quando voce usa o BUILDH.BAT passando como parametro o nome do .PRG, exemplo, BUILDH TESTE, voce praticamente induziu o compilador a compilar o TESTE.PRG e linká-lo ao TESTE.RC.

Arquivos .RC contém a modelagem das telas de uso em seu aplicativo. Usando .RC voce deixa de usar os velhos comandos @..SAY e @..GET passando a usá-los por redefinições em sua programação, por isto voce ve o comando REDEFINE nos códigos.

O uso .RC, leva a um desenho de telas mais refinados onde os posicionamentos ficam melhores no ponto de vista do design e voce posiciona os controles usando pixels de distancia.

Geralmente a compilação integra os .RC dentro do pacote do .EXE, ou seja, um .RC é transformado em .RES(arquivo de recursos) e o linker agrega ao .EXE ou .RES tornando-os um só.

Os arquivos .RES podem possuir string, bitmaps e definições de dialogos e telas.

Os Resource Compilers transformam .RC em .RES, da mesma forma que os .PRG são transformados em .OBJ. Então os .OBJ e .RES são agregados ao runtime para torna-se executáveis.

quando não é mais possivel se agregar um .RES a um executável(existem limites) voce gera uma .DLL à partir de um .RES e faz vinculo em sua aplicação através de comandos como SET RESOURCE TO Minha.DLL.

Pelo menos no Borland, existem um limite para o tamanho do um .RES e um .EXE para serem vinculados em um só. Não fui muito a fundo para descobrir como sanar o problema e o resolvi fazendo uso do compilador de recursos do PELLESC. Mas isto é outra estória.

Voltando ao seu problema, sugiro que voce comece, devagar, a modificar a ERRSYSW.PRG padrão do Fivewin, agregando os recursos existentes no exemplo da seguinte forma, primeiro-mudando a tela, segundo-enviando email e depois, mostrando mensagens mais sofisticadas como, data, hora, usuario, dados da maquina, etc.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 07 Ago 2014 17:16

Rochinha, o tema agradou, de mais sugestões quie, porfa:



Obg. abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 12 Ago 2014 10:06

Bom dia Rochinha, pode me dizer onde estou errando neste seu exemplo, não dá erro, mas não chega nada na minha caixa postal.

#include "FiveWin.ch"

function Main()

   LOCAL oBar
   LOCAL cEmail, cMensagem, cHost, cReplyTo, cSubject, cMsg, lReceipt, lAuth, ;
         cUser, cPass, lPop3, cPOP3Host

   DEFINE WINDOW oWnd TITLE "Usando SMTP Para Email"

   DEFINE BUTTONBAR oBar _3D OF oWnd

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\new.bmp" FLAT ;
          ACTION SendEmailRel( cEmail, cMensagem, cHost, cReplyTo, cSubject, ;
                               cMsg, lReceipt, lAuth, cUser, cPass, lPop3,   ;
                               cPOP3Host )

   SET MESSAGE OF oWnd TO "Usando SMTP Para Email" NOINSET CLOCK DATE KEYBOARD

   ACTIVATE WINDOW oWnd

return nil

function SendEmailRel( cSender, cBody, cHost, cReplyTo, cSubject, cMsg, lReceipt, lAuth, cUser, cPass, lPop3, cPOP3Host )

   LOCAL oInit

   DEFAULT cHost  := 'smtp.pleno.com.br'      ,;
           cPOP3Host := 'mail.pleno.com.br'   ,;
           cSender := 'joao@pleno.com.br'     ,;
           cReplyTo := 'joao@pleno.com.br'    ,;
           lReceipt := .f.                        ,;
           lAuth  := .t.                          ,;
           lPop3  := .t.                          ,;
           cSubject := '*** CONTROLE DE ERROS ***',;
           cMsg   := cBody                        ,;
           cUser  := 'joao@pleno.com.br'          ,;
           cPass  := 'Senha57'

   oInit := TSmtp():New( cHost )

   oMail := TSmtp():New( cHost, , lAuth, cUser, cPass ) // [jlalin], IBTC

   oMail:cReplyTo    := cReplyTo
   oMail:nGMT      := 8 // 8 = Pacific Standard Time (GMT -08:00) - Adjust this to your own Time Zone!
   oMail:nDelay     := 1
   *oMail:lTxtAsAttach  := .F.    // uncomment to force txt, log and htm files as inline as opposed to attachement
   oMail:oSocket:lDebug := .T.    // uncomment to create log file
   oMail:oSocket:cLogFile := "smtp.log"
   oMail:bConnecting   := {|| oWnd:SetMsg( "Conectando a " + cHost + " (" + oMail:cIPServer + ") a aguardando resposta..." ) }
   oMail:bConnected   := {|| oWnd:SetMsg( "Conectado e enviando email e anexos..." ) }

   oMail:SendMail( ;
     'joao@pleno.com.br', ;      // from/de
     { 'joao@pleno.com.br' }, ;  // to/para (arreglo) - I use cSender here also because it's an "autotest". Actually you would type a different address here
     cMsg,;                      // Body/Mensaje
     cSubject,;                  // Subject/Asunto
     { "error.log" }, ;          // Array of filenames to attach/Arreglo de nombres de archivos a agregar
     { }, ;                      // aCC
     { cSender }, ;              // aBCC
     lReceipt, ;                 // Return Receipt/acuse de recibo
     cBody )                     // msg in HTML format/mensaje en HTML

   oInit:end()

   //Msgstop( "EMAIL do erro enviado com sucesso!" )

return nil


Obg. Abs
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor rochinha » 12 Ago 2014 15:28

Amiguinho,

Neste topico parece que voce mesmo conseguiu. Já adaptou o mesmo ao módulo de erros?
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 13 Ago 2014 16:07

Obg, Rochinha, notei um problema na classe TSMTP.PRG

Se eu ponho dois ou mais emails, para enviar, não vai, tipo:

   { 'joao@pleno.com.br; contato@pleno.com.br' }, ;  // to/para (arreglo) - não funciona.


Obg. abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 13 Ago 2014 16:29

Resolvido, desculpe o incomodo Rochinha,

   oOutMail:SendMail( "joao@pleno.com.br",;     // From
                      { "joao@pleno.com.br", ;
                        "marcelo@marcainformatica.com.br", ;
                        "marca@compuland.com.br" },; // To
                        "Mensagens de Erros do Programa",; // Msg Text
                        "*** CONTROLE DE ERROS *** usando 3 emails",; // Subject
                      { "error.log" } )  // attached files


abs,
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor jfaguiar » 19 Fev 2017 10:48

Ola rocheinha. Achei bacana rapaz, mas quando vou compilar em FW 13.07 dar uma erro na linha 1128:
errorsys.prg(1128) Error E0030 Syntax error: "syntax error at '1'"

Pode dar uma light? vlw
jfaguiar
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 8
Data de registro: 13 Nov 2012 12:36
Cidade/Estado: Mauá - SP
Curtiu: 0 vez
Mens.Curtidas: 0 vez

A tela da ErrorSys assusta? então use esta.

Mensagempor JoséQuintas » 19 Fev 2017 13:07

Que merd. até a fivewin faz isso?

Mensagem de erro usando GUI: se tiver erro na GUI, a mensagem não funciona.
Por mais que o erro seja enfeitado, erro vai ser sempre erro.

Basta salvar em disco, e abrir no bloco de notas.
Não depende nem do Harbour pra mostrar o erro, e muito menos de qualquer LIB funcionando.
E se quiser mandar por email, manda depois, do jeito que quiser, afinal tá salvo em disco.

Assim funciona sempre, não importa qual seja a GUI, ou o erro.
E de adicional, vão erros do Harbour, que não aparecem na tela.
Basta usar o arquivo de erros padrão do Harbour e pronto.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18013
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor JoséQuintas » 19 Fev 2017 13:22

O problema das pastas do meu repositório é que cada hora elas tem um nome.... rs
hmgall agora virou allgui, porque não tem só hmg... rs

https://github.com/JoseQuintas/AllGui/blob/master/common/ERRORSYS.prg

de repente o conjunto, pra ver aonde está... rs

https://github.com/JoseQuintas

O que esta errorsys faz:
Acumula os erros em hb_out.log, e abre no bloco de notas.
Esse arquivo também é usado pelo Harbour pra outros tipos de erro que não aparecem na tela.

Depois, ao carregar o aplicativo, basta checar a existência de hb_out.log e enviar por email, ou o que quiser fazer.

De quebra, pode usar WriteErrorLog() pra outras mensagens que queira acrescentar.

Simples e prático, pode usar fivewin, hmg, ohg, hwgui, console, gtwvg, multithread, qualquer coisa.

Aliás.... tá aí um ponto interessante: é possivel que TODAS as LIBs fiquem sem mostrar erro em multithread, e essa funciona sempre.

Aproveitando pra pentelhar:
Se uma rotina de erros atende GTWVG, ela atende qualquer LIB. Já as das LIBs... mal atendem elas mesmas....
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18013
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor Kapiaba » 20 Fev 2017 09:51

Bom dia, com Fivewin the best, não há necessidade de usar isso: CLASS TSystemInfo.

Diga o que você quer fazer com o seu ERRSYSW.PRG, mas deveis usar o da versão FWHX1307 e fazer as modifcações, nunca use o ERRSYSW.PRG de uma versão anterior. Eu uso atualmente o ERRSYSW.PRG da versão FEHX1612 modificada para meu gosto.

abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

A tela da ErrorSys assusta? então use esta.

Mensagempor jfaguiar » 23 Fev 2017 09:06

jfaguiar escreveu:Ola rochinha. Achei bacana rapaz, mas quando vou compilar em FW 13.07 dar uma erro na linha 1111:
errorsys.prg(1128) Error E0030 Syntax error: "syntax error at '1'"

Pode dar uma light? vlw
jfaguiar
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 8
Data de registro: 13 Nov 2012 12:36
Cidade/Estado: Mauá - SP
Curtiu: 0 vez
Mens.Curtidas: 0 vez

A tela da ErrorSys assusta? então use esta.

Mensagempor rochinha » 27 Fev 2017 11:38

Amiguinhos,

jfaguiar
Olhando o Errorsys.prg disponibilizado logo acima vejo que esta linha se dá exatamente dentro da METHOD Memory() portanto não existe esta possibilidade para você de usá-la, bem como as funções ou chamadas a TSystemInfo.

Você pode suprimir as funções chamadas que não sejam encontradas e que você ache que não sejam úteis usando uma dummy function
FUNCTION Memory( nada )
    return 0
...
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Próximo



Retornar para FiveWin

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 8 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro