28 de noviembre de 2005

Comparar dos registros

El siguiente código muestra tres formas de comparar los valores de dos registros, en el mismo cursor o en dos cursores con la misma estructura.

1) Creando un objeto con SCATTER NAME por cada registro a ser comparado, hacemos la comparación mediante la función COMPOBJ(). El comando SCATTER incluye una completa flexibilidad para detallar un grupo específico de campos, incluyendo o excluyendo campos Memo o General.

2) Con la función CURSORTOXML() generando una cadena XML por cada registro a ser comparado, hacemos luego una simple comparación de cadenas entre ambas. CURSORTOXML() no soporta personalizar la lista de campos.

3) Generando un "checksum" con la función SYS(2017) por cada registro a ser comparado, SYS(2017) incluye una completa flexibilidad para detallar un grupo específico de campos, incluyendo o excluyendo campos Memo o General. De las tres técnicas, esta es mucho mas rápida y fácil de codificar, pero es probablemente la menos conocida de las tres. Note que SYS(2017) fue agregado a VFP antes de VFP8, pero fue mejorado en VFP8 para manejar cadenas grandes.

TRY
  USE (_Samples+"Northwind\Customers") IN 0
CATCH
ENDTRY
IF NOT USED("Customers")
  MESSAGEBOX("No se pudo abrir la tabla Customers en _Samples",16,"Aviso")
  RETURN
ENDIF

******************************************
*  Comparar objetos
******************************************
LOCAL loFirstRecord, loSecondRecord
SELECT Customers
LOCATE 
SCATTER MEMO NAME loFirstRecord
SKIP
SCATTER MEMO NAME loSecondRecord
IF COMPOBJ(loFirstRecord,loSecondRecord)
  MESSAGEBOX("Los registros son iguales",48,"Aviso")
 ELSE
  MESSAGEBOX("Los registros son distintos",48,"Aviso")
ENDIF

******************************************
*  Comparar XML
******************************************
ERASE FirstRecord.XML
ERASE SecondRecord.XML
SELECT Customers
LOCATE 
CURSORTOXML("Customers","FirstRecord.XML",1,512,1)
SKIP
CURSORTOXML("Customers","SecondRecord.XML",1,512,1)
IF FILETOSTR("FirstRecord.XML") == FILETOSTR("SecondRecord.XML")
  MESSAGEBOX("Los registros son iguales",48,"Aviso")
 ELSE
  MESSAGEBOX("Los registros son distintos",48,"Aviso")
ENDIF
ERASE FirstRecord.XML
ERASE SecondRecord.XML

******************************************
*  Comparar SYS(2017)
******************************************
LOCAL lnFirstRecord, lnSecondRecord
SELECT Customers
LOCATE 
lnFirstRecord = SYS(2017,"",0,3)
SKIP 
lnSecondRecord = SYS(2017,"",0,3)
IF lnFirstRecord = lnSecondRecord
  MESSAGEBOX("Los registros son iguales",48,"Aviso")
 ELSE
  MESSAGEBOX("Los registros son distintos",48,"Aviso")
ENDIF

USE IN Customers
RETURN

VFP Tips & Tricks - Drew Speedie

3 de noviembre de 2005

Email y VFP: Parte 1i (EsSmtp)

Artículo original: Email and VFP: Part 1i (EsSmtp)
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,def9a19f-04ab-46ff-8421-f700822f1773.aspx 
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


