Funcion Enviar mail de xHabour a Habour no funciona

Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Tue Mar 24, 2020 1:47 am

Estimados

Esta funcion de enviar mail, funciona con xHarbour pero con Harbout NO funciona

Code: Select all  Expand view

FUNCTION SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, lTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo )
   /*
   cServer    -> Necessário. Nome IP ou o domínio do servidor de email
   nPort      -> Opcional.   A porta usada pelo o meu servidor de email
   cFro       -> Necessário. Endereço de email do remetente
   aTo        -> Necessário. Seqüência de caracteres ou matriz de endereços de email para enviar o email para
   aCC        -> Opcional.   Seqüência de caracteres ou matriz de email adresses para CC (Copia do email)
   aBCC       -> Opcional.   Seqüência de caracteres ou matriz de email adresses de Cco (copia oculta do email)
   cBody      -> Opcional.   A mensagem do corpo do email como texto, ou o nome do arquivo da mensagem em HTML para enviar.
   cSubject   -> Opcional.   Assunto do email
   aFiles     -> Opcional.   Matriz/arquivos de anexos para enviar com o email
   cUser      -> Necessário. Nome de usuário para o servidor POP3
   cPass      -> Necessário. Senha para cUser
   cPopServer -> Necessário. Nome IP ou o domínio do servidor de email POP3
   nPriority  -> Opcional.   Email de prioridade: 1 = alta, 3 = Normal (padrão), 5 = baixa
   lRead      -> Opcional.   Se definido como. T., uma solicitação de confirmação é enviada. A configuração padrão é. f.
   lTrace     -> Opcional.   Se definido como. T., um arquivo de log é criado (sendmail <nNr>.log). A configuração padrão é. f.
   lPopAuth   -> Opcional.   Sinalizador para indicar que Autentication POP3 é usado. A configuração padrão é. T.
   lnoauth    -> Opcional.   Servidores de email que nao precisam de autenticacao smtp
   nTimeOut   -> Opcional.   Numero de milesimos de segundos a Aguarda o envio - Padrão é 2000(2 segundos)
   cReplyTo   -> Opcional.
   */


   LOCAL oInMail, cBodyTemp, oUrl, oMail, oAttach, aThisFile, cFile, cFname, cFext, cData, oUrl1

   LOCAL cTmp          :=""
   LOCAL cMimeText     := ""
   LOCAL cTo           := ""
   LOCAL cCC           := ""
   LOCAL cBCC          := ""

   LOCAL lConnectPlain := .F.
   LOCAL lReturn       := .T.
   LOCAL lAuthLogin    := .F.
   LOCAL lAuthPlain    := .F.
   LOCAL lConnect      := .T.
   LOCAL oPop
   LOCAL adata:={},nCount,nSize,nSent

   DEFAULT cUser       := ""
   DEFAULT cPass       := ""
   DEFAULT nPort       := 25
   DEFAULT aFiles      := {}
   DEFAULT nPriority   := 3
   DEFAULT lRead       := .F.
   DEFAULT lTrace      := .F.
   DEFAULT lPopAuth    := .T.
   DEFAULT lNoAuth     := .F.
   DEFAULT nTimeOut    := 10000  // 20000
   DEFAULT cReplyTo    := ""

   cUser := StrTran( cUser, "@", "&at;" )

   IF !( (".htm" IN Lower( cBody ) .OR. ".html" IN Lower( cBody ) ) .AND. File(cBody) )

      IF !( Right( cBody, 2 ) == HB_OSNewLine() )
         cBody += HB_OsNewLine()
      ENDIF

   ENDIF

   // cTo
   IF Valtype( aTo ) == "A"
      IF Len( aTo ) > 1
         FOR EACH cTo IN aTo
            IF HB_EnumIndex() != 1
               cTmp += cTo + ","
            ENDIF
         NEXT
         cTmp := Substr( cTmp, 1, Len( cTmp ) - 1 )
      ENDIF
      cTo := aTo[ 1 ]
      IF Len( cTmp ) > 0
         cTo += "," + cTmp
      ENDIF
   ELSE
      cTo := Alltrim( aTo )
   ENDIF


   // CC (Carbon Copy)
   IF Valtype(aCC) =="A"
      IF Len(aCC) >0
         FOR EACH cTmp IN aCC
            cCC += cTmp + ","
         NEXT
         cCC := Substr( cCC, 1, Len( cCC ) - 1 )
      ENDIF
   ELSEIF Valtype(aCC) =="C"
      cCC := Alltrim( aCC )
   ENDIF


   // BCC (Blind Carbon Copy)
   IF Valtype(aBCC) =="A"
      IF Len(aBCC)>0
         FOR EACH cTmp IN aBCC
            cBCC += cTmp + ","
         NEXT
         cBCC := Substr( cBCC, 1, Len( cBCC ) - 1 )
      ENDIF
   ELSEIF Valtype(aBCC) =="C"
      cBCC := Alltrim( aBCC )
   ENDIF

   IF cPopServer != NIL .AND. lPopAuth
      TRY
         oUrl1 := tUrl():New( "pop://" + cUser + ":" + cPass + "@" + cPopServer + "/" )
         oUrl1:cUserid := Strtran( cUser, "&at;", "@" )
         opop:= tIPClientPOP():New( oUrl1, lTrace )
         IF oPop:Open()
            oPop:Close()
         ENDIF
      CATCH
         lReturn := .F.
      END

   ENDIF

   IF !lReturn
      RETURN .F.
   ENDIF

   TRY
      oUrl := tUrl():New( "smtp://" + cUser + "@" + cServer + '/' + cTo )
   CATCH
      lReturn := .F.
   END

   IF !lReturn
      RETURN .F.
   ENDIF

   oUrl:nPort   := nPort
   oUrl:cUserid := Strtran( cUser, "&at;", "@" )

   oMail   := tipMail():new()
   oAttach := tipMail():new()
   oAttach:SetEncoder( "7-bit" )

   IF (".htm" IN Lower( cBody ) .OR. ".html" IN Lower( cBody ) ) .AND. File(cBody)
      cMimeText := "text/html ; charset=ISO-8859-1"
      oAttach:hHeaders[ "Content-Type" ] := cMimeText
      cBodyTemp := cBody
      cBody     := MemoRead( cBodyTemp ) + chr( 13 ) + chr( 10 )

   ELSE
      oMail:hHeaders[ "Content-Type" ] := "text/plain; charset=iso8851"
   ENDIF

   oAttach:SetBody( cBody )
   oMail:Attach( oAttach )
   oUrl:cFile := cTo + If( Empty(cCC), "", "," + cCC ) + If( Empty(cBCC), "", "," + cBCC)

   oMail:hHeaders[ "Date" ] := tip_Timestamp()
   oMail:hHeaders[ "From" ] := cFrom

   IF !Empty(cCC)
      oMail:hHeaders[ "Cc" ] := cCC
   ENDIF
   IF !Empty(cBCC)
      oMail:hHeaders[ "Bcc" ] := cBCC
   ENDIF
   IF !Empty(cReplyTo)
      oMail:hHeaders[ "Reply-To" ] := cReplyTo
   ENDIF

   TRY
      oInmail := tIPClientSMTP():New( oUrl, lTrace)
   CATCH
      lReturn := .F.
   END

   IF !lReturn
      RETURN .F.
   ENDIF

   oInmail:nConnTimeout:= nTimeOut

   IF !lNoAuth

      IF oInMail:Opensecure()

         WHILE .T.
            oInMail:GetOk()
            IF oInMail:cReply == NIL
               EXIT
            ELSEIF "LOGIN" IN oInMail:cReply
               lAuthLogin := .T.
            ELSEIF "PLAIN" IN oInMail:cReply
               lAuthPlain := .T.
            ENDIF
         ENDDO

         IF lAuthLogin
            IF !oInMail:Auth( cUser, cPass )
               lConnect := .F.
            ELSE
               lConnectPlain  := .T.
            ENDIF
         ENDIF

         IF lAuthPlain .AND. !lConnect
            IF !oInMail:AuthPlain( cUser, cPass )
               lConnect := .F.
            ENDIF
         ELSE
            IF !lConnectPlain
               oInmail:Getok()
               lConnect := .F.
            ENDIF
         ENDIF
      ELSE
         lConnect := .F.
      ENDIF
   ELSE
      lConnect := .F.
   ENDIF

   IF !lConnect

      if !lNoAuth
         oInMail:Close()
      endif

      TRY
         oInmail := tIPClientsmtp():New( oUrl, lTrace)
      CATCH
         lReturn := .F.
      END

      oInmail:nConnTimeout:=nTimeOut


      IF !oInMail:Open()
         lConnect := .F.
         oInmail:Close()
         RETURN .F.
      ENDIF

      WHILE .T.
         oInMail:GetOk()
         IF oInMail:cReply == NIL
            EXIT
         ENDIF
      ENDDO

   ENDIF

   oInMail:oUrl:cUserid := cFrom
   oMail:hHeaders[ "To" ]      := cTo
   oMail:hHeaders[ "Subject" ] := cSubject

   FOR EACH aThisFile IN AFiles

      IF Valtype( aThisFile ) == "C"
         cFile := aThisFile
         cData := Memoread( cFile ) + chr( 13 ) + chr( 10 )
      ELSEIF Valtype( aThisFile ) == "A" .AND. Len( aThisFile ) >= 2
         cFile := aThisFile[ 1 ]
         cData := aThisFile[ 2 ] + chr( 13 ) + chr( 10 )
      ELSE
         lReturn := .F.
         EXIT
      ENDIF

      oAttach := TipMail():New()

      HB_FNameSplit( cFile,, @cFname, @cFext )

      IF Lower( cFile ) LIKE ".+\.(vbd|asn|asz|asd|pqi|tsp|exe|sml|ofml)"    .OR. ;
         Lower( cFile ) LIKE ".+\.(pfr|frl|spl|gz||stk|ips|ptlk|hqx|mbd)"    .OR. ;
         Lower( cFile ) LIKE ".+\.(mfp|pot|pps|ppt|ppz|doc|n2p|bin|class)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(lha|lzh|lzx|dbf|cdx|dbt|fpt|ntx|oda)"     .OR. ;
         Lower( cFile ) LIKE ".+\.(axs|zpa|pdf|ai|eps|ps|shw|qrt|rtc|rtf)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(smp|dst|talk|tbk|vmd|vmf|wri|wid|rrf)"    .OR. ;
         Lower( cFile ) LIKE ".+\.(wis|ins|tmv|arj|asp|aabaam|aas|bcpio)"    .OR. ;
         Lower( cFile ) LIKE ".+\.(vcd|chat|cnc|coda|page|z|con|cpio|pqf)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(csh|cu|csm|dcr|dir|dxr|swa|dvi|evy|ebk)"  .OR. ;
         Lower( cFile ) LIKE ".+\.(gtar|hdf|map|phtml|php3|ica|ipx|ips|js)"  .OR. ;
         Lower( cFile ) LIKE ".+\.(latex|bin|mif|mpl|mpire|adr|wlt|nc|cdf)"  .OR. ;
         Lower( cFile ) LIKE ".+\.(npx|nsc|pgp|css|sh||shar|swf|spr|sprite)" .OR. ;
         Lower( cFile ) LIKE ".+\.(sit|sca|sv4cpio|sv4crc|tar|tcl|tex)"      .OR. ;
         Lower( cFile ) LIKE ".+\.(texinfo|texi|tlk|t|tr|roff|man|mems)"     .OR. ;
         Lower( cFile ) LIKE ".+\.(alt|che|ustar|src|xls|xlt|zip|au|snd)"    .OR. ;
         Lower( cFile ) LIKE ".+\.(es|gsm|gsd|rmf|tsi|vox|wtx|aif|aiff)"     .OR. ;
         Lower( cFile ) LIKE ".+\.(aifc|cht|dus|mid|midi|mp3|mp2|m3u|ram)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(ra|rpm|stream|rmf|vqf|vql|vqe|wav|wtx)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(mol|pdb|dwf|ivr|cod|cpi|fif|gif|ief)"     .OR. ;
         Lower( cFile ) LIKE ".+\.(jpeg|jpg|jpe|rip|svh|tiff|tif|mcf|svf)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(dwg|dxf|wi|ras|etf|fpx|fh5|fh4|fhc|dsf)"  .OR. ;
         Lower( cFile ) LIKE ".+\.(pnm|pbm|pgm|ppm|rgb|xbm|xpm|xwd|dig)"     .OR. ;
         Lower( cFile ) LIKE ".+\.(push|wan|waf||afl|mpeg|mpg|mpe|qt|mov)"   .OR. ;
         Lower( cFile ) LIKE ".+\.(viv|vivo|asf|asx|avi|movie|vgm|vgx)"      .OR. ;
         Lower( cFile ) LIKE ".+\.(xdr|vgp|vts|vtts|3dmf|3dm|qd3d|qd3)"      .OR. ;
         Lower( cFile ) LIKE ".+\.(svr|wrl|wrz|vrt)"                       .OR. Empty(cFExt)
         oAttach:SetEncoder( "base64" )
      ELSE
         oAttach:SetEncoder( "7-bit" )
      ENDIF

      cMimeText := HB_SetMimeType( cFile, cFname, cFext )
      // Some EMAIL readers use Content-Type to check for filename

      IF ".html" in lower( cFext) .OR. ".htm" in lower( cFext )
         cMimeText += "; charset=ISO-8859-1"
      ENDIF

      oAttach:hHeaders[ "Content-Type" ] := cMimeText
      // But usually, original filename is set here
      oAttach:hHeaders[ "Content-Disposition" ] := "attachment; filename=" + cFname + cFext
      oAttach:SetBody( cData )
      oMail:Attach( oAttach )

   NEXT

   IF lRead
      oMail:hHeaders[ "Disposition-Notification-To" ] := cUser
   ENDIF

   IF nPriority != 3
      oMail:hHeaders[ "X-Priority" ] := Str( nPriority, 1 )
   ENDIF

   oInmail:Write( oMail:ToString() )
