BlackTDN Search

terça-feira, 3 de maio de 2011

Protheus :: Herança de Classe em Advpl ( Derivando fTdb à partir da classe fT )

Aproveitando a deixa do exemplo de classe criado para resolver uma limitação nas funções do tipo FT_F*, vamos criar uma nova classe derivada fTdb que herda as características da classe fT.

A nova classe, fTdb, fará exatamente a mesmo coisa que a classe anterior, com a diferença que a classe fT manipulava um array com as informações do arquivo texto lido e a nova classe, fTdb irá manipular uma tabela. Ela será útil caso número de registros do arquivo texto a ser lido supere o limite do Array.


#INCLUDE "PROTHEUS.CH"
#INCLUDE "TRYEXCEPTION.CH"
#INCLUDE "FILEIO.CH"
#INCLUDE "DBSTRUCT.CH"
/*/
 CLASS:  fTdb
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Alternativa aas funcoes tipo FT_F* devido as limitacoes apontadas em (http://tdn.totvs.com.br/kbm#9734)
 Sintaxe: ftdb():New() : Objeto do Tipo fT
/*/
CLASS fTdb FROM fT

 DATA cDbFile
 DATA cDbAlias
 DATA cRDDName

 METHOD New()  CONSTRUCTOR
 METHOD ClassName()

 METHOD ft_fUse( cFile )
 METHOD ft_fOpen( cFile )
 METHOD ft_fClose()
 
 METHOD ft_fAlias()
 
 METHOD ft_fExists( cFile )
 
 METHOD ft_fRecno()
 METHOD ft_fSkip( nSkipper )
 METHOD ft_fGoTo( nGoTo )
 METHOD ft_fGoTop()
 METHOD ft_fGoBottom()
 METHOD ft_fLastRec()
 METHOD ft_fRecCount()

 METHOD ft_fEof()
 METHOD ft_fBof()

 METHOD ft_fReadLn()
 METHOD ft_fReadLine()
 
 METHOD ft_fError( cError )

 METHOD ft_fSetCRLF( cCRLF )
 METHOD ft_fSetRddName( cRddName )
 METHOD ft_fSetBufferSize( nBufferSize )

END CLASS

User Function ftdb()
Return( NIL )

/*/
 METHOD:  New
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: CONSTRUCTOR
 Sintaxe: ftdb():New() : Object do Tipo fT    
/*/
METHOD New() CLASS fTdb

 _Super:New()

 Self:cDbFile := ""
 Self:cDbAlias := ""

 Self:cClassName := "FTDB"

 Self:ft_fSetRddName()

Return( Self )

/*/
 METHOD:  ClassName
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retornar o Nome da Classe
 Sintaxe: ftdb():ClassName() : Retorna o Nome da Classe
/*/
METHOD ClassName() CLASS fTdb
Return( Self:cClassName )

/*/
 METHOD:  ft_fUse
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Abrir o Arquivo Passado como Parametro
 Sintaxe: ftdb():ft_fUse( cFile ) : nfHandle ( nfHandle > 0 True, False)
/*/
METHOD ft_fUse( cFile ) CLASS fTdb

 TRYEXCEPTION

  IF !( Self:ft_fExists( cFile ) )
   BREAK
  EndIF

  Self:ft_fOpen( cFile )
 
 CATCHEXCEPTION

  Self:ft_fClose()

 ENDEXCEPTION

Return( Self:nfHandle )

