Yo utilizo esto para recibir mensajes POP3 y procesarlos en función del asunto del mensaje. Si trae ficheros adjuntos los creo en C:\REMOTO\INTER y acto seguido los proceso (descomprimo e incorporo al programa central).
Saludos.
Code: Select all
#include "Fivewin.ch"
#include "c5grid.ch"
FUNCTION ReciboPOP3()
LOCAL oIco
LOCAL oWndChild
LOCAL oGrid
LOCAL oCol1,oCol2,oCol3,oCol4,oCol5,oCol6,oCol7,oCol8
LOCAL oHdr1,oHdr2,oHdr3,oHdr4,oHdr5,oHdr6,oHdr7,oHdr8
LOCAL oBar,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5,oBtn6
LOCAL oDbf5
LOCAL oGet1
LOCAL cSearch:=space(30)
LOCAL oPanel,oTabs
Apertura({78})
DEFINE WINDOW oWndChild TITLE OemToAnsi("Historial de Correos") MDICHILD NOSYSMENU
#ifndef __XPP__
oPanel = TPanel():New()
#else
oPanel = TPanel():New():_New()
#endif
oWndChild:oClient = oPanel // It is the client control of oWnd
@ 0,0 TABS oTabs PROMPTS "Fecha Entrada","Origen","Fecha Proceso" OF oPanel ;
ACTION ( oGrid:=Cambia78Index(oGrid,oTabs:nOption,78) )
oPanel:oBottom = oTabs
dbSelectArea(78)
dbSetOrder(1)
dbGotop()
DATABASE oDbf5
@ 0, 0 GRID oGrid SIZE oApp:nResolX,oApp:nResolY OF oPanel ;
ALIAS "lpop3" ;
VSCROLL HSCROLL VGRID HGRID ;
COLOR CLR_BLACK,CLR_LIGHTGRAY ;
BAR ACTION (oBtn4:Click(),.T.)
oPanel:oLeft = oGrid
oPanel:oRight = oGrid
DEFINE HEADER oHdr0 ;
TITLE "Procesado" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol1 OF oGrid ;
DATA "lpop3->fproce" ;
HEADER oHdr0 ;
NOEDITABLE WIDTH 70
DEFINE HEADER oHdr1 ;
TITLE "Fecha Correo" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol1 OF oGrid ;
DATA "lpop3->fentra" ;
HEADER oHdr1 ;
NOEDITABLE WIDTH 70
DEFINE HEADER oHdr11 ;
TITLE "F.Recogida" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol11 OF oGrid ;
DATA {|| dtoc(lpop3->flee)+" "+lpop3->hlee } ;
HEADER oHdr11 ;
NOEDITABLE WIDTH 120
DEFINE HEADER oHdr2 ;
TITLE "Asunto" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol2 OF oGrid ;
DATA "lpop3->asunto" ;
HEADER oHdr2 ;
NOEDITABLE WIDTH 200
DEFINE HEADER oHdr3 ;
TITLE "Ficheros" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol3 OF oGrid ;
DATA "lpop3->files" ;
HEADER oHdr3 ;
NOEDITABLE WIDTH 200
DEFINE HEADER oHdr5 ;
TITLE "Origen" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol5 OF oGrid ;
DATA "lpop3->origen" ;
HEADER oHdr5 ;
NOEDITABLE WIDTH 100
DEFINE HEADER oHdr4 ;
TITLE "Ruta" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol4 OF oGrid ;
DATA "lpop3->ruta" ;
HEADER oHdr4 ;
NOEDITABLE WIDTH 200
DEFINE HEADER oHdr6 ;
TITLE "Texto" ;
ALIGN CENTER ;
VGRID ;
COLORPANE CLR_HGRAY ;
BUTTONLOOK
DEFINE COLUMNA oCol6 OF oGrid ;
DATA "lpop3->texto" ;
HEADER oHdr6 ;
NOEDITABLE WIDTH 200
DEFINE BUTTONBAR oBar _3D OF oWndChild
DEFINE BUTTON oBtn4 OF oBAR RESOURCE "BTNLINREFRESH" ;
TOOLTIP "Zoom" GROUP NOBORDER ;
ACTION( MsgInfo(lpop3->texto) )
DEFINE BUTTON oBtn5 OF oBAR RESOURCE "BTNLINEXIT" ;
TOOLTIP "(S)alir" GROUP NOBORDER ;
ACTION( oGrid:End(),Cierre({78}),oWndChild:End() )
@ 0.4,45 GET oSGet1 VAR cSearch PICTURE "@D" OF oBar SIZE 90,20 ;
MESSAGE OemToAnsi("Introduzca C¢digo o Nombre a Buscar") ;
VALID ( dbSetOrder(1),oGrid:Gotop(),;
oGrid:Seek( dtos(cSearch),.T. ),;
oGrid:Refresh(),oApp:Edicion:=.F.,.T. )
ACTIVATE WINDOW oWndChild MAXIMIZED ;
ON INIT ( oGrid:SetFilter(),oGrid:SetFocus() )
oWndChild:bKeyDown:={|nKey,nFlag| LeeGeneralTeclas(nKey,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5,oBtn6) }
RETURN .F.
static FUNCTION LeeGeneralTeclas(nKey,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5,oBtn6)
DO CASE
CASE nKey==27 // ESC
IF !oApp:Edicion
oBtn5:Click()
ENDIF
CASE nKey==83 // S=Salir
IF !oApp:Edicion
oBtn5:Click()
ENDIF
CASE nKey==76 // L=Localizar
oApp:Edicion:=.T.
oSGet1:SetFocus()
ENDCASE
RETURN .T.
static FUNCTION Cambia78Index(oGrid,nTab,nArea)
dbSelectArea(nArea)
DO CASE
CASE nTab==1
dbSetOrder(1)
CASE nTab==2
dbSetOrder(2)
CASE nTab==3
dbSetOrder(3)
ENDCASE
oGrid:Refresh()
RETURN oGrid
static FUNCTION DaMes(nMes)
LOCAL nValor:=0
DO CASE
CASE nMes=="JAN"
nValor:=1
CASE nMes=="FEB"
nValor:=2
CASE nMes=="MAR"
nValor:=3
CASE nMes=="APR"
nValor:=4
CASE nMes=="MAY"
nValor:=5
CASE nMes=="JUN"
nValor:=6
CASE nMes=="JUL"
nValor:=7
CASE nMes=="AUG"
nValor:=8
CASE nMes=="SEP"
nValor:=9
CASE nMes=="OCT"
nValor:=10
CASE nMes=="NOV"
nValor:=11
CASE nMes=="DEC"
nValor:=12
ENDCASE
RETURN str(nValor,2)
static FUNCTION TmpDir()
LOCAL cTmpDir:="C:\REMOTO\INTER\__temp"
DO WHILE File( cTmpDir := "C:\REMOTO\INTER\__" + StrZero( nRandom( 99999 ), 5 ) )
ENDDO
makedir(cTmpDir)
RETURN cTmpDir
FUNCTION ReadPOP3()
LOCAL oDlg
LOCAL oMeter1:=0
LOCAL nActual:=0
Apertura({78,20,21})
dbSelectArea(78)
DEFINE DIALOG oDlg RESOURCE "GENERAL"
REDEFINE METER oMeter1 VAR nActual TOTAL 100 ID 51 OF oDlg
ACTIVATE DIALOG oDlg CENTERED ON INIT ( ReadEmails(oMeter1,oDlg) )
Cierre({78,20,21})
RETURN
static FUNCTION ReadEmails( oMeter1, oDlg )
LOCAL oInMail
oMeter1:Set(10)
SysRefresh()
oInMail = TPop3():New( alltrim(empre2->ippop3),, alltrim(empre2->usuario), alltrim(empre2->clave) ) // mail server IP
oInMail:bDone = { || MeterLeeEmails( oMeter1, oInMail, oDlg ) }
oInMail:GetMail(.F.)
RETURN nil
static FUNCTION MeterLeeEmails( oMeter1, oInMail, oDlg )
LOCAL n
LOCAL nTmpDir:=""
LOCAL cResul:=""
LOCAL cTexto:=""
LOCAL cCadena:=""
LOCAL _:=0
LOCAL aTexFiles:=ARRAY(0)
LOCAL aNomFiles:=ARRAY(0)
LOCAL nPos78
LOCAL cTextul:=""
oMeter1:nTotal:=len(oInMail:aMsgs)+1
SysRefresh()
oMeter1:Set(1)
SysRefresh()
FOR n = 1 TO Len( oInMail:aMsgs )
oMeter1:Set(n+1)
SysRefresh()
aTexFiles:=ARRAY(0)
aNomFiles:=ARRAY(0)
cAsunto:=substr(oInMail:aMsgs[ n ],;
at("Subject:",oInMail:aMsgs[n])+8,;
at(chr(13),substr(oInMail:aMsgs[n],at("Subject:",oInMail:aMsgs[n])+8))-1)
cFecha :=substr(oInMail:aMsgs[ n ],;
at("Date:",oInMail:aMsgs[n])+5,;
at(chr(13),substr(oInMail:aMsgs[n],at("Date:",oInMail:aMsgs[n])+5))-1)
nDia:=alltrim(substr(cFecha,at(", ",cFecha)+2,2))
nMes:=substr(cFecha,at(nDia+" ",cFecha)+3,3)
nAnno:=substr(cFecha,at(nMes,cFecha)+4,4)
nMes:=upper(nMes)
dFecha:=ctod(nDia+"/"+DaMes(nMes)+"/"+nAnno)
cOrigen:=substr(oInMail:aMsgs[ n ],;
at("From:",oInMail:aMsgs[n])+5,;
at(chr(13),substr(oInMail:aMsgs[n],at("From:",oInMail:aMsgs[n])+5))-1)
cCadena:=alltrim(oInMail:aMsgs[n])
DO WHILE .T.
_:=at('filename="',cCadena)
IF _#0
cFile :=alltrim(substr(cCadena,;
_+10,;
at('"',substr(cCadena,_+10))-1))
cCadena:=substr(cCadena,_+10)
cTexto :=substr(cCadena,at(chr(13),cCadena)+1)
cTexto :=substr(cTexto,at(chr(13),cTexto)+2)
cTexto :=substr(cTexto,1,at("NextPar",cTexto)-1)
cTexto :=substr(cTexto,1,rat(chr(13),cTexto))
AADD(aNomFiles,cFile)
AADD(aTexFiles,cTexto)
cCadena:=substr(cCadena,at("NextPar",cCadena)+7)
_:=0
ELSE
EXIT
ENDIF
ENDDO
cCadena1:=alltrim(oInMail:aMsgs[n])
nPos1Cadena:=at('text/plain;',cCadena1)
cCadena1:=substr(cCadena1,nPos1Cadena+12)
cCadena1:=substr(cCadena1,at(chr(13),cCadena1)+1)
cCadena1:=substr(cCadena1,at(chr(13),cCadena1)+2)
cTextul:=substr(cCadena1,1,at("NextPar",cCadena1)-9)
DO CASE
CASE "MENSAJE"$alltrim(upper(cAsunto))
dbSelectArea(78)
IF CsInsertRec()
fieldput(1,dFecha)
fieldput(2,alltrim(cOrigen))
fieldput(3,alltrim(cAsunto))
fieldput(7,date())
fieldput(8,time())
lpop3->texto:=alltrim(cTextul)
lpop3->fproce:=date()
CsUnLock()
MsgInfo(lpop3->texto)
ENDIF
CASE "Pedido:"$alltrim(cAsunto)
dbSelectArea(78)
IF CsInsertRec()
fieldput(1,dFecha)
fieldput(2,alltrim(cOrigen))
fieldput(3,alltrim(cAsunto))
nTmpDir:=TmpDir()
fieldput(5,nTmpDir)
FOR x:=1 TO len(aNomFiles)
fieldput(4,alltrim(fieldget(4))+alltrim(aNomFiles[x])+",")
nHanLer:=FCREATE("tmpmime.txt")
FWRITE(nHanLer,aTexFiles[x],len(aTexFiles[x]))
FCLOSE(nHanLer)
FMIMEDEC("tmpmime.txt",nTmpDir+"\"+alltrim(aNomFiles[x]))
NEXT
fieldput(7,date())
fieldput(8,time())
ENDIF
// Lanza Proceso de Pedidos de REMOTO
FOR x:=1 TO len(aNomFiles)
origen:=nTmpDir+"\"+aNomFiles[x]
destino:="C:\REMOTO\INTER\"+aNomFiles[x]
COPY FILE &origen TO &destino
NEXT
IF file("C:\REMOTO\INTER\PED2TAJ.RAR")
MsgMeter({| oMeter, oText,oDlg, lEnd | ;
MeterPedido( oMeter, oText, oDlg, @lEnd ) },;
"Preparando Datos ...","Sincronizando")
dbSelectArea(78)
IF CsLockRec()
lpop3->fproce:=date()
CsUnLock()
ENDIF
ELSE
MsgInfo("No Encuentro el Fichero:"+chr(13)+;
"C:\REMOTO\INTER\PED2TAJ.RAR",OemToAnsi("Informaci¢n"))
ENDIF
CASE "Ficheros Maestros:"$alltrim(cAsunto)
dbSelectArea(78)
IF CsInsertRec()
fieldput(1,dFecha)
fieldput(2,alltrim(cOrigen))
fieldput(3,alltrim(cAsunto))
nTmpDir:=TmpDir()
fieldput(5,nTmpDir)
FOR x:=1 TO len(aNomFiles)
fieldput(4,alltrim(fieldget(4))+alltrim(aNomFiles[x])+",")
nHanLer:=FCREATE("tmpmime.txt")
FWRITE(nHanLer,aTexFiles[x],len(aTexFiles[x]))
FCLOSE(nHanLer)
FMIMEDEC("tmpmime.txt",nTmpDir+"\"+alltrim(aNomFiles[x]))
NEXT
fieldput(7,date())
fieldput(8,time())
ENDIF
// Lanza Proceso de Recepcion de REMOTO
FOR x:=1 TO len(aNomFiles)
origen:=nTmpDir+"\"+aNomFiles[x]
destino:="C:\REMOTO\INTER\"+aNomFiles[x]
COPY FILE &origen TO &destino
NEXT
IF file("C:\REMOTO\INTER\OBR2TAJ.RAR")
MsgMeter({| oMeter, oText,oDlg, lEnd | ;
MeterRecibe( oMeter, oText, oDlg, @lEnd ) },;
"Preparando Datos ...","Sincronizando")
dbSelectArea(78)
IF CsLockRec()
lpop3->fproce:=date()
CsUnLock()
ENDIF
ELSE
MsgInfo("No Encuentro el Fichero:"+chr(13)+;
"C:\REMOTO\INTER\OBR2TAJ.RAR",OemToAnsi("Informaci¢n"))
ENDIF
ENDCASE
NEXT
oMeter1:Set(oMeter1:nTotal)
SysRefresh()
oDlg:End()
RETURN nil
static FUNCTION MeterRecibe( oMeter, oText, oDlg, lEnd )
Apertura({20})
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.FPT'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.NDF'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
WaitRun('RAR.EXE e -o+ -pxxxxxx C:\REMOTO\INTER\OBR2TAJ.RAR C:\REMOTO\INTER',6)
origen:="C:\REMOTO\INTER\"
destino:="\"+DIRECTORIO+"\"+cCamp+"\"
aOrigen:=DIRECTORY('C:\REMOTO\INTER\@*.*')
oMeter:nTotal = len(aOrigen)+2
FOR x:=1 TO len(aOrigen)
origen2:=destino2:=""
origen2:=origen+aOrigen[x,1]
destino2:=destino+aOrigen[x,1]
COPY FILE &origen2 TO &destino2
oMeter:Set(x)
SysRefresh()
NEXT
oMeter:Set(x+1)
SysRefresh()
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.FPT'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.NDF'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
oMeter:Set(x+2)
SysRefresh()
Cierre({20})
dbCommitAll()
RETURN
static FUNCTION MeterPedido( oMeter, oText, oDlg, lEnd )
Apertura({20,81,82})
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.FPT'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.NDF'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
WaitRun('RAR.EXE e -o+ -pxxxxxx C:\REMOTO\INTER\PED2TAJ.RAR C:\REMOTO\INTER',6)
origen:="C:\REMOTO\INTER\"
destino:="\"+DIRECTORIO+"\"+cCamp+"\"
aOrigen:=DIRECTORY('C:\REMOTO\INTER\@*.*')
oMeter:nTotal = len(aOrigen)+2
FOR x:=1 TO len(aOrigen)
origen2:=destino2:=""
origen2:=origen+aOrigen[x,1]
destino2:=destino+aOrigen[x,1]
COPY FILE &origen2 TO &destino2
oMeter:Set(x)
SysRefresh()
NEXT
dbSelectArea(81)
append from C:\REMOTO\INTER\$pedido.ndf
dbSelectArea(82)
append from C:\REMOTO\INTER\$lped.ndf
oMeter:Set(x+1)
SysRefresh()
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.FPT'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
AEVAL(DIRECTORY('C:\REMOTO\INTER\*.NDF'), {|x| ferase("C:\REMOTO\INTER\"+x[1]) })
oMeter:Set(x+2)
SysRefresh()
Cierre({20,81,82})
dbCommitAll()
RETURN