/*   cData := oMail:ToString()
   nSize := Len(cData)
   for nCount := 1 to len(cData) step 1024
       aadd(aData, substr( cData,nCount,1024))
   next
   nSent :=0
   for nCount :=1 to len(aData)
      nSent += oInmail:Write( aData[nCount],len(aData[nCount]))
   next
*/

   oInMail:Commit()
   oInMail:Close()

RETURN lReturn


//-------------------------------------------------------------//


FUNCTION HB_SetMimeType( cFile, cFname, cFext )

   cFile := Lower( cFile )

   IF     cFile LIKE ".+\.vbd"                         ; RETURN "application/activexdocument="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(asn|asz|asd)"               ; RETURN "application/astound="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pqi"                         ; RETURN "application/cprplayer=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tsp"                         ; RETURN "application/dsptype="+cFname + cFext
   ELSEIF cFile LIKE ".+\.exe"                         ; RETURN "application/exe="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(sml|ofml)"                  ; RETURN "application/fml="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pfr"                         ; RETURN "application/font-tdpfr=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.frl"                         ; RETURN "application/freeloader=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.spl"                         ; RETURN "application/futuresplash =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.gz"                          ; RETURN "application/gzip =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.stk"                         ; RETURN "application/hstu =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ips"                         ; RETURN "application/ips="+cFname + cFext
   ELSEIF cFile LIKE ".+\.ptlk"                        ; RETURN "application/listenup =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.hqx"                         ; RETURN "application/mac-binhex40 =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.mbd"                         ; RETURN "application/mbedlet="+cFname + cFext
   ELSEIF cFile LIKE ".+\.mfp"                         ; RETURN "application/mirage=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(pot|pps|ppt|ppz)"           ; RETURN "application/mspowerpoint =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.doc"                         ; RETURN "application/msword=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.n2p"                         ; RETURN "application/n2p="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(bin|class|lha|lzh|lzx|dbf)" ; RETURN "application/octet-stream =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.oda"                         ; RETURN "application/oda="+cFname + cFext
   ELSEIF cFile LIKE ".+\.axs"                         ; RETURN "application/olescript=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.zpa"                         ; RETURN "application/pcphoto="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pdf"                         ; RETURN "application/pdf="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(ai|eps|ps)"                 ; RETURN "application/postscript=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.shw"                         ; RETURN "application/presentations=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.qrt"                         ; RETURN "application/quest=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.rtc"                         ; RETURN "application/rtc="+cFname + cFext
   ELSEIF cFile LIKE ".+\.rtf"                         ; RETURN "application/rtf="+cFname + cFext
   ELSEIF cFile LIKE ".+\.smp"                         ; RETURN "application/studiom="+cFname + cFext
   ELSEIF cFile LIKE ".+\.dst"                         ; RETURN "application/tajima=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.talk"                        ; RETURN "application/talker=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.tbk"                         ; RETURN "application/toolbook =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.vmd"                         ; RETURN "application/vocaltec-media-desc="+cFname + cFext
   ELSEIF cFile LIKE ".+\.vmf"                         ; RETURN "application/vocaltec-media-file="+cFname + cFext
   ELSEIF cFile LIKE ".+\.wri"                         ; RETURN "application/write=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.wid"                         ; RETURN "application/x-DemoShield =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.rrf"                         ; RETURN "application/x-InstallFromTheWeb="+cFname + cFext
   ELSEIF cFile LIKE ".+\.wis"                         ; RETURN "application/x-InstallShield="+cFname + cFext
   ELSEIF cFile LIKE ".+\.ins"                         ; RETURN "application/x-NET-Install=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tmv"                         ; RETURN "application/x-Parable-Thing="+cFname + cFext
   ELSEIF cFile LIKE ".+\.arj"                         ; RETURN "application/x-arj=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.asp"                         ; RETURN "application/x-asap=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.aab"                         ; RETURN "application/x-authorware-bin =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(aam|aas)"                   ; RETURN "application/x-authorware-map =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.bcpio"                       ; RETURN "application/x-bcpio="+cFname + cFext
   ELSEIF cFile LIKE ".+\.vcd"                         ; RETURN "application/x-cdlink =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.chat"                        ; RETURN "application/x-chat=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.cnc"                         ; RETURN "application/x-cnc=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(coda|page)"                 ; RETURN "application/x-coda=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.z"                           ; RETURN "application/x-compress=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.con"                         ; RETURN "application/x-connector="+cFname + cFext
   ELSEIF cFile LIKE ".+\.cpio"                        ; RETURN "application/x-cpio=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.pqf"                         ; RETURN "application/x-cprplayer="+cFname + cFext
   ELSEIF cFile LIKE ".+\.csh"                         ; RETURN "application/x-csh=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(cu|csm)"                    ; RETURN "application/x-cu-seeme=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(dcr|dir|dxr|swa)"           ; RETURN "application/x-director=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.dvi"                         ; RETURN "application/x-dvi=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.evy"                         ; RETURN "application/x-envoy="+cFname + cFext
   ELSEIF cFile LIKE ".+\.ebk"                         ; RETURN "application/x-expandedbook=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.gtar"                        ; RETURN "application/x-gtar=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.hdf"                         ; RETURN "application/x-hdf=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.map"                         ; RETURN "application/x-httpd-imap =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.phtml"                       ; RETURN "application/x-httpd-php="+cFname + cFext
   ELSEIF cFile LIKE ".+\.php3"                        ; RETURN "application/x-httpd-php3 =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ica"                         ; RETURN "application/x-ica=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ipx"                         ; RETURN "application/x-ipix=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.ips"                         ; RETURN "application/x-ipscript=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.js"                          ; RETURN "application/x-javascript =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.latex"                       ; RETURN "application/x-latex="+cFname + cFext
   ELSEIF cFile LIKE ".+\.bin"                         ; RETURN "application/x-macbinary="+cFname + cFext
   ELSEIF cFile LIKE ".+\.mif"                         ; RETURN "application/x-mif=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(mpl|mpire)"                 ; RETURN "application/x-mpire="+cFname + cFext
   ELSEIF cFile LIKE ".+\.adr"                         ; RETURN "application/x-msaddr =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.wlt"                         ; RETURN "application/x-mswallet=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(nc|cdf)"                    ; RETURN "application/x-netcdf =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.npx"                         ; RETURN "application/x-netfpx =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.nsc"                         ; RETURN "application/x-nschat =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.pgp"                         ; RETURN "application/x-pgp-plugin =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.css"                         ; RETURN "application/x-pointplus="+cFname + cFext
   ELSEIF cFile LIKE ".+\.sh"                          ; RETURN "application/x-sh =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.shar"                        ; RETURN "application/x-shar=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.swf"                         ; RETURN "application/x-shockwave-flash=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.spr"                         ; RETURN "application/x-sprite =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.sprite"                      ; RETURN "application/x-sprite =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.sit"                         ; RETURN "application/x-stuffit=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.sca"                         ; RETURN "application/x-supercard="+cFname + cFext
   ELSEIF cFile LIKE ".+\.sv4cpio"                     ; RETURN "application/x-sv4cpio=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.sv4crc"                      ; RETURN "application/x-sv4crc =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tar"                         ; RETURN "application/x-tar=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tcl"                         ; RETURN "application/x-tcl=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tex"                         ; RETURN "application/x-tex=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(texinfo|texi)"              ; RETURN "application/x-texinfo=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tlk"                         ; RETURN "application/x-tlk=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(t|tr|roff)"                 ; RETURN "application/x-troff="+cFname + cFext
   ELSEIF cFile LIKE ".+\.man"                         ; RETURN "application/x-troff-man="+cFname + cFext
   ELSEIF cFile LIKE ".+\.me"                          ; RETURN "application/x-troff-me=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.ms"                          ; RETURN "application/x-troff-ms=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.alt"                         ; RETURN "application/x-up-alert=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.che"                         ; RETURN "application/x-up-cacheop =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ustar"                       ; RETURN "application/x-ustar="+cFname + cFext
   ELSEIF cFile LIKE ".+\.src"                         ; RETURN "application/x-wais-source=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.xls"                         ; RETURN "application/xls="+cFname + cFext
   ELSEIF cFile LIKE ".+\.xlt"                         ; RETURN "application/xlt="+cFname + cFext
   ELSEIF cFile LIKE ".+\.zip"                         ; RETURN "application/zip="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(au|snd)"                    ; RETURN "audio/basic="+cFname + cFext
   ELSEIF cFile LIKE ".+\.es"                          ; RETURN "audio/echospeech =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(gsm|gsd)"                   ; RETURN "audio/gsm=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.rmf"                         ; RETURN "audio/rmf=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tsi"                         ; RETURN "audio/tsplayer=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.vox"                         ; RETURN "audio/voxware=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.wtx"                         ; RETURN "audio/wtx=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(aif|aiff|aifc)"             ; RETURN "audio/x-aiff =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(cht|dus)"                   ; RETURN "audio/x-dspeech="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(mid|midi)"                  ; RETURN "audio/x-midi =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.mp3"                         ; RETURN "audio/x-mpeg =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.mp2"                         ; RETURN "audio/x-mpeg =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.m3u"                         ; RETURN "audio/x-mpegurl="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(ram|ra)"                    ; RETURN "audio/x-pn-realaudio =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.rpm"                         ; RETURN "audio/x-pn-realaudio-plugin="+cFname + cFext
   ELSEIF cFile LIKE ".+\.stream"                      ; RETURN "audio/x-qt-stream=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.rmf"                         ; RETURN "audio/x-rmf="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(vqf|vql)"                   ; RETURN "audio/x-twinvq=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.vqe"                         ; RETURN "audio/x-twinvq-plugin=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.wav"                         ; RETURN "audio/x-wav="+cFname + cFext
   ELSEIF cFile LIKE ".+\.wtx"                         ; RETURN "audio/x-wtx="+cFname + cFext
   ELSEIF cFile LIKE ".+\.mol"                         ; RETURN "chemical/x-mdl-molfile=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.pdb"                         ; RETURN "chemical/x-pdb=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.dwf"                         ; RETURN "drawing/x-dwf=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ivr"                         ; RETURN "i-world/i-vrml=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.cod"                         ; RETURN "image/cis-cod=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.cpi"                         ; RETURN "image/cpi=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.fif"                         ; RETURN "image/fif=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.gif"                         ; RETURN "image/gif=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ief"                         ; RETURN "image/ief=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(jpeg|jpg|jpe)"              ; RETURN "image/jpeg=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.rip"                         ; RETURN "image/rip=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.svh"                         ; RETURN "image/svh=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(tiff|tif)"                  ; RETURN "image/tiff=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.mcf"                         ; RETURN "image/vasa=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(svf|dwg|dxf)"               ; RETURN "image/vnd=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.wi"                          ; RETURN "image/wavelet=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ras"                         ; RETURN "image/x-cmu-raster=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.etf"                         ; RETURN "image/x-etf="+cFname + cFext
   ELSEIF cFile LIKE ".+\.fpx"                         ; RETURN "image/x-fpx="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(fh5|fh4|fhc)"               ; RETURN "image/x-freehand =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.dsf"                         ; RETURN "image/x-mgx-dsf="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pnm"                         ; RETURN "image/x-portable-anymap="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pbm"                         ; RETURN "image/x-portable-bitmap="+cFname + cFext
   ELSEIF cFile LIKE ".+\.pgm"                         ; RETURN "image/x-portable-graymap =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.ppm"                         ; RETURN "image/x-portable-pixmap="+cFname + cFext
   ELSEIF cFile LIKE ".+\.rgb"                         ; RETURN "image/x-rgb="+cFname + cFext
   ELSEIF cFile LIKE ".+\.xbm"                         ; RETURN "image/x-xbitmap="+cFname + cFext
   ELSEIF cFile LIKE ".+\.xpm"                         ; RETURN "image/x-xpixmap="+cFname + cFext
   ELSEIF cFile LIKE ".+\.xwd"                         ; RETURN "image/x-xwindowdump="+cFname + cFext
   ELSEIF cFile LIKE ".+\.dig"                         ; RETURN "multipart/mixed="+cFname + cFext
   ELSEIF cFile LIKE ".+\.push"                        ; RETURN "multipart/x-mixed-replace=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(wan|waf)"                   ; RETURN "plugin/wanimate="+cFname + cFext
   ELSEIF cFile LIKE ".+\.ccs"                         ; RETURN "text/ccs =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(htm|html)"                  ; RETURN "text/html=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.pgr"                         ; RETURN "text/parsnegar-document="+cFname + cFext
   ELSEIF cFile LIKE ".+\.txt"                         ; RETURN "text/plain=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.rtx"                         ; RETURN "text/richtext=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.tsv"                         ; RETURN "text/tab-separated-values=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.hdml"                        ; RETURN "text/x-hdml="+cFname + cFext
   ELSEIF cFile LIKE ".+\.etx"                         ; RETURN "text/x-setext=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(talk|spc)"                  ; RETURN "text/x-speech=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.afl"                         ; RETURN "video/animaflex="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(mpeg|mpg|mpe)"              ; RETURN "video/mpeg=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(qt|mov)"                    ; RETURN "video/quicktime="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(viv|vivo)"                  ; RETURN "video/vnd.vivo=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.(asf|asx)"                   ; RETURN "video/x-ms-asf=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.avi"                         ; RETURN "video/x-msvideo="+cFname + cFext
   ELSEIF cFile LIKE ".+\.movie"                       ; RETURN "video/x-sgi-movie=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(vgm|vgx|xdr)"               ; RETURN "video/x-videogram=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.vgp"                         ; RETURN "video/x-videogram-plugin =" + cFname + cFext
   ELSEIF cFile LIKE ".+\.vts"                         ; RETURN "workbook/formulaone="+cFname + cFext
   ELSEIF cFile LIKE ".+\.vtts"                        ; RETURN "workbook/formulaone="+cFname + cFext
   ELSEIF cFile LIKE ".+\.(3dmf|3dm|qd3d|qd3)"         ; RETURN "x-world/x-3dmf=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.svr"                         ; RETURN "x-world/x-svr=" + cFname + cFext
   ELSEIF cFile LIKE ".+\.(wrl|wrz)"                   ; RETURN "x-world/x-vrml=" +cFname + cFext
   ELSEIF cFile LIKE ".+\.vrt"                         ; RETURN "x-world/x-vrt=" + cFname + cFext
   ENDIF