/*/
 METHOD:  ft_fOpen
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Abrir o Arquivo Passado como Parametro
 Sintaxe: ftdb():ft_fOpen( cFile ) : nfHandle ( nfHandle > 0 True, False)
/*/
METHOD ft_fOpen( cFile ) CLASS fTdb

 Local adbStruct := { { "LINE" , "M" , 80 , 0 } }
 
 Local lNewArea := .T.
 Local lShared := .T.
 Local lReadOnly := .F.
 Local lHelp  := .F.
 Local lQuit  := .F.

 TRYEXCEPTION

  IF !( Self:ft_fExists( cFile ) )
   BREAK
  EndIF

  Self:cFile  := cFile
  Self:nfHandle := fOpen( Self:cFile , FO_READ )
  
  IF ( Self:nfHandle <= 0 )
   BREAK
  EndIF
  
  Self:cDbFile  := CriaTrab( NIL , .F. )
  While MsFile( Self:cDbFile , NIL , Self:cRddName )
   Self:cDbFile := CriaTrab( NIL , .F. )
  End While
  
  Self:cDbFile  += IF( ( Self:cRddName == "TOPCONN" ) , "" , GetDbExtension() )

  IF !( MsCreate( Self:cDbFile , adbStruct , Self:cRddName ) )
   BREAK
  EndIF

  Self:cDbAlias := GetNextAlias()
  
  IF !( MsOpEndbf( @lNewArea , Self:cRddName , Self:cDbFile , Self:cDbAlias , @lShared , @lReadOnly , @lHelp , @lQuit ) )
   BREAK
  EndIF

  Self:nFileSize := fSeek( Self:nfHandle , 0 , FS_END )

  fSeek( Self:nfHandle , 0 , FS_SET )

  Self:nFileSize := ReadFile( Self:cDbAlias , @Self:nfHandle , @Self:nBufferSize , @Self:nFileSize , @Self:cCRLF )

  Self:ft_fGoTop()

 CATCHEXCEPTION
 
  Self:ft_fClose()
 
 ENDEXCEPTION

Return( Self:nfHandle )

/*/
 Funcao:  ReadFile
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Percorre o Arquivo a ser lido e alimento o Array aLines
 Sintaxe: ReadFile( cAlias , nfHandle , nBufferSize , nFileSize , cCRLF ) : nLines Read
/*/
Static Function ReadFile( cAlias , nfHandle , nBufferSize , nFileSize , cCRLF )
    
 Local cLine   := ""
 Local cBuffer  := ""

 Local nLines  := 0
 Local nAtPlus  := ( Len( cCRLF ) -1 )
 Local nBytesRead := 0

 While ( nBytesRead <= nFileSize )
  cBuffer   += fReadStr( @nfHandle , @nBufferSize )
  nBytesRead  += nBufferSize
  While ( cCRLF $ cBuffer )
   ++nLines
   cLine   := SubStr( cBuffer , 1 , ( AT( cCRLF , cBuffer ) + nAtPlus ) )
   cBuffer  := SubStr( cBuffer , Len( cLine ) + 1 )
   cLine  := StrTran( cLine , cCRLF , "" )
   ( cAlias )->( dbAppend( .T. ) )
   ( cAlias )->( FieldPut( 1 , cLine  ) )
   cLine  := ""
  End While
 End While

 IF !Empty( cBuffer )
  ++nLines
  ( cAlias )->( dbAppend( .T. ) )
  ( cAlias )->( FieldPut( 1 , cBuffer ) )
  cBuffer := ""
 EndIF

Return( nLines )

/*/
 METHOD:  ft_fClose
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Fechar o Arquivo aberto pela ft_fOpen ou ft_fUse
 Sintaxe: ftdb():ft_fClose() : NIL
/*/
METHOD ft_fClose() CLASS fTdb

 Local cMemoFile
 
 _Super:ft_fClose()

 IF ( Select( Self:cDbAlias ) > 0 )
  ( Self:cDbAlias )->( dbCloseArea() )
 EndIF

 IF MsFile( Self:cDbFile , NIL , Self:cRddName )
  MsErase( Self:cDbFile , NIL , Self:cRddName )
 EndIF
 
 cMemoFile := ( FileNoExt( Self:cDbFile ) + ".fpt" )
 
 IF File( cMemoFile )
  fErase( cMemoFile )
 EndIF

 Self:cDbFile := ""
 Self:cDbAlias := ""