Como hemos visto en las entradas previas de esta serie, el envío de correo electrónico con VFP puede realizarse de varias maneras. En esta entrada, voy a mostrar el empleo de un control ActiveX gratuito, que está disponible y es conocido simplemente como EsSmtp. Este control se vendió por Eurosource (http://www.eurosource.se); pero ahora se encuentra en SourceForge (http://sourceforge.net/projects/activex). No sólo es gratis, sino que es de código abierto. Hay algunos controles disponibles; pero con el único que estoy familiarizado es con EsSmtp. Necesitará descargar y registrar este control para que el ejemplo trabaje. Puede descargarlo aquí: http://sourceforge.net/project/showfiles.php?group_id=47048. Y encontrar información adicional aquí: http://activex.sourceforge.net/essmtp.html.

Bien, sin más dilación, he aquí el código.
*******************************
*!* Ejemplo de utilización de SendViaEsSmtp
*******************************
DIMENSION aryAttach(2)
aryAttach(1) = "C:\attachment1.txt" && cambie a un archivo real que existe en su PC
aryAttach(2) = "C:\attachment2.zip" && cambie a un archivo real que existe en su PC
LOCAL lcFromName, lcFromAddress, lcTo, lcSubject, lcBody, lcCC, lcBCC, lcSMTPServer, lcErrReturn
lcFromName = "Mi Nombre"
lcFromAddress = "yo@midominio.com"
lcTo = "alguien@sudominio.com"
lcSubject = "Hey ¿Ha intentado enviar un email con VFP?"
lcBody = ""Quiero hacerle saber que VFP es muy versátil y hay muchas formas de enviar un email."
lcCC = "otro@sudominio.com"
lcBCC = "mijefe@dominiodeljefe.com"
lcSMTPServer = "mail.myhost.com"
SendViaEsSmtp(@lcErrReturn, lcFromName, lcFromAddress, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcSMTPServer)
IF EMPTY(lcErrReturn)
  MESSAGEBOX("'" + lcSubject + "' se envió satisfactoriamente.", 64, "Envía email via EsSmtp")
ELSE
  MESSAGEBOX("'" + lcSubject + "' falló al enviar. Causa:" + CHR(13) + lcErrReturn, 64, "Envía email via EsSmtp")
ENDIF

*******************************************
PROCEDURE SendViaEsSmtp(tcReturn, tcFromName, tcFromAddress, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcSMTPSever)
*******************************************
  LOCAL loEsSmtp, lnCountAttachments, lnErrorNo
  TRY
    loEsSmtp = CREATEOBJECT("ESSMTP.EsSmtpCtrl.1")
    WITH loEsSmtp
    IF TYPE("tcSMTPSever") = "C"
      .SMTPServer = tcSMTPSever
    ENDIF 
    IF TYPE("tcFromName") = "C"
      .SourceName = tcFromName
    ENDIF
    IF TYPE("tcFromAddress") = "C"
      .SourceAddress = tcFromAddress
    ENDIF
    .DestinationAddress = tcTo
    IF TYPE("tcCC") = "C"
      .CCDestinationAddress = tcCC
    ENDIF
    IF TYPE("tcBCC") = "C"
      .BCCDestinationAddress = tcBCC
    ENDIF
    .Subject = tcSubject
    .MailData = tcBody
    IF TYPE("taFiles", 1) = "A"
      FOR lnCountAttachments = 1 TO ALEN(taFiles)
        .AddAttachment(taFiles(lnCountAttachments), 0) && 0 significa codificar a base64 si es necesario
      ENDFOR
    ENDIF
    IF .SendMail() != 1 && hubo un problema
      lnErrorNo = .ErrorNo
      DO CASE
        CASE lnErrorNo = 421
          THROW "El servicio no está disponible, cerrando el canal de transmisión"
        CASE lnErrorNo = 450
          THROW "No se realizó la acción requerida: buzón no disponible [Por ejemplo, buzón lleno]"
        CASE lnErrorNo = 451
          THROW "Ha abortado la acción requerida: hubo error local al procesar"
        CASE lnErrorNo = 452
          THROW "No se realizó la acción requerida: hay insuficiente capacidad de almacenado del sistema"
        CASE lnErrorNo = 500
          THROW "Error de sintaxis, comando irreconocible [Puede incluir errores del tipo: línea demasiado larga]"
        CASE lnErrorNo = 501
          THROW "Error de sintaxis en los parámetros o argumentos"
        CASE lnErrorNo = 502
          THROW "No se implementó el comando"
        CASE lnErrorNo = 503
          THROW "Está mal la secuencia de comandos"
        CASE lnErrorNo = 504
          THROW "No implementado el parámetro del comando"
        CASE lnErrorNo = 550
          THROW "No se realizó la acción requerida: buzón de correo no disponible [Por ejemplo: no existe, no tiene acceso]"
        CASE lnErrorNo = 552
          THROW "Ha abortado la acción requerida: excede la capacidad de almacenamiento"
        CASE lnErrorNo = 553
          THROW "No se realizó la acción requerida: el nombre del buzón no está admitido [Por ejemplo, es incorrecta la sintaxis del buzón]"
        CASE lnErrorNo = 554
          THROW "Falló la transacción"
        OTHERWISE
          THROW "Error desconocido - Podría estar relacionado con el WinSock"
      ENDCASE
    ENDIF
    ENDWITH
  CATCH TO loError
    tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
      [LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
      [Message: ] + loError.MESSAGE + CHR(13) + ;
      [Procedure: ] + loError.PROCEDURE + CHR(13) + ;
      [Details: ] + loError.DETAILS + CHR(13) + ;
      [StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
      [LineContents: ] + loError.LINECONTENTS
  FINALLY
    RELEASE loEsSmtp
    loEsSmtp = .NULL.
  ENDTRY
ENDPROC

2 de noviembre de 2005

Email y VFP: Parte 1e (Shell)

Artículo original: Email and VFP: Part 1e (Shell)
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,0041d75b-ce37-4493-aac9-0db82b7317d5.aspx 
Autor: Craig Boyd
Traducido por: Ana María Bisbé York

Puede enviar una URL Mailto como el comando ShellExecute para facilitar el envío de correo electrónico en VFP. Debe observar que la línea de comando (URL) está limitada a 2048 bytes (sin embargo en mi sistema no podría crear una mayor de 2020 bytes) y no hay facilidades para adjuntar ficheros utilizando este método. Tiene por una parte estas limitaciones; pero es una solución que se logra en entorno de desarrollo.

*******************************
*!* Ejemplo de utilización de SendViaShell
*******************************
LOCAL lcTo, lcSubject, lcBody, lcCC, lcBCC, lcErrReturn
lcTo = "alguien@algundominio.com"
lcSubject = "Ha intentado enviar un email con VFP?"
lcBody = "Quiero hacerle saber que VFP es muy versátil" + CHR(13) + "y hay muchas formas de enviar un email."
lcCC = "otro@otrodominio.com"
lcBCC = "mijefe@dominiodeljefe.com"
SendViaShell(@lcErrReturn, lcTo, lcSubject, lcBody, lcCC, lcBCC)
IF EMPTY(lcErrReturn)
  MESSAGEBOX("'" + lcSubject + "' se envió satisfactoriamente.", 64, "Enviar email vía Shell")
ELSE
  MESSAGEBOX("'" + lcSubject + "'falló al enviar. Causa:" + CHR(13) + lcErrReturn, 64, ;
    "Enviar email vía Shell")
ENDIF

*******************************************
PROCEDURE SendViaShell(tcReturn, tcTo, tcSubject, tcBody, tcCC, tcBCC)
*******************************************
DECLARE INTEGER ShellExecute IN shell32.DLL ;
  INTEGER hwndWin, STRING cOperation, STRING cFile, ;
  STRING cParameters, STRING cDirectory, INTEGER nShowWin
  LOCAL lcCommand, lcCRLF

TRY
  lcCRLF = "%0D%0A"
  lcCommand = "mailto:" + tcTo + "?Subject=" + tcSubject + "&Body=" + STRTRAN(tcBody, CHR(13), lcCRLF)
  IF TYPE("tcCC") = "C"
    lcCommand = lcCommand + "&CC=" + tcCC
  ENDIF
  IF TYPE("tcBCC") = "C"
    lcCommand = lcCommand + "&BCC=" + tcBCC
  ENDIF
  IF LEN(lcCommand) > 2020 && debía ser 2048, pero no en mi sistema
    THROW "El comando Mailto está limitado a 2048 bytes"
  ENDIF
  ShellExecute(0, "open", lcCommand, "", "", 1)
CATCH TO loError
  tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
    [LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
    [Message: ] + loError.MESSAGE + CHR(13) + ;
    [Procedure: ] + loError.PROCEDURE + CHR(13) + ;
    [Details: ] + loError.DETAILS + CHR(13) + ;
    [StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
    [LineContents: ] + loError.LINECONTENTS
FINALLY
  CLEAR DLLS "ShellExecute"
ENDTRY
ENDPROC

1 de noviembre de 2005

Email y VFP: Parte 1a (MAPI)

Artículo original: Email and VFP: Part 1a (MAPI)
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,8f569366-c76a-4873-9029-f31c07cf125e.aspx 
Autor: Craig Boyd
Traducido por: Ana María Bisbé York

Esta serie de entradas de blog serán fundamentalmente códigos de ejemplo, lo que significa que voy a brindar ejemplos que funcionan (corte y pegue en un prg, tenga en cuenta que hay que hacer los cambios necesarios para que su entorno se corresponda y ejecute el código) que puede utilizar para explorar las diferentes facetas de enviar correo electrónico con VFP 9. Voy a cubrir varios temas en esta serie incluyendo varias tecnologías de enviar y recibir y productos de terceros:   POP3, SMTP, MAPI, Outlook, CDO NTS, CDOSYS, JMAIL, ShellExecute, Blat, ESSMTP, OSSMTP, etc.

Comenzaré mostrando un ejemplo del empleo de MAPI para enviar un mensaje desde VFP9 que permita adjuntos, enviar con copias, con copia oculta e incluso un nombre de usuario y contraseña SMTP

*******************************
*!* Ejemplo de utilización de SendViaMAPI
*******************************
DIMENSION aryAttach(2)
aryAttach(1) = "C:\attachment1.txt" && cambie a un archivo real que existe en su PC
aryAttach(2) = "C:\attachment2.zip" && cambie a un archivo real que existe en su PC
LOCAL lcTo, lcSubject, lcBody, lnCount, lcCC, lcBCC, lcUserName, lcPassword, llOpenEmail, lcErrReturn
lcTo = "alguien@algundominio.com"
lcSubject = "¿Ha intentado enviar un email con VFP?"
lcBody = "Quiero hacerle saber que VFP es muy versátil" + CHR(13) + "y hay muchas formas de enviar un email."
lcCC = "otro@otrodominio.com"
lcBCC = "mijefe@dominiodeljefe.com"
lcUserName = "yo@midominio.com" && mi nombre de usuario SMTP 
lcPassword = "Mi_PaSsWoRd" && mi contraseña SMTP 
*!* para enviar correo automáticamente haga llOpenEmail igual a .F.
llOpenEmail = .T. && Si el correo se abrió o no, en el cliente de correo MAPI
SendViaMAPI(@lcErrReturn, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcUserName, lcPassword, llOpenEmail)
IF EMPTY(lcErrReturn)
  MESSAGEBOX("'" + lcSubject + "'  se envió satisfactoriamente.", 64, "Envía email via MAPI")
ELSE
  MESSAGEBOX("'" + lcSubject + "' falló al enviar. Causa:" + CHR(13) + lcErrReturn, 64, "Envía email via MAPI")
ENDIF

*******************************************
PROCEDURE SendViaMAPI(tcReturn, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcUserName, tcPassword, tlOpenEmail)
*******************************************
  #DEFINE PRIMARY 1
  #DEFINE CARBON_COPY 2
  #DEFINE BLIND_CARBON_COPY 3
  LOCAL loSession, loMessages, lnAttachments, loError AS EXCEPTION, loErrorSend AS EXCEPTION
  tcReturn = ""
  TRY
    loSession = CREATEOBJECT( "MSMAPI.MAPISession" )
    IF TYPE("tcUserName") = "C"
      loSession.UserName = tcUserName
    ENDIF
    IF TYPE("tcPassword") = "C"
      loSession.PASSWORD = tcPassword
    ENDIF
    loSession.Signon()
    IF (loSession.SessionID > 0)
      loMessages = CREATEOBJECT( "MSMAPI.MAPIMessages" )
      loMessages.SessionID = loSession.SessionID
    ENDIF
    WITH loMessages
      .Compose()
      .RecipDisplayName = tcTo
      .RecipType = PRIMARY
      .ResolveName()
      IF TYPE("tcCC") = "C"
        .RecipIndex = .RecipCount
        .RecipDisplayName = tcCC
        .RecipType = CARBON_COPY
        .ResolveName()
      ENDIF
      IF TYPE("tcBCC") = "C"
        .RecipIndex = .RecipCount
        .RecipDisplayName = tcBCC
        .RecipType = BLIND_CARBON_COPY
        .ResolveName()
      ENDIF
      .MsgSubject = tcSubject
      .MsgNoteText = tcBody
      IF TYPE("taFiles", 1) = "A"
        lnAttachments = ALEN(taFiles)
        IF LEN(tcBody) < lnAttachments && Se asegura que el cuerpo es suficientemente grande para los adjuntos
          tcBody = PADR(tcBody, lnAttachments, " ")
        ENDIF
        FOR lnCountAttachments = 1 TO lnAttachments
          .AttachmentIndex = .AttachmentCount
          .AttachmentPosition = .AttachmentIndex
          .AttachmentName = JUSTFNAME(taFiles(lnCountAttachments))
          .AttachmentPathName = taFiles(lnCountAttachments)
        ENDFOR
      ENDIF
      TRY
        .SEND(tlOpenEmail)
      CATCH TO loErrorSend
        IF tlOpenEmail && El usuario canceló la operación desde su cliente de correo?
          tcReturn = "El usuario canceló el envío de correo."
        ELSE
          THROW loErrorSend
        ENDIF
      ENDTRY
    ENDWITH
    loSession.Signoff()
  CATCH TO loError
    tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
      [LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
      [Message: ] + loError.MESSAGE + CHR(13) + ;
      [Procedure: ] + loError.PROCEDURE + CHR(13) + ;
      [Details: ] + loError.DETAILS + CHR(13) + ;
      [StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
      [LineContents: ] + loError.LINECONTENTS
  FINALLY
    STORE .NULL. TO loSession, loMessages
    RELEASE loSession, loMessages
  ENDTRY
ENDPROC