RETURN "text/plain;filename=" + cFname + cFext


 
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby karinha » Tue Mar 24, 2020 3:14 am

¿Te refieres a este modelo? Si es así, intente contactar al autor a través de Skype.

http://fivewin.com.br/index.php?/topic/15528-rotina-de-email-simplesresolvido/

Saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Tue Mar 24, 2020 1:08 pm

No le gusta esto:

el "IN"

Code: Select all  Expand view
IF !( (".htm" IN Lower( cBody ) .OR. ".html" IN Lower( cBody ) ) .AND. File(cBody) )

ELSEIF "LOGIN" IN oInMail:cReply
 


el "LIKE"

Code: Select all  Expand view
Lower( cFile ) LIKE ".+\.(svr|wrl|wrz|vrt)"
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby Antonio Linares » Tue Mar 24, 2020 1:41 pm

Cambia IN por $

y

LIKE por ==
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42059
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Tue Mar 24, 2020 6:18 pm

Estimado.....

muchas gracias.... pasó....

me este error...

Error: Unresolved external '_HB_FUN_TURL' referenced from C:\DOB\DOB\CDX\COMPRASV\DEBUG\ENV-MAIL.OBJ
Error: Unresolved external '_HB_FUN_TIPCLIENTPOP' referenced from C:\DOB\DOB\CDX\COMPRASV\DEBUG\ENV-MAIL.OBJ
Error: Unresolved external '_HB_FUN_TIPMAIL' referenced from C:\DOB\DOB\CDX\COMPRASV\DEBUG\ENV-MAIL.OBJ
Error: Unresolved external '_HB_FUN_TIP_TIMESTAMP' referenced from C:\DOB\DOB\CDX\COMPRASV\DEBUG\ENV-MAIL.OBJ
Error: Unresolved external '_HB_FUN_TIPCLIENTSMTP' referenced from C:\DOB\DOB\CDX\COMPRASV\DEBUG\ENV-MAIL.OBJ