Return( NIL )

/*/
 METHOD:  ft_fAlias
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retornar o Nome do Arquivo Atualmente Aberto
 Sintaxe: ftdb():ft_fAlias() : cFile
/*/
METHOD ft_fAlias() CLASS fTdb
Return( Self:cDbAlias )

/*/
 METHOD:  ft_fExists
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Verifica se o Arquivo Existe
 Sintaxe: ftdb():ft_fExists( cFile ) : lExists
/*/
METHOD ft_fExists( cFile ) CLASS fTdb
Return( _Super:ft_fExists( cFile ) )

/*/
 METHOD:  ft_fRecno
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retorna o Recno Atual
 Sintaxe: ftdb():ft_fRecno() : nRecno
/*/
METHOD ft_fRecno() CLASS fTdb
 Self:nRecno := ( Self:cDbAlias )->( Recno() )
Return( Self:nRecno )

/*/
 METHOD:  ft_fSkip
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Salta n Posicoes 
 Sintaxe: ftdb():ft_fSkip( nSkipper ) : nRecno
/*/
METHOD ft_fSkip( nSkipper ) CLASS fTdb
 DEFAULT nSkipper := 1
 ( Self:cDbAlias )->( dbSkip( nSkipper ) )
 Self:nRecno := Self:ft_fRecno()
Return( Self:nRecno )

/*/
 METHOD:  ft_fGoTo
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Salta para o Registro informando em nGoto
 Sintaxe: ftdb():ft_fGoTo( nGoTo ) : nRecno
/*/
METHOD ft_fGoTo( nGoTo ) CLASS fTdb
 ( Self:cDbAlias )->( dbGoto( nGoTo ) )
 Self:nRecno := Self:ft_fRecno()
Return( Self:nRecno )

/*/
 METHOD:  ft_fGoTop
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Salta para o Inicio do Arquivo
 Sintaxe: ftdb():ft_fGoTo( nGoTo ) : nRecno
/*/
METHOD ft_fGoTop() CLASS fTdb
 ( Self:cDbAlias )->( dbGoTop() )
 Self:nRecno := Self:ft_fRecno()
Return( Self:nRecno )

/*/
 METHOD:  ft_fGoBottom
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Salta para o Final do Arquivo
 Sintaxe: ftdb():ft_fGoBottom() : nRecno
/*/
METHOD ft_fGoBottom() CLASS fTdb
 ( Self:cDbAlias )->( dbGoBottom() )
 Self:nRecno := Self:ft_fRecno()
Return( Self:nRecno )

/*/
 METHOD:  ft_fLastRec
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retorna o Numero de Registro do Arquivo
 Sintaxe: ftdb():ft_fLastRec() : nRecCount
/*/
METHOD ft_fLastRec() CLASS fTdb
Return( ( Self:cDbAlias )->( LastRec() ) )

/*/
 METHOD:  ft_fRecCount
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retorna o Numero de Registro do Arquivo
 Sintaxe: ftdb():ft_fRecCount() : nRecCount
/*/
METHOD ft_fRecCount() CLASS fTdb
Return( ( Self:cDbAlias )->( RecCount() ) )

/*/
 METHOD:  ft_fEof
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Verifica se Atingiu o Final do Arquivo
 Sintaxe: ftdb():ft_fEof() : lEof
/*/
METHOD ft_fEof() CLASS fTdb
Return( ( Self:cDbAlias )->( Eof() ) )

/*/
 METHOD:  ft_fBof
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Verifica se Atingiu o Inicio do Arquivo
 Sintaxe: ftdb():ft_fBof() : lBof
/*/
METHOD ft_fBof() CLASS fTdb
Return( ( Self:cDbAlias )->( Bof() ) )