muchas gracias
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby cnavarro » Tue Mar 24, 2020 7:04 pm

Añade la lib hbTip.lib
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6541
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Tue Mar 24, 2020 7:31 pm

perfecto....

LISTO... :P

MUCHA GRACIAS !!!!
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Fri Mar 27, 2020 4:57 pm

muchas gracias x la ayuda...

pero

cuando ejecuto el envio queda dando el programa y se traba, cual puede ser el problema ??

gracias

david
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Mon Mar 30, 2020 1:33 pm

Gente....

Se frena en esto:

oInMail:GetOk()

me devuelve .F. y queda dando vuelta en esto..

Code: Select all  Expand view

         WHILE .T.
            oInMail:GetOk()                                  // ACA
            IF oInMail:cReply == NIL
               EXIT
            ELSEIF "LOGIN" $ oInMail:cReply
               lAuthLogin := .T.
            ELSEIF "PLAIN" $ oInMail:cReply
               lAuthPlain := .T.
            ENDIF
         ENDDO
 
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby Ariel » Tue Mar 31, 2020 10:10 am

David,

deberias ver que te devuelve :cReply

saludos.
Ariel
 
Posts: 376
Joined: Wed Nov 29, 2006 1:51 pm
Location: Rosario - Argentina

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby jnavas » Tue Mar 31, 2020 12:17 pm