/*/
 METHOD:  ft_fReadLine
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Le a Linha do Registro Atualmente Posicionado
 Sintaxe: ftdb():ft_fReadLine() : cLine
/*/
METHOD ft_fReadLine() CLASS fTdb

 TRYEXCEPTION

  Self:nLastRecno := Self:nRecno
  Self:cLine  := ( Self:cDbAlias )->( FieldGet( 1 ) )

 CATCHEXCEPTION

  Self:cLine := ""

 ENDEXCEPTION

Return( Self:cLine )

/*/
 METHOD:  ft_fReadLn
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Le a Linha do Registro Atualmente Posicionado
 Sintaxe: ftdb():ft_fReadLn() : cLine
/*/
METHOD ft_fReadLn() CLASS fTdb
Return( Self:ft_fReadLine() )

/*/
 METHOD:  ft_fError
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Retorna o Ultimo erro ocorrido
 Sintaxe: ftdb():ft_fError( @cError ) : nDosError
/*/
METHOD ft_fError( cError ) CLASS fTdb
 cError := CaptureError()
Return( fError() )

/*/
 METHOD:  ft_fSetBufferSize
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Redefine nBufferSize
 Sintaxe: ftdb():ft_fSetBufferSize( nBufferSize ) : nLastBufferSize
/*/
METHOD ft_fSetBufferSize( nBufferSize ) CLASS fTdb
Return( _Super:ft_fSetBufferSize( @nBufferSize ) )

/*/
 METHOD:  ft_fSetCRLF
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Redefine cCRLF
 Sintaxe: ftdb():ft_fSetCRLF( cCRLF ) : nLastCRLF
/*/
METHOD ft_fSetCRLF( cCRLF ) CLASS fTdb
Return( _Super:ft_fSetCRLF( @cCRLF ) )

/*/
 METHOD:  ft_fSetRddName
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Redefine cRddName
 Sintaxe: ftdb():ft_fSetRddName( cRddName ) : cLastRddName
/*/
METHOD ft_fSetRddName( cRddName ) CLASS fTdb
 Local cLastRddName := Self:cRddName
 DEFAULT cRddName := "DBFCDXADS"
 Self:cRddName  := Upper( cRddName )
Return( cLastRddName )


Abaixo um Exemplo de uso da nova classe.


#INCLUDE "PROTHEUS.CH"
#INCLUDE "TBICONN.CH"
/*/
 Funcao:  FTFdbSample
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Exemplo de Uso da Classe fTdb
/*/
User Function FTFdbSample()

 Local aCab
 Local aDet

 Local cFile   := "FTFSample.csv" //Deve estar em \system\

 aFile     := FileToArr( @cFile )
 aCab    := aFile[1]
 aDet     := aFile[2]

Return( { aCab , aDet } )

/*/
 Funcao:  FileToArr
 Autor:  Marinaldo de Jesus
 Data:  01/05/2011
 Descricao: Exemplo de Uso da Classe fT
/*/
Static Function FileToArr( cFile )
 Local aCab   := {}
 Local aDet   := {}

 Local cLine   := ""
 Local cToken  := Chr(255)
 Local cRddName  := "DBFCDXADS" //"TOPCONN"

 Local lPrepEnv  := ( !( cRddName == "DBFCDXADS" ) .and. ( Select( "SM0" ) == "0" ) )

 Local ofTdb   := fTdb():New()

 IF ( lPrepEnv )
  PREPARE ENVIRONMENT EMPRESA "01" FILIAL "01"
 EndIF

  BEGIN SEQUENCE
 
   ofTdb:ft_fSetRddName( cRddName )
   
   IF ( ofTdb:ft_fUse( cFile ) <= 0 )
    ofTdb:ft_fUse()
    BREAK
   EndIF
 
   While !( ofTdb:ft_fEof() )
    IncProc()
    cLine   := ofTdb:ft_fReadLn()
    ConOut( cLine )
    cLine  := StrTran( cLine , '""' , '" "' )    //Carrego um espaço em branco
    cLine  := StrTran( cLine , '","' , cToken ) //Defino o Separador
    cLine  := StrTran( cLine , '"' , "" )   //Retiro as Aspas 
    IF ( ofTdb:ft_fRecno() == 1 )
     aCab := StrTokArr( cLine , cToken )   //A primeira Linha contem o Cabeçalho dos campos
    Else
     aAdd( aDet , StrTokArr( cLine , cToken ) )  //As demais linhas sao os Detalhes
    EndIF
    cLine  := "" 
    ofTdb:ft_fSkip()
   End While
 
   ofTdb:ft_fUse()
 
  END SEQUENCE

 IF ( lPrepEnv )
  RESET ENVIRONMENT
 EndIF