Saludos
Puedes enviarme codigo fuente funciona a mi cuenta de correo adaptaprodrive@gmail.com
Agradecido
User avatar
jnavas
 
Posts: 479
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Tue Mar 31, 2020 1:03 pm

Gracias por contactarme..

Ariel... en el Alert.... no me muestra nada.... es como si vinieran en blanco... ni tampoco muestra .T. , .F. o NIL

david
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Sun Apr 05, 2020 12:07 pm

Buenos dias

Porque esta variable :cReply devuelve en blanco o sin datos ??... este es motivo que no Responde la rutina.

David
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby jvtecheto » Mon Apr 06, 2020 7:47 am

Hola amigos:

Esta funcion que adjunto, no es mia, la saque del foro, envia email correcamente solo que tienes que desactivar la opcion de google de activar el acceso a tu cuenta de aplicaciones poco seguras, entonces google te manda automaticamente correo de alerta de seguridad critica, tanto afecta a la seguridad mandar correos desde nuestra aplicacion?, hay alguna manera de modificar la funcion, para que se salte esa alerta de seguridad?

Gracias por vuestra ayuda.

la funcion.
Code: Select all  Expand view

Function SendMail()

LOCAL loCfg, loMsg, oError, isError := .F., oRep, oPrn
local cSMTP := "smtp.gmail.com"
Local cPuerto := 465
Local cLogin := "usuario@gmail.com"
Local cPassword := "contraseña google"
local cRemitente:= "Crispin handler"
Local cDestino := "otracuenta@yahoo.es"
Local cAsunto := "Prueba de correo"
Local cMensaje := "Probando correo desde Fivewin" + chr(10)
local cSSL := .T., cAuth := .T.
local cFichero := nil

// Control autentificación via SSL
cSSL := .T.
// Internet
loCfg := CREATEOBJECT( "CDO.Configuration" )
WITH OBJECT loCfg:Fields
   :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cSMTP // "smtp.gmail.com"
   :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := cPuerto //465
   :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2
   :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := cAuth //.T.
   :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := cSSL // .T.
   :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cLogin //tu cuenta de correo de salida
   :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cPassword //"" //con tu clave gmail. en este caso
   :Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"):Value := 30

   :Update()
END WITH

loMsg := CREATEOBJECT ( "CDO.Message" )
WITH OBJECT loMsg
   :Configuration := loCfg
   :From := cLogin
   :To := cDestino
   :Subject := cAsunto
   :MDNRequested := .T.
   :TextBody := cMensaje
   :Send()
END WITH

IF isError == .F.
    MsgInfo( "Mensaje enviado correctamente", " A V I S O " )
    ELSE
    MsgStop("ERROR: Se ha producido un error al enviar un mensaje al buzon "+ cDestino + CRLF + CRLF + "Descripción del Error: "+oError:Description, " E R R O R ")
ENDIF

return nil
 


Saludos

Jose.
Fwh 24.07 64 bits + Harbour 64 bits 3.2dev(r2407221137) + MSVC64
User avatar
jvtecheto
 
Posts: 592
Joined: Mon Mar 04, 2013 4:32 pm
Location: Spain

Re: Funcion Enviar mail de xHabour a Habour no funciona

Postby davidbarrio » Mon Apr 13, 2020 9:49 am

Muchas gracias por la sugerencia...

Quería ver si podía hacer funcionar esta rutina que estaba funcionando normalmente.

veo de seguir intentando buscar solución, sino intentaré migrar a otra función... gracias nuevamente.

david
davidbarrio
 
Posts: 14
Joined: Wed Apr 04, 2007 11:56 am


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 27 guests