Return( { aCab , aDet } )

Para baixar os arquivos utilizanos neste "post", clique aqui, e, para maiores referências sobre Herança em Advpl consulte: Como criar uma classe ADVPL com herança (http://tdn.totvs.com.br/kbm#9392)

Para maior ditática e aprendizado, recomendo que os exemplos sejam executados através do IDE (totvsDevStudio) digitando-se u_FTFdbSample ou u_FTFSample e depurando-se o código. 

Para comparar se o retorno das duas classes são exatamente iguais, poderiamos testar com:

ArrayCompare( u_FTFdbSample() , u_FTFSample() ) : Se .T. (True) o conteúdo retornado é exatamente igual. Ambas as classes estão fazendo o que se propõe, caso contrário.... "Tem alguma coisa errada que não está certa."

E.T.: ArrayCompare é uma função em Advpl que compara o conteúdo de 2 Arrays e verifica se são exatamente iguais. Se for, retorna .T. (True/Verdadeiro), caso contrário retornára (.F./False/Falso). ArrayCompare é uma das preciosidades criada por esse que vos escreve enquanto ainda na equipe IP da Totvs. Sua Sintaxe é: ArrayCompare( aArray1 , aArray2 ) ? .T. : .F.

Tenho dito: "Simples Assim".

[]s

иαldσ dj

10 comentários:

  1. Sempre Tio Marinaldo,

    Excelente dica de um excelente profissional!

    ResponderExcluir
  2. Marinaldo,

    Tentei usar o mesmo conceito criando uma classe TEMAIL que estende a TMailMessage

    Class TEmail From TMailMessage

    Data cError as String init ""
    Data lRelauth as Boolean init .f.
    Data cServer as String init ""
    Data cConta as String init ""
    Data cSenha as String init ""
    Data cArqHtml as String init ""
    Data aVariaveis as Array init {}
    Data oServer as Object

    METHOD New() CONSTRUCTOR
    Method inicializa()
    Method EnviaEMail()
    Method aaddVariavel()
    Method setHtml()
    Method converteMensagem()


    EndClass

    //ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
    //³ new ³
    //ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    Method new() Class TEmail
    _Super:New()
    Return(Self)

    Porem ao compilar tenho a seguinte mensagem
    TEMAIL.PRW(45) C2021 Constructor of class TEMAIL must initialize the parent class TMAILMESSAGE

    O que pode ser?

    ResponderExcluir
  3. Ismael, faça a seguinte alteração.

    De:

    Method new() Class TEmail
    _Super:New()
    Return(Self)

    Para:

    Method new() Class TEmail
    :New() //<-Este é um caso especial em que o Construtor da Classe "Pai" deve ser executado logo após a declaração do método.
    /*
    Inclua seu código customizado para NEW aqui
    */
    Return(Self)

    ResponderExcluir
  4. Nao querendo ser chato... mas esse é um nivel de programacao somente para o SUPER NALDO.

    Agora o sistema da a seguinte mensagem e chega a derrubar o server

    Exception code: C0000005 ACCESS_VIOLATION
    Fault address: 01EF6352 770ADFA5:00000000
    Call stack:
    Address Frame
    01EF6352 0356FE20
    1021CAC9 0356FE3C
    apMain+1FE659
    Unable to locate source line number
    1021DE68 0356FE44
    apMain+1FF9F8
    Unable to locate source line number
    10077C9E 0356FE58
    apMain+5982E
    Unable to locate source line number
    10217BFB 0356FE70
    apMain+1F978B
    Unable to locate source line number
    Call stack:
    Address Frame Logical addr Module
    apMain+1F6C77
    102150E7 00000000 0001:002140E7 E:\MICROSIGA_11\INPLAC\bin\appserverIsmael\apwinnt.dll

    Meu fonte esta assim

    Class TEmail From TMailMessage

    Data cError as String init ""
    Data lRelauth as Boolean init .f.
    Data cServer as String init ""
    Data cConta as String init ""
    Data cSenha as String init ""
    Data cArqHtml as String init ""
    Data aVariaveis as Array init {}
    Data oServer as Object

    METHOD New() CONSTRUCTOR
    Method inicializa()


    EndClass

    //ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
    //³ new ³
    //ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    Method New() Class TEmail
    :New()

    conout("teste")
    Return(Self)

    //ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
    //³ init ³
    //ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    Method inicializa(/*xFrom,xEmailTo,xEmailCC,xEmailBCC,xTitulo*/) Class TEmail

    /*::cFrom := "nfe2@inplac.com.br" //If(Empty(xFrom),GetMV("MV_RELACNT"),xFrom)
    ::cTo := If(xEmailTo != Nil,Rtrim(xEmailTo) ,"email@email.com.br")
    ::cCC := If(xEmailCC != Nil,Rtrim(xEmailCC) ,"")
    ::cBCC := If(xEmailBCC != Nil,Rtrim(xEmailBCC) ,"")
    ::cDate := dtoc(dDataBase)
    ::cBody := ""

    ::cSubject := If(xTitulo != Nil,Rtrim(xTitulo) ,"Sem Titulo")*/

    Return

    ResponderExcluir
    Respostas
    1. Ismael,

      Infelizmente trabalhar com OOP no ADVPL nos traz algumas surpresas. Diferente de Linguagens como [x]Harbour, C++, Java, Delphi, etc, em que os conceitos OOP como Herança, Herança Múltipla, Polimorfismo dentre outros são bem implementados. ADVPL possui uma "pseudo" programação OOP. Então, para evitar maiores surpresas, altere seu código para:

      #INCLUDE "PROTHEUS.CH"
      Class TEmail

      Data cError as String init ""
      Data lRelauth as Boolean init .f.
      Data cServer as String init ""
      Data cConta as String init ""
      Data cSenha as String init ""
      Data cArqHtml as String init ""
      Data aVariaveis as Array init {}

      Data oMessage as Object
      Data oServer as Object

      METHOD New() CONSTRUCTOR
      Method inicializa()

      EndClass

      Method New() Class TEmail
      ::oMessage := TMailMessage():New()
      ::oServer := TMailManager():New()
      Return(Self)

      Method inicializa(/*xFrom,xEmailTo,xEmailCC,xEmailBCC,xTitulo*/) Class TEmail

      /*::cFrom := "nfe2@inplac.com.br" //If(Empty(xFrom),GetMV("MV_RELACNT"),xFrom)
      ::oMessage:cTo := If(xEmailTo != Nil,Rtrim(xEmailTo) ,"email@email.com.br")
      ::oMessage:cCC := If(xEmailCC != Nil,Rtrim(xEmailCC) ,"")
      ::oMessage:cBCC := If(xEmailBCC != Nil,Rtrim(xEmailBCC) ,"")
      ::oMessage:cDate := dtoc(dDataBase)
      ::oMessage:cBody := ""

      ::oMessage:cSubject := If(xTitulo != Nil,Rtrim(xTitulo) ,"Sem Titulo")*/

      Return

      User Function TEmail()
      Return( TEmail():New() )

      User Function TEmailEx()
      Local oTEmail := U_TEmail()
      Return( NIL )

      Excluir
    2. "Object Oriented syntax in Harbour is compatible with CA-CLIPPER. But Clipper only allowed creation of objects from a few standard classes, and did not let the programmer create new classes. In Harbour, you can create your own classes--complete with Methods, Instance Variables, Class Variables and Inheritance. Entire applications can be designed and coded in Object Oriented style"

      Já em ADVPL.... (sem comentários)

      Excluir
    3. No Harbour:

      CLASS
      Define a Class for Object Oriented Programming

      Syntax
      [CREATE] CLASS [ [,] ]
      [STATIC]

      Arguments

      Name of the class to define. By tradition, Harbour classes start with "T" to avoid collisions with user- created classes.
      The Parent class(es) to use for inheritance. Harbour supports Multiple Inheritance.

      function. It will therefore not be available outside the current module.

      Description

      CLASS creates a class from which you can create objects. The CLASS command begins the class specification, in which the DATA elements (also known as instance variables) and METHODS of the class are named. The following scoping commands may also appear. They control the default scope of DATA and METHOD commands that follow them.

      EXPORTED:
      VISIBLE:
      HIDDEN:
      PROTECTED:

      The class specification ends with the END CLASS command.

      Classes can inherit from multiple , and the chain of inheritance can extend to many levels.
      A program uses a Class by calling the Class Constructor, usually the New() method, to create an object. That object is usually assigned to a variable, which is used to access the DATA elements and methods.

      Harbour's OOP syntax and implementation supports Scoping (Protect, Hidden and Readonly) and Delegating, and is largely compatible with Class(y)(tm),TopClass(tm) and Visual Objects(tm).

      Excluir
  5. Certo

    Já tinha pensado tb nesta solução.
    Ficaria mais feliz se o ADVPL atendesse a esses conceitos e evoluísse em conceitos como limite de 1Mb para uma string, ou mesmo limites de array.

    De qualquer forma muito obrigado pela força.

    Como te questionar sob assuntos que não possuem tópicos?

    Sempre acompanho seu blog e já aprendi muito com ele... parabens pelo empenho em ajudar a nós.

    ResponderExcluir
  6. Naldo, boa tarde! Estou tentando compilar uma classe tAutoGet porém está dando o mesmo erro mencionado pelo Ismael:
    TAUTOGET.PRG(67) C2021 Constructor of class TAUTOGET must initialize the parent class TGET

    Conforme sugerido, fiz o uso de :New() no programa, parou de dar o erro, porém quando vou executar está dando isso aqui:
    THREAD ERROR (Marcio, MARCIO-PC) 03/09/2014 16:22:25
    invalid property _SUPCLS_ on TAUTOGET:NEW(TAUTOGET.PRG) 03/09/2014 16:21:41 line : 76

    Alguma idéia do que possa ser?!

    ResponderExcluir
  7. Caso alguém passe pelo problema do Anônimo, recebi o mesmo erro ao instanciar uma classe pai desta forma: Super:New()
    Troquei para _Super:New() e resolveu.

    Class Composicao FROM EnterpriseStruct
    [...]
    End Class
    Method New(cCompositionCode,nMode,_cBranch,_cEnterprise,_cActivity,_cSubActivity,_cReview,_nSocial,_nAddTool ) Class Composicao
    _Super:New({__CUserId,cEmpAnt,cFilAnt,'001','0001','000000'}) // corrigir na proxima versão
    self:cBranch := _cBranch
    self:cEnterprise := _cEnterprise
    self:cActivity := _cActivity
    self:cSubActivity := _cSubActivity
    self:cReview := _cReview
    self:cComposition := cCompositionCode
    self:aComposition := aClone(::GetComposition(nMode))
    self:nSocial := _nSocial
    self:nAddTool := _nAddTool
    Return

    ResponderExcluir