enviar correo con archivo adjunto desde Vpro5

Edgar Guevara

unread,

Aug 14, 2013, 7:43:41 PM8/14/13

to mund...@googlegroups.com

Buenas Tardes,

Estimados colegas, sé que el tema se ha tratado, pero no encuentro el correo.

Lo que requiero es enviar correo por gmail con archivo adjunto.

Alguien tiene alguna rutina para vpro5.

Gracias de antemano,

Saludos

Luis Alfonso Sanchez

unread,

Aug 15, 2013, 12:48:52 PM8/15/13

to mund...@googlegroups.com

Hola, Este programa era el que utilizaba hace años en vpro5 , recuerdo que funcionaba muy bien espero te sea de ayuda , esta documentado cualquier consulta nos avisas.

SALUDOS

MAIL.BBX

0015 REM Hecho por Luis Alfonso Sanchez

0020 REM mail.bbx 26/09/2004

0030 ENTER TO$,FROM$,SUBJECT$,MESSAGE$,ATTACHMENTS$,HOST$,PORT

0040 rem to$ = remitente del correo

0041 rem from$= quien envio el correo$

0042 rem subject$ = texto asunto del correo

0043 rem message$= cuerpo del correo

0044 rem attachments$= archivo adjunto ejemplo : "C:/tmp/archivo.xls";rem en algunas ocaciones hay que agregar un terminador $0A$

0045 rem HOST$= nombre del cominio por ejemplo gmail.com

0046 rem port = puerto del smtp puerto por default = 25

0110 REM "Nombre del Servidor y puerto

0120 IF HOST$="" THEN LET HOST$="hotmail.com"

0130 IF PORT=0 THEN LET PORT=25

0300 REM Configuracion del servidor

0320 LET INT=UNT; OPEN (INT,MODE="host="+HOST$+",port="+STR(PORT))"N0"

0330 LET OUT=INT

0340 GOTO 0400

0410 LET O$="EHLO"+HOST$,I$="250"; GOSUB MAIL

0420 LET O$="MAIL From:<"+FROM$+">",I$="250"; GOSUB MAIL

0430 LET O$="RCPT To:<"+TO$+">",I$="250"; GOSUB MAIL

0440 LET O$="DATA",I$="354"; GOSUB MAIL

0510 REM "Remitente del mensaje .

0520 LET BOUNDARY$="----=_Ructura_de_Control_para_Mensajes_MultiPartes",I$=""

0530 LET O$="From: "+FROM$; GOSUB MAIL

0540 LET O$="To: "+TO$; GOSUB MAIL

0550 LET O$="Subject: "+SUBJECT$; GOSUB MAIL

0560 LET O$="MIME-Version: 1.0"; GOSUB MAIL

0570 LET O$="Content-Type: multipart/mixed;"; GOSUB MAIL

0580 LET O$=$09$+"boundary="""+BOUNDARY$+""""; GOSUB MAIL

0590 LET O$=""; GOSUB MAIL

0600 LET O$="Mensaje de Multiples partes (formato MIME)"; GOSUB MAIL

0610 LET O$=""; GOSUB MAIL

2000 REM 2000

2010 LET O$="--"+BOUNDARY$; GOSUB MAIL

2020 LET O$="Content-Type: text/plain; charset=us-ascii"; GOSUB MAIL

2030 LET O$="Content-Transfer-Encoding: quoted-printable"; GOSUB MAIL

2040 LET O$=""; GOSUB MAIL

2050 LET O$=MESSAGE$; GOSUB MAIL

2060 LET O$="--"+BOUNDARY$; GOSUB MAIL

2070 LET TEMP=POS($0D0A$=ATTACHMENTS$); IF TEMP=0 THEN GOTO 2210

2080 LET FILE$=ATTACHMENTS$(1,TEMP-1),ATTACHMENTS$=ATTACHMENTS$(TEMP+2)

2090 LET FR=UNT; OPEN (FR,ISZ=-1,ERR=2070)FILE$

2100 LET FILE_NAME$=FILE$(1+POS("/"=FILE$,-1))

2110 REM "attachments on MIME format: text/binary"

2120 LET O$="Content-Type: text/binary; name="""+FILE_NAME$+""""; GOSUB MAIL

2130 LET O$="Content-Transfer-Encoding: base64"; GOSUB MAIL

2140 LET O$="Content-Disposition: attachment; filename="""+FILE_NAME$+""""; GO

2140:SUB MAIL

2150 LET O$=""; GOSUB MAIL

2160 READ RECORD(FR,SIZ=57,END=2180)O$

2170 CALL "BASE64.BBX",0,O$; GOSUB MAIL; GOTO 2160

2180 LET O$="--"+BOUNDARY$; GOSUB MAIL

2190 CLOSE (FR)

2200 GOTO 2070

2210 LET O$=".",I$="250"; GOSUB MAIL

2220 LET O$="QUIT",I$="221"; GOSUB MAIL

2230 CLOSE (INT)

2240 CLOSE (OUT)

2250 EXIT

2260 MAIL:

2270 PRINT (INT)O$; IF I$="" THEN RETURN

2280 LET IN$=""; READ (OUT,TIM=10,ERR=2290)IN$

2290 IF POS(I$+" "=IN$)<>1 THEN GOTO 2280

2300 RETURN

PROGRAMA 2:

BASE64.BBX

0010 REM Encode/Decode Base64" 27/10/2004

0015 REM hecho por : Luis Alfonso Sanchez

0020 ENTER FUNCTION,STRING$

0030 REM "

0040 REM " FUNCTION = 0 codifica

0050 REM " 1 decodifica

0060 REM "

0070 REM " STRING$ = (cadena a codificar o decodificar)

0080 REM "

0100 REM ^100

0110 LET TBL$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+

0110:/"

0120 REM

0130 ON FUNCTION GOTO 0200,0300

0200 REM ^100

0210 REM "codificar

0220 LET PAD=MOD(LEN(STRING$),3)

0230 IF PAD THEN LET PAD=3-PAD,STRING$=STRING$+FILL(PAD,$00$)

0240 FOR POS=1 TO LEN(STRING$) STEP 3; LET NUM=DEC($00$+STRING$(POS,3)); FOR B

0240:ASE=18 TO 0 STEP -6; LET CHAR=MOD(INT(NUM/2^BASE),64),NUM=NUM-CHAR*2^BASE

0240:,RSLT$=RSLT$+TBL$(1+CHAR,1); NEXT BASE

0250 NEXT POS; IF PAD THEN LET RSLT$(1+LEN(RSLT$)-PAD)="=="

0260 GOTO 9910

0300 REM ^100

0310 REM "decodifica

0320 LET PAD=POS("="=STRING$)

0330 IF PAD THEN LET STRING$(PAD)=FILL(PAD,TBL$(1,1)),PAD=LEN(STRING$(PAD))

0340 FOR POS=1 TO LEN(STRING$) STEP 4; LET NUM=(POS(STRING$(POS,1)=TBL$)-1)*2^

0340:18+(POS(STRING$(POS+1,1)=TBL$)-1)*2^12+(POS(STRING$(POS+2,1)=TBL$)-1)*2^6

0340:+(POS(STRING$(POS+3,1)=TBL$))-1,RSLT$=RSLT$+BIN(NUM,3)

0350 NEXT POS; IF PAD THEN LET RSLT$=RSLT$(1,LEN(RSLT$)-PAD)

0360 GOTO 9910

9910 REM 9910"END OF PROGRAM

9920 LET STRING$=RSLT$

9930 STOP

--
Has recibido este mensaje porque estás suscrito al grupo "MundoBBx" de Grupos de Google.
Para anular la suscripción a este grupo y dejar de recibir sus correos electrónicos, envía un correo electrónico a mundobbx+u...@googlegroups.com.
Para obtener más opciones, visita https://groups.google.com/groups/opt_out.

--

--------------------------------------------------
Luis Alfonso Sánchez Del Castillo

Edgar Guevara

unread,

Aug 15, 2013, 1:09:44 PM8/15/13

to mund...@googlegroups.com

Gracias por la pronta respuesta. Lo voy a probar.
Muchas gracias....

programadorbi

unread,

Dec 3, 2015, 10:00:18 AM12/3/15

to MundoBBx

Estimado Luis Alfonso,

Tengo el problema que me da error 12 al abril el puerto NO, específicamente en la linea 320.

Me podes dar una ayuda.

Gracias

Luis Alfonso Sanchez

unread,

Dec 3, 2015, 10:53:13 AM12/3/15

to mund...@googlegroups.com

Revisa si en el config.bbx que utilizas se encuentra esta linea

ALIAS N0 TCP "" NODELAY

Para anular la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a mundobbx+u...@googlegroups.com.
Para acceder a más opciones, visita https://groups.google.com/d/optout.

cseguel

unread,

Dec 3, 2015, 1:04:41 PM12/3/15

to mund...@googlegroups.com

Luis Alfonso, me he colgado a esta rutina que me parece muy buena y tengo la misma necesidad que Edgar Guevara.

Sin embargo, al agregar el ALIAS N0 TCP "" NODELAY que tú indicas (en el config.bbx), al ejecutar la aplicación me arroja lo siguiente:

¿Me faltará algo en el config?

Gracias.

Luis Jiménez M.

unread,

Dec 3, 2015, 1:37:18 PM12/3/15

to mund...@googlegroups.com

Estimado

Puede mandar las primeras líneas del config que esta usando, creo que se puede haber quedado cortos con la cantidad de alias

El software de antivirus Avast ha analizado este correo electrónico en busca de virus.
www.avast.com

image001.png

Luis Alfonso Sanchez

unread,

Dec 3, 2015, 3:56:42 PM12/3/15

to mund...@googlegroups.com

Agregale al ALIASES =

si tiene por ejemplo 10 ponle 11 o mayor

cseguel

unread,

Dec 3, 2015, 7:53:27 PM12/3/15

to mund...@googlegroups.com

Perfecto, muchas gracias.

CEMS

unread,

Dec 10, 2015, 11:37:17 PM12/10/15

to MundoBBx

Hola Edgar

lo que pides no es fácil, Gmail usa autenticacion XOAUTH2 para el uso de su plataforma donde se encuentran sus servidor SMTP.

te recomiendo leas este articulo:

https://developers.google.com/gmail/xoauth2_protocol

Saludos cordiales,

CEMS

unread,

Dec 11, 2015, 12:25:33 AM12/11/15

to MundoBBx

Hola Edgar

Anexo te dejo el original del programa de quien se atribuye su autoria (Luis Alfonso Sanchez), vaya nunca pensé llegar a esto!! jajaja...

La versión que te dejo soporta autenticacion XOAUTH2 y cifrado SSL características requeridas para poder conectar con servidores de Google.

Podrás probar como funciona el programa en el siguiente link:

Envío de Correo Electrónico

colocar la clave "demo" cuando le sea solicitado.

0010 rem 0010"^EMAIL.SMTP""BBx7.3""Send E-Mail via SMTP""CEMS, 01/28/2003
0020 rem " 
0030 rem "by (por): Carlos E. Mendoza S., 01/28/2003
0040 rem "Copyright (c) 2003-&up INGENIX Consulting-VE.  All rights reserved.
0050 rem "
0060 rem "INGENIX 21 grants you a royalty free license to use or modify this
0070 rem "software provided that this copyright notice appears on all copies.
0080 rem "This software is provided "AS IS," without a warranty of any kind.
0090 rem "
0100 rem "INGENIX 21 le otorga una licencia gratuita para usar y/o modificar
0110 rem "este software siempre que mantenga este COPYRIGHT en todas las copia
0110:s.
0120 rem "Este software es entregado "COMO ESTA", sin ningun tipo de garantia.
0130 rem 
0140 seterr 0160
0150 enter FROM$,TO$,CC$,BCC$,SUBJECT$,MESSG$,ATTACH$,HOST$,PORT,USR$,PWD$,ERR
0150:$
0160 let SMTP_HOST$=HOST$,SMTP_PORT=PORT
0170 seterr 9330; rem setesc 9340
0180 gosub 9000
0200 rem ^100
0210 rem "Fully Qualified Domain Name
0220 let FQDN$="[ localhost ]"
0230 rem 
0240 rem "Hay Servidores que requieren un FQDN valido
0250 rem "de ser el caso, tildee la casilla FQDN en la plantilla de correo
0260 if pos("FQDN"=SMTP_FLAG$)=0 then goto 0700
0270 let TMP=pos("FQDN_URL="=cvs(SMTP_FLAG$,4))+9
0280 if TMP>9 then let FQDN_URL$=ath(SMTP_FLAG$(TMP,pos(" "=SMTP_FLAG$(TMP)+" 
0280:")-1))
0290 if FQDN_URL$="" then let FQDN_URL$="http://ipecho.net/plain"
0300 let TMP=pos(";"=FQDN_URL$+";"),URL$=FQDN_URL$(1,TMP-1)
0310 let FQDN_URL$=FQDN_URL$(min(len(FQDN_URL$)+1,TMP+1))
0320 rem 
0330 rem "Establece conexion con el servidor HOST$ via HTTP (PORT=80)
0340 let HOST$=""; call "^PROTO.TCP",HOST$,PORT,URL$
0350 let FLAG$="PROTOCOL=http "+HTTP_FLAG$,CONFIG$=HTTP_CONFIG$
0400 rem ^100
0410 rem "General Request Method (GET or POST)
0420 let SEND$=URL$+CR$
0430 let SEND$=SEND$+"Connection: close"+CR$
0440 let REPLY$=""; gosub REQUEST
0450 if VERBOSE>1 then let TMP$="* "+RCVD$; gosub 5320
0460 let TMP=pos(CR$+"HTTP/1."=SEND$)+len(CR$)
0470 if num(SEND$(TMP+9,3),err=0600)<>200 then goto 0600
0480 rem 
0490 let TMP=pos(";"=FQDN_URL$+";"),TMP$=FQDN_URL$(1,TMP-1)
0500 let FQDN_URL$=FQDN_URL$(min(len(FQDN_URL$)+1,TMP+1))
0510 let TMP=1; if TMP$>"" then let TMP=pos(TMP$=RCVD$); if TMP=0 then goto 04
0510:90
0520 let TMP$=RCVD$(TMP+len(TMP$),pos(" ">RCVD$(TMP+len(TMP$))+" ")-1)
0530 if TMP$>"" then goto 0560
0540 if FQDN_URL$="" then goto 0600
0550 goto 0490
0560 let TMP=num(TMP$(1,3),err=0580)
0570 if TMP and pos("."=TMP$(4))=1 then let TMP$="[ "+TMP$+" ]"
0580 let FQDN$=TMP$
0600 rem ^100
0610 if VERBOSE>0 then let TMP$="* FQDN="+FQDN$; gosub 5300
0700 rem ^100
0710 rem "Verifica si la Autenticacion es XOAUTH2 para obtener el token
0720 let TMP$="XOAUTH_TOKEN="; gosub 9170; if TMP=0 then goto 1100
0730 let XOAUTH_TOKEN$=ath(VALUE$)
0740 let CLIENT_ID$="449055871565-33ohlrn627cphetugqtqj2mgj5f6mulr.apps.google
0740:usercontent.com"
0750 let CLIENT_SECRET$="dd_7FybVl85YSwFyxTY5quj4"
0760 let REDIRECT_URI$="http://host.ingenix21.com.ve/cgi-bin/sinfonix.pl?xoaut
0760:h"
0770 rem 
0780 rem "Establece conexion con el servidor HOST$ via HTTPS (PORT=443)
0790 let URL$="https://www.googleapis.com/oauth2/v3/token"
0800 let HOST$=""; call "^PROTO.TCP",HOST$,PORT,URL$
0810 let FLAG$="PROTOCOL=http "+HTTP_FLAG$,CONFIG$=HTTP_CONFIG$
0900 rem ^100
0910 rem "General Request Method (GET or POST)
0920 let SEND$=URL$+CR$
0930 let SEND$=SEND$+"Content-Type: application/x-www-form-urlencoded"+CR$
0940 let SEND$=SEND$+"Connection: close"+CR$
0950 let SEND$=SEND$+""+CR$
0960 let SEND$=SEND$+"code="+XOAUTH_TOKEN$+"&"
0970 let SEND$=SEND$+"client_id="+CLIENT_ID$+"&"
0980 let SEND$=SEND$+"client_secret="+CLIENT_SECRET$+"&"
0990 let SEND$=SEND$+"redirect_uri="+REDIRECT_URI$+"&"
1000 let SEND$=SEND$+"grant_type=authorization_code&"
1010 let REPLY$=""; gosub REQUEST
1020 rem 
1030 let TMP=pos($22$+"access_token"+$22$=RCVD$)
1040 if TMP=0 then goto 1110
1050 let TMP$=RCVD$(TMP+14),TMP=pos($22$=TMP$)
1060 if TMP=0 then goto 1110
1070 let ACCESS_TOKEN$=TMP$(TMP+1,pos($22$=TMP$(TMP+1)+$22$)-1)
1080 if VERBOSE>0 then let TMP$="* ACCESS_TOKEN="+ACCESS_TOKEN$; gosub 5300
1100 rem ^100
1110 rem "Establece conexion con el servidor HOST$ via SMTP (PORT=25) 
1120 let HOST$=SMTP_HOST$,PORT=SMTP_PORT
1130 let FLAG$="PROTOCOL=smtp "+SMTP_FLAG$,CONFIG$=SMTP_CONFIG$
1200 rem ^100
1210 let SEND$="EHLO "+FQDN$,REPLY$="250"; gosub REQUEST
1220 rem 
1230 if pos("STARTTLS"=RCVD$)=0 or SSL<>2 or SCHEME=0 then goto 1270
1240 let SEND$="STARTTLS",REPLY$="220"; gosub REQUEST
1250 let SEND$="EHLO "+FQDN$,REPLY$="250"; gosub REQUEST
1260 rem 
1270 if pos("XOAUTH2"=RCVD$)=0 or pos("XOAUTH2"=FLAG$)=0 then goto 1320
1280 let SASL$="user="+USR$+$01$+"auth=Bearer "+ACCESS_TOKEN$+$0101$
1290 call "^BASE64",0,SASL$
1300 let SEND$="AUTH XOAUTH2 "+SASL$,REPLY$="235"; gosub REQUEST
1310 goto 1510
1320 if pos("PLAIN"=RCVD$)=0 or pos("PLAIN"=FLAG$)=0 then goto 1360
1330 let SECRET$=$00$+USR$+$00$+PWD$; call "^BASE64",0,SECRET$
1340 let SEND$="AUTH PLAIN "+SECRET$,REPLY$="235"; gosub REQUEST
1350 goto 1510
1360 if pos("LOGIN"=RCVD$)=0 or pos("LOGIN"=FLAG$)=0 then goto 1510
1400 rem ^100
1410 let SEND$="AUTH LOGIN",REPLY$="334",PRINT$="ON"; gosub REQUEST
1420 let SEND$=USR$,REPLY$="334"; call "^BASE64",0,SEND$; gosub REQUEST
1430 let SEND$=PWD$,REPLY$="235"; call "^BASE64",0,SEND$; gosub REQUEST
1500 rem ^100
1510 let SEND$="MAIL From: <"+FROM$+">",REPLY$="250"; gosub REQUEST
1600 rem ^100
1610 let RCPT$=TO$+";"+CC$+";"+BCC$
1700 rem ^100
1710 gosub SPLIT_RCPT
1720 if MAIL$>"" then let SEND$="RCPT To: <"+MAIL$+">"; gosub REQUEST
1730 if RCPT$>"" then goto 1710
1740 let SEND$="DATA",REPLY$="354"; gosub REQUEST
2000 rem 2000
2010 rem "Header Message
2020 let BOUNDARY$="----=_NextPart_00_"+hta(day+str(tim)),REPLY$="",PRINT$="ON
2020:"
2030 rem 
2040 let SEND$="To: "+TO$; gosub REQUEST
2050 let SEND$="Cc: "+CC$; gosub REQUEST
2060 let SEND$="Subject: "+SUBJECT$; gosub REQUEST
2100 rem ^100
2110 let SEND$="From: "+FROM$; gosub REQUEST
2120 let SEND$="User-Agent: Sinfonix 2000 E-Mail"; gosub REQUEST
2130 let SEND$="X-Mailer: Sinfonix 2000 - INGENIX Consulting VE"; gosub REQUES
2130:T
2140 let SEND$="MIME-Version: 1.0"; gosub REQUEST
2150 let SEND$="Content-Disposition: inline;"; gosub REQUEST
2160 let SEND$="Content-Type: multipart/mixed;"; gosub REQUEST
2170 let SEND$=$09$+"boundary="""+BOUNDARY$+""""; gosub REQUEST
2180 let SEND$=""; gosub REQUEST
2200 rem ^100
2210 let SEND$="Mensaje de Multiples partes (MIME Format)"; gosub REQUEST
2220 let SEND$=""; gosub REQUEST
2230 let SEND$="--"+BOUNDARY$; gosub REQUEST
2300 rem ^100
2310 rem "(Text/Plain) Message
2320 if TXT_MESSG$="" then goto 2500
2330 let SEND$="Content-Type: text/plain;"; gosub REQUEST
2340 let SEND$=$09$+"charset=us-ascii"; gosub REQUEST
2350 let SEND$="Content-Transfer-Encoding: quoted-printable"; gosub REQUEST
2360 let SEND$=""; gosub REQUEST
2370 let SEND$=TXT_MESSG$; gosub REQUEST
2380 let SEND$="--"+BOUNDARY$
2390 if HTM_MESSG$="" and ATTACH$="" then let SEND$=SEND$+"--"
2400 gosub REQUEST
2500 rem ^100
2510 rem "(Text/Html) Message
2520 if HTM_MESSG$="" then goto 2700
2530 let SEND$="Content-Type: text/html;"; gosub REQUEST
2540 let SEND$=$09$+"charset=us-ascii"; gosub REQUEST
2550 let SEND$="Content-Transfer-Encoding: quoted-printable"; gosub REQUEST
2560 let SEND$=""; gosub REQUEST
2570 let SEND$=MESSG$; gosub REQUEST
2580 let SEND$="--"+BOUNDARY$
2590 if ATTACH$="" then let SEND$=SEND$+"--"
2600 gosub REQUEST
2700 rem ^100
2710 rem "Attachments on MIME format: application/octet-stream;"
2720 if ATTACH$="" then goto 3010
2730 let TEMP=pos($0D0A$=ATTACH$)
2740 if TEMP=0 then let ATTACH$=ATTACH$+$0D0A$; goto 2730
2750 let FILE$=ATTACH$(1,TEMP-1),ATTACH$=ATTACH$(TEMP+2)
2760 let CHANNEL=unt; open (CHANNEL,isz=-1,err=2720)FILE$
2770 let FILE_NAME$=FILE$(1+pos("/"=FILE$,-1))
2800 rem ^100
2810 let SEND$="Content-Type: application/octet-stream;"; gosub REQUEST
2820 let SEND$=$09$+"name="""+FILE_NAME$+""""; gosub REQUEST
2830 let SEND$="Content-Transfer-Encoding: base64"; gosub REQUEST
2840 let SEND$="Content-Disposition: attachment;"; gosub REQUEST
2850 let SEND$=$09$+"filename="""+FILE_NAME$+""""; gosub REQUEST
2860 let SEND$=""; gosub REQUEST
2870 rem 
2880 read record(CHANNEL,siz=54,end=2910)SEND$
2890 call "^BASE64",0,SEND$; gosub REQUEST
2900 goto 2880
2910 let SEND$="--"+BOUNDARY$; if ATTACH$="" then let SEND$=SEND$+"--"
2920 gosub REQUEST
2930 close (CHANNEL)
2940 goto 2720
3000 rem ^100
3010 rem "End of Message...
3020 let SEND$=".",REPLY$="250"; gosub REQUEST
3030 let SEND$="QUIT",REPLY$="221"; gosub REQUEST
3040 goto 9910
3050 rem 
5000 rem 5000"Sub-Routine 
5100 rem ^100
5110 rem "Split the Recipient
5120 SPLIT_RCPT: 
5130 let POS=min(pos(" "=RCPT$+" "),pos(","=RCPT$+","),pos(";"=RCPT$+";"))
5140 let MAIL$=RCPT$(1,POS-1),RCPT$=cvs(RCPT$(min(POS,len(RCPT$))+1),3)
5150 return 
5160 rem 
5200 rem ^100"Submit Request to SMTP Server
5210 REQUEST: 
5220 let TMP_FLAG$=FLAG$
5230 let TMP_FLAG$=TMP_FLAG$+"CRLF="+hta(CR$)+" "
5240 let TMP_FLAG$=TMP_FLAG$+"REPLY="+REPLY$+" "
5250 let TMP_FLAG$=TMP_FLAG$+"PRINT="+PRINT$+" "
5260 call "^PROTO.TCP",HOST$,PORT,SEND$,RCVD$,CONFIG$,TMP_FLAG$
5270 let ERR$=TMP_FLAG$; if ERR$>"" then goto 9910
5280 return 
5300 rem ^100"TRACE Process
5310 let TMP$=TMP$+CR$
5320 rem 
5330 let TMP=pos(" "=TMP$),PF$=""
5340 if TMP then let PF$=TMP$(1,TMP),TMP$=TMP$(TMP+1)
5350 if fid(0)<>"IO" then goto 5370
5360 let Z$="<",X$="&lt;"; gosub 5410
5370 let TMP=pos(CR$=TMP$)
5380 if TMP then print PF$+TMP$(1,TMP-1); let TMP$=TMP$(TMP+len(CR$)); goto 53
5380:70
5390 if TMP$>"" then print PF$+TMP$,
5400 return 
5410 let TMP=pos(Z$=TMP$); if TMP=0 then return 
5420 let TMP$=TMP$(1,TMP-1)+X$+TMP$(TMP+len(Z$))
5430 goto 5410
9000 rem 9000,5"DEFINITION SECTION
9005 call "^DFILS",0,STDIO$
9010 let SMTP_FLAG$=ERR$,ERR$="",CR$=$0A$
9015 if SMTP_FLAG$="" then let SMTP_FLAG$="VERBOSE LEVEL=3 FQDN "
9020 if pos("VERBOSE "=SMTP_FLAG$)=0 then goto 9035
9025 let TMP$="LEVEL="; gosub 9170; let VERBOSE=VALUE
9030 let HTTP_FLAG$=HTTP_FLAG$+"VERBOSE LEVEL="+str(VERBOSE)+" "
9035 if pos("SSL "=SMTP_FLAG$) then let SSL=1
9040 if pos("STARTTLS "=SMTP_FLAG$) then let SSL=2
9045 if pos("OPENSSL "=SMTP_FLAG$) then let SCHEME=1
9050 if pos("GNUTLS "=SMTP_FLAG$) then let SCHEME=2
9055 rem 
9060 let TXT_MESSG$=MESSG$(1,pos($00$=MESSG$+$00$)-1)
9065 let HTM_MESSG$=MESSG$(min(len(MESSG$)+1,pos($00$=MESSG$+$00$)+1))
9070 rem 
9075 if VERBOSE=0 and pgm(-1)<>pgm(-2) then goto 9085
9080 if fid(0)<>"IO" then print 'CS',; let VERBOSE=2
9085 goto 9135
9090 rem 
9100 if USR$="" then let USR$="x@y",PWD$="*******"
9105 if TO$="" then let TO$="x@y"
9110 if CC$="" then let CC$="x@y"
9115 if BCC$="" then let BCC$="x@y"
9120 if SUBJECT$="" then let SUBJECT$="prueba de email via SMTP"
9125 if MESSG$="" then let MESSG$=SUBJECT$
9130 if ATTACH$="" then let ATTACH$="/sinfonix/logoingenix.gif"
9135 rem 
9140 if FROM$="" then let FROM$=USR$
9145 if SMTP_HOST$="" then let SMTP_HOST$="localhost",SMTP_PORT=80
9150 if SMTP_HOST$="" and pos("@"=USR$) then let SMTP_HOST$="smtp."+USR$(pos("
9150:@"=USR$)+1),SMTP_PORT=25
9155 if SMTP_HOST$="" and USR$>"" then let SMTP_HOST$="localhost",SMTP_PORT=25
9160 if FROM$="" and SMTP_HOST$="" then let ERR$=ERR$+"host no found"+$0D0A$; 
9160:goto 9910
9165 return 
9170 let TMP=pos(TMP$=cvs(SMTP_FLAG$,4)); if TMP=0 then return 
9175 let TMP$=SMTP_FLAG$(TMP,pos(" "=SMTP_FLAG$(TMP)+" ")-1)
9180 if pos("="=TMP$)=0 then let TMP$=""; return 
9185 let VALUE$=TMP$(pos("="=TMP$)+1)
9190 let VALUE=0,VALUE=num(VALUE$,err=9195)
9195 return 
9300 rem 9300"ROUTINE PROGRAM
9310 rem 
9320 rem "ERROR I/O FILE
9330 call "^IOERR",err,tcb(5),"^EMAIL.SMTP"; retry
9340 return ; rem "Press ESC... retry
9700 rem 9700"READ TABLE
9710 let Z$=cvs(Z$,2); find record(FILES+1,key=Z$,dom=9720)Z$; return 
9720 dim Z$(100); return 
9730 def fnSEEK$(SEEKKEY$,FILE_ID$)=fnBIT$(SEEKKEY$+$00$,FILE_ID$,$00FF$,max(p
9730:os($00$<>SEEKKEY$,-1),1))
9740 def fnBIT$(SEEKKEY$,FILE_ID$,MOST$,LENGTH)=SEEKKEY$(1,LENGTH-1)+chr(max(a
9740:sc(SEEKKEY$(LENGTH)),1)-1)+fill(max(asc(FILE_ID$(2))-LENGTH,0),MOST$(1+mi
9740:n(1,asc(SEEKKEY$(LENGTH))),1))
9800 rem 9800"EDIT ERROR
9810 print (0,err=9810)'RB',; return 
9900 rem 9900"END OF PROGRAM
9910 close (OUT,err=9920)
9920 close (IN,err=9930)
9930 rem 
9940 if VERBOSE=0 then goto 9970
9950 if ERR$>"" then let TMP$="* !ERROR="+ERR$; gosub 5300
9960 if fid(0)="IO" then release 
9970 seterr 9980; exit 
9980 stop

0010 rem 0010"^PROTO.TCP""BBx7.3""Internet Protocol Handler""CEMS, 01/10/2006
0020 rem " 
0030 rem "by (por): Carlos E. Mendoza S., 01/10/2006
0040 rem "Copyright (c) 2003-&up INGENIX Consulting-VE.  All rights reserved.
0050 rem "
0060 rem "INGENIX 21 grants you a royalty free license to use or modify this
0070 rem "software provided that this copyright notice appears on all copies.
0080 rem "This software is provided "AS IS," without a warranty of any kind.
0090 rem "
0100 rem "INGENIX 21 le otorga una licencia gratuita para usar y/o modificar
0110 rem "este software siempre que mantenga este COPYRIGHT en todas las copia
0110:s.
0120 rem "Este software es entregado "COMO ESTA", sin ningun tipo de garantia.
0130 rem 
0140 seterr 0150; enter HOST$,PORT,REQUEST$,RESPONSE$,CONFIG$,FLAG$
0150 seterr 9330; rem setesc 9340
0200 rem ^100
0210 rem "Prepare the connection environment
0220 gosub 9000; gosub 8000
0300 rem ^100
0310 rem "Connects to server HOST$:PORT
0320 gosub OPEN_PORT
0400 rem ^100
0410 rem "Starts Transmission According the Protocol
0420 on PROTOCOL-1 goto HTTP,SMTP,POP3,IMAP,FTP,XMPP
0430 rem 
0500 rem ^100"HTTP Protocol Handler
0510 HTTP: 
0520 let SEND$="",TMP=pos(CR$=REQUEST$)
0530 if TMP=0 then let REQUEST$=REQUEST$+CR$; goto 0520
0540 let URL$=cvs(REQUEST$(1,TMP-1),3),REQUEST$=REQUEST$(TMP)
0550 if URL$="" then let URL$="/"
0560 rem 
0570 let METHOD$="GET",TMP=pos(CR$+CR$=REQUEST$); if TMP=0 then goto 0590
0580 let METHOD$="POST",CONTENT_LENGTH=len(REQUEST$(TMP+len(CR$)*2))
0590 rem 
0600 let TMP=pos(URL$(1,pos(" "=URL$+" ")-1)=CMD_HTTP$)
0610 if TMP=0 then let URL$=METHOD$+" "+URL$
0620 rem 
0630 let TMP=pos("HTTP/1."=URL$(pos(" "=" "+URL$,-1)))
0640 if TMP<>1 then let URL$=URL$+" HTTP/1.1"
0650 rem 
0660 let SEND$=SEND$+URL$+CR$
0700 rem ^100
0710 rem "Http DEFAULT Header
0720 let TMP$=CR$+"User-Agent: Sinfonix2000/1.0"; gosub 8600
0730 let TMP$=CR$+"Host: "+HOST$; gosub 8660; gosub 8600
0740 let TMP$=CR$+"Accept: */*"; gosub 8600
0750 if CONTENT_LENGTH=0 then goto 0770
0760 let TMP$=CR$+"Content-Length: "+str(CONTENT_LENGTH); gosub 8600
0770 rem 
0800 rem ^100
0810 rem "Http EXTENDED Header
0820 if pos("HTTP-HEADER=DEFAULT"=cvs(FLAG$,7)) then goto 0840
0830 let TMP$=CR$+"Accept-Encoding: chunked"; gosub 8600
0840 rem 
0850 let SEND$=SEND$+REQUEST$(len(CR$)+1)
0860 rem 
0870 gosub REQUEST; let REQUEST$=SEND$; rem "Summit Request
0880 rem 
0900 rem ^100"Init Response
0910 let RESPONSE$=""
0920 rem 
0930 rem "Response STATUS Line
0940 gosub RESPONSE; if pos("HTTP/1."=DATA$)=1 then goto 1110
0950 rem 
0960 rem "ERROR Request...
0970 let RESPONSE$=RESPONSE$+"HTTP/1.1 400 Bad Request (Sinfonix2000)"+CR$
0980 let RESPONSE$=RESPONSE$+"Connection: close"+CR$
0990 let RESPONSE$=RESPONSE$+CR$
1000 goto 1620
1100 rem ^100
1110 rem "Response HEADER Lines
1120 let RESPONSE$=RESPONSE$+DATA$; gosub RESPONSE
1130 if DATA$<>$0D0A$ then goto 1110; rem "Next HEADER Line
1200 rem ^100
1210 rem "Content-Length:
1220 let TMP=pos("Content-Length: "=RESPONSE$)+16; if TMP=16 then goto 1310
1230 let LENGTH=num(RESPONSE$(TMP,pos(" ">RESPONSE$(TMP)+" ")-1),err=1610)
1240 let EOF$="",CHUNK$=""
1250 goto 1700
1300 rem ^100
1310 rem "Transfer-Encoding:
1320 let TMP=pos("Transfer-Encoding: "=RESPONSE$)+19; if TMP=19 then goto 1410
1330 let LENGTH=0
1340 let EOF$="",CHUNK$=""
1350 goto 1700
1400 rem ^100
1410 rem "Content-Type:
1420 let TMP=pos("Content-Type: "=RESPONSE$)+14; if TMP=14 then goto 1600
1430 let TMP=pos(": application/json"=RESPONSE$)+18; if TMP=18 then goto 1500
1440 let LENGTH=-1
1450 let EOF$="read:errno=",CHUNK$=""
1460 goto 1700
1500 rem ^100
1600 rem ^100
1610 rem "Error?
1620 let LENGTH=-1
1630 let EOF$="",CHUNK$=""
1640 goto 1700
1700 rem ^100
1710 let HEADER_LENGTH=len(RESPONSE$)
1800 rem ^100
1810 rem "Response BODY Lines
1820 let RESPONSE$=RESPONSE$+DATA$
1830 if VERBOSE>1 then gosub 6720
1840 gosub RESPONSE; if EOF$>"" and pos(EOF$=DATA$)=1 then goto 1880
1850 if LENGTH=-1 then goto 1820 else if LENGTH=0 then goto 1900
1860 let RLEN=RLEN+len(DATA$); if RLEN<LENGTH then goto 1820
1870 let RESPONSE$=RESPONSE$+DATA$
1880 if VERBOSE>1 then gosub 6710
1890 goto 2100
1900 if CHUNK$="" then goto 1930
1910 let RLEN=RLEN+len(DATA$); if RLEN>=CHUNK then let CHUNK$=""
1920 goto 1820
1930 let CHUNK$=DATA$(1,min(pos($0D0A$=DATA$),pos(";"=DATA$+";"))-1)
1940 if mod(len(CHUNK$),2) then let CHUNK$="0"+CHUNK$
1950 let CHUNK$=ath(CHUNK$),RLEN=0,CHUNK=dec($00$+CHUNK$)+1
1960 if CHUNK>1 then goto 1830
1970 if VERBOSE>1 then gosub 6710
1980 rem 
1990 rem "Response FOOTER Lines
2000 gosub RESPONSE; if DATA$=$0D0A$ then goto 2100
2010 let RESPONSE$=RESPONSE$(1,HEADER_LENGTH)+DATA$+RESPONSE$(HEADER_LENGTH+1)
2020 let HEADER_LENGTH=HEADER_LENGTH+len(DATA$)
2030 goto 2000
2100 rem ^100
2110 let TMP=int(pos(RESPONSE$(10,3)="???,100,302,303,307,",4)/4)
2120 on TMP goto 2240,0900,2130
2130 let TMP$=CR$+"Location: "; gosub 8680
2140 if TMP$>"" then let URL$=TMP$(11); gosub 8770 else goto 2240
2150 let TMP_CONFIG$=CONFIG$
2160 if TMP_HOST$=HOST$ and TMP_PORT=PORT then goto 2210
2170 let TMP_CONFIG$=""
2180 let TMP$=CR$+"Connection: close"; gosub 8600
2190 let TMP$=CR$+"Host:"; gosub 8660
2200 rem 
2210 let REQUEST$=URL$+CR$+"Original-METHOD: "+REQUEST$
2220 call "^PROTO.TCP",TMP_HOST$,TMP_PORT,REQUEST$,RESPONSE$,TMP_CONFIG$,FLAG$
2230 goto 2100
2240 rem 
2250 let TMP=pos($0D0A0D0A$=RESPONSE$); if TMP=0 then goto 2280
2260 let REQUEST$=REQUEST$+$0D0A0D0A$+RESPONSE$(1,TMP+4-1)
2270 let RESPONSE$=RESPONSE$(TMP+4)
2280 goto 9910
2290 rem 
2300 rem ^100"SMTP Protocol Handler
2310 SMTP: let SEND$=REQUEST$; gosub REQUEST; if REPLY$="" then goto 9910
2320 rem 
2330 let RESPONSE$="",REPLY=num(REPLY$,err=2340)
2340 gosub RESPONSE; let RESPONSE$=RESPONSE$+DATA$
2350 let TMP=num(DATA$(1,4),err=2340); if TMP<1 or TMP>599 then goto 2340
2360 if TMP<>REPLY then goto 7030
2370 if REQUEST$="STARTTLS" then gosub STARTTLS
2380 goto 9910
2390 rem 
2400 rem ^100"POP3 Protocol Handler
2410 POP3: 
2420 rem 
2500 rem ^100"IMAP Protocol Handler
2510 IMAP: 
2520 rem 
2600 rem ^100"FTP  Protocol Handler
2610 FTP: 
2620 rem 
2700 rem ^100"XMPP Protocol Handler
2710 XMPP: 
2800 rem ^100
5000 rem 5000"Sub-Routine 
5010 rem 
5100 rem ^100"Connects to server 
5110 OPEN_PORT: 
5120 if CMD$+ARG$="" then goto 5150
5130 if pos(str(PROTOCOL)="1")=0 then return 
5140 gosub 6600; if (PID) then return 
5150 rem 
5160 on SSL goto 5200,5400
5200 rem ^100
5210 rem "TELNET  used to establish an BASIC connection
5220 let CMD$="telnet"
5230 let ARG$=" "
5240 let TELNET_CMD$="toggle crlf"+CR$+"open "+HOST$+" "+str(PORT)+CR$
5300 rem ^100
5310 rem "GNUTLS  used to establish an BASIC connection
5311 goto 5680
5320 let CMD$="gnutls-cli"
5330 let ARG$=" "+HOST$+" --port "+str(PORT); rem +" --crlf"
5340 let ARG$=ARG$+" --starttls"
5350 rem CERT$="/sinfonix/tutorial/domain.crt"
5360 rem ARG$=ARG$+" --x509cafile "+CERT$+" --no-ca-verification"
5370 let TELNET_CMD$=""
5380 goto 5680
5400 rem ^100
5410 on SCHEME goto 5510,5510,5610
5500 rem ^100
5510 rem "OPENSSL used to establish an ENCRYPTED connection
5520 let CMD$="openssl"
5530 let ARG$=" s_client -host "+HOST$+" -port "+str(PORT)
5540 let ARG$=ARG$+" -crlf -ign_eof"; rem -quiet"
5550 if SSL=2 then let ARG$=ARG$+" -starttls "+PROTO_NAME$(PROTOCOL*5-4,5)
5560 let TELNET_CMD$=""
5570 goto 5680
5600 rem ^100
5610 rem "GNUTLS  used to establish an ENCRYPTED connection
5620 let CMD$="gnutls-cli"
5630 let ARG$=" "+HOST$+" --port "+str(PORT)+" --crlf"
5640 if SSL=2 then let ARG$=ARG$+" --starttls"
5650 let CERT$="/sinfonix/tutorial/domain.crt"
5660 let ARG$=ARG$+" --x509cafile "+CERT$+" --no-ca-verification"
5670 let TELNET_CMD$=""
5680 rem 
5690 close (IN,err=5700)
5700 close (OUT,err=5710)
5710 rem 
5720 call "^DFILS",0,STDIO$
5730 let CMD_TMP$=CMD$+ARG$+" >"+STDIO$+" 2>&1"
5740 let OUT=unt; open (OUT,err=5740)"|"+CMD_TMP$
5750 let IN=unt; open (IN,err=5740)STDIO$
5760 if VERBOSE>0 then let TMP$="# "+CMD_TMP$; gosub 6800
5770 rem 
5780 if TELNET_CMD$="" then goto 5830
5790 let SEND$=TELNET_CMD$(1,pos(CR$=TELNET_CMD$)-1)
5800 let TELNET_CMD$=TELNET_CMD$(pos(CR$=TELNET_CMD$)+len(CR$))
5810 gosub REQUEST; goto 5780
5820 rem 
5830 let RESPONSE$="",BAK_REPLY$=REPLY$,REPLY$="persistent"
5840 gosub RESPONSE; if RESPONSE$+DATA$="" then goto 5840
5850 let RESPONSE$=RESPONSE$+DATA$; if DATA$<>"" then goto 5840
5860 let REPLY$=BAK_REPLY$
5870 return 
5880 rem 
5900 rem ^100"Submit Request to Server
5910 REQUEST: 
5920 if SEND$="" and pos("PRINT=ON"=FLAG$)=0 then goto 5940
5930 let SEND$=SEND$+CR$; write record(OUT,err=5940)SEND$
5940 if VERBOSE>2 then let TMP$="* "+FLAG$; gosub 6800
5950 if VERBOSE>0 then let TMP$="> "+SEND$; gosub 6820
5960 goto 6100
5970 rem 
6000 rem ^100"Waiting for Server Response
6010 RESPONSE: let DATA$="",TIMEOUT=0
6020 LOOP: read record(IN,tim=10,siz=1,err=TIMEOUT)TMP$
6030 let DATA$=DATA$+TMP$; if TMP$<>$0A$ then goto LOOP
6040 if VERBOSE>0 then let TMP$="< "+DATA$; gosub 6820
6050 goto 6100
6060 TIMEOUT: if TIMEOUT<200000 then let TIMEOUT=TIMEOUT+1; goto LOOP
6070 gosub 6600; if PID=0 then goto 7020
6080 if RESPONSE$+DATA$="" and REPLY$<>"persistent" then goto 7020
6090 return 
6100 rem ^100
6110 if fid(0)="IO" or ASK$<>"" then return 
6120 print (FID0)@(0),"Hit <ENTER> to pause (ANYKEY to Continue) ",
6130 read record(FID0,siz=1)ASK$
6140 print (FID0)@(0),'CL',
6150 if cvs(ASK$,4)="Q" and pgm(-1)=pgm(-2) then escape
6160 if ASK$=$0D$ then let ASK$=""
6170 return 
6180 rem 
6200 rem ^100"START Data Encryption
6210 STARTTLS: 
6220 gosub 6600; if PID=0 then goto 7020
6230 let KILL_CMD$="kill -ALRM "+str(PID)
6240 if VERBOSE>1 then let TMP$="* "+KILL_CMD$; gosub 6800
6250 let TMP=scall(KILL_CMD$)
6260 return 
6270 rem 
6300 rem ^100"End Transmission...
6310 ETX: 
6320 if pos("Connection: close"+CR$=REQUEST$)=0 then goto 6360
6330 close (OUT,err=6340)
6340 close (IN,err=6350)
6350 let OUT=0,IN=0
6360 rem 
6370 let CONFIG$=""
6380 let CONFIG$=CONFIG$+bin(len(HOST$),2)+HOST$
6390 let CONFIG$=CONFIG$+bin(PORT,3)
6400 let CONFIG$=CONFIG$+bin(VERBOSE,3)
6410 let CONFIG$=CONFIG$+bin(SSL,3)
6420 let CONFIG$=CONFIG$+bin(SCHEME,3)
6430 let CONFIG$=CONFIG$+bin(OUT,3)
6440 let CONFIG$=CONFIG$+bin(IN,3)
6450 let CONFIG$=CONFIG$+bin(len(STDIO$),2)+STDIO$
6460 let CONFIG$=CONFIG$+bin(PROTOCOL,3)
6470 let CONFIG$=CONFIG$+bin(len(REPLY$),2)+REPLY$
6480 let CONFIG$=CONFIG$+bin(len(CR$),2)+CR$
6490 let CONFIG$=CONFIG$+bin(len(CMD$),2)+CMD$
6500 let CONFIG$=CONFIG$+bin(len(ARG$),2)+ARG$
6510 let CONFIG$=CONFIG$+bin(FID0,3)
6520 let FLAG$=ERR$
6530 return 
6540 rem 
6600 rem ^100"Process ID (PID)
6610 let TMP$="""_ "+cvs(CMD$+ARG$,2)+""""
6620 let Z$=""; call "^DFILS",0,Z$
6630 let TMP=scall("ps -axf|grep "+TMP$+"|grep -v grep|awk '{print $1}'>"+Z$)
6640 let PID=0,TMP=unt; open (TMP)Z$; read (TMP,err=6650)PID
6650 close (TMP)
6660 if VERBOSE>1 then let TMP$="* pid("+str(PID)+") "+TMP$; gosub 6800
6670 return 
6700 rem ^100"TRACE HTML Process
6710 gosub 6720; let TMP$="  "; gosub 6800; return 
6720 let TMP$="* LENGTH="+str(LENGTH:"###,##0")+", RLEN="+str(RLEN:"###,##0")+
6720:", CHUNK="+str(CHUNK:"###,###0BB"); gosub 6820
6730 return 
6800 rem ^100"TRACE Process 
6810 let TMP$=TMP$+CR$
6820 rem 
6830 let TMP=pos(" "=TMP$),PF$=""
6840 if TMP then let PF$=TMP$(1,TMP),TMP$=TMP$(TMP+1)
6850 if PF$="< " and pos($0D$=TMP$)=0 then let PF$="* "
6860 if fid(0)<>"IO" then goto 6880
6870 let Z$="<",X$="&lt;"; gosub 6930
6880 let TMP=pos($0D$=TMP$); if TMP then let TMP$=TMP$(1,TMP-1)+"^M"+TMP$(TMP+
6880:1); goto 6880
6890 let TMP=pos(CR$=TMP$)
6900 if TMP then print PF$+TMP$(1,TMP-1); let TMP$=TMP$(TMP+len(CR$)); goto 68
6900:80
6910 if TMP$>"" then print PF$+TMP$,
6920 return 
6930 let TMP=pos(Z$=TMP$); if TMP=0 then return 
6940 let TMP$=TMP$(1,TMP-1)+X$+TMP$(TMP+len(Z$))
6950 goto 6930
6960 rem 
7000 rem ^100"ERROR Handler 
7010 let ERR$=ERR$+"Name or service not known"+$0D0A$; goto 9910
7020 let ERR$=ERR$+"Connection reset by peer "+$0D0A$; goto 9910
7030 let ERR$=ERR$+RESPONSE$; goto 9910
7040 let ERR$=ERR$+"unknow error"+$0D0A$; goto 9910
7050 rem 
8000 rem 8000"Prepare the connection environment
8010 if CONFIG$="" then goto 8160
8020 gosub 8580; let HOST$=TMP$
8030 let PORT=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8040 let VERBOSE=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8050 let SSL=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8060 let SCHEME=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8070 let OUT=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8080 let IN=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8090 gosub 8580; let STDIO$=TMP$
8100 let PROTOCOL=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8110 gosub 8580; let REPLY$=TMP$
8120 gosub 8580; let CR$=TMP$
8130 gosub 8580; let CMD$=TMP$
8140 gosub 8580; let ARG$=TMP$
8150 let FID0=dec(CONFIG$(1,3)),CONFIG$=CONFIG$(4)
8160 rem 
8170 if pos("VERBOSE "=FLAG$)=0 then goto 8190
8180 let TMP$="LEVEL="; gosub 8520; let VERBOSE=VALUE
8190 if pos("SSL "=FLAG$) then let SSL=1
8200 if pos("STARTTLS "=FLAG$) then let SSL=2
8210 if pos("OPENSSL "=FLAG$) then let SCHEME=1
8220 if pos("GNUTLS "=FLAG$) then let SCHEME=2
8230 let TMP$="PROTOCOL="; gosub 8520; if VALUE then let PROTOCOL=VALUE
8240 let TMP=int(pos(cvs(VALUE$,4)=cvs(PROTO_NAME$,4))/5)+1
8250 if PROTOCOL=0 then let PROTOCOL=TMP
8260 rem 
8270 let TMP$=str(PORT:"####")
8280 if PROTOCOL then goto 8330
8290 if pos(TMP$="  80 443",4) then let PROTOCOL=1; goto 8330; rem     "HTTP
8300 if pos(TMP$="  25 587 465",4) then let PROTOCOL=2; goto 8330; rem "SMTP
8310 if pos(TMP$=" 110 993",4) then let PROTOCOL=3; goto 8330; rem     "POP3
8320 rem 
8330 if SSL then goto 8360
8340 if pos(TMP$=" 443 465 993",4) then let SSL=1; rem "SSL
8350 if pos(TMP$=" 587",4) then let SSL=2; rem         "STARTTLS
8360 rem 
8370 let TMP$="REPLY="; gosub 8520; if TMP then let REPLY$=VALUE$
8380 let TMP$="CRLF="; gosub 8520; if TMP then let CR$=ath(VALUE$,err=8390)
8390 rem 
8400 if FID0 or (VERBOSE=0 and pgm(-1)<>pgm(-2)) then goto 8430
8410 let FID0=unt; open (FID0)fid(0)
8420 if fid(0)="IO" then print "<pre>" else print 'CS',; let VERBOSE=2
8430 rem 
8440 rem HOST$="smtp.live.com",PORT=25
8450 if HOST$>"" then goto 8510
8460 let URL$=REQUEST$; gosub 8770
8470 let REQUEST$=URL$
8480 if TMP_HOST$="" then let ERR$=ERR$+"host no found"+$0D0A$
8490 let HOST$=TMP_HOST$,PORT=TMP_PORT
8500 goto 9910
8510 return 
8520 let TMP=pos(TMP$=cvs(FLAG$,4)); if TMP=0 then return 
8530 let TMP$=FLAG$(TMP,pos(" "=FLAG$(TMP)+" ")-1)
8540 if pos("="=TMP$)=0 then let TMP$=""; return 
8550 let VALUE$=TMP$(pos("="=TMP$)+1)
8560 let VALUE=0,VALUE=num(VALUE$,err=8570)
8570 return 
8580 let TMP=dec(CONFIG$(1,2)),TMP$=CONFIG$(3,TMP),CONFIG$=CONFIG$(3+TMP)
8590 return 
8600 rem 
8610 let TMP=pos(":"=TMP$); if TMP=0 then let TMP=pos(" "=TMP$+" ")
8620 if pos(cvs(TMP$(1,TMP),4)=cvs(REQUEST$,4)) then goto 8650
8630 if pos(CR$=TMP$)=1 then let TMP$=TMP$(len(CR$)+1); goto 8630
8640 let SEND$=SEND$+TMP$+CR$
8650 return 
8660 rem 
8670 let TEMP$=REQUEST$; gosub 8700; let REQUEST$=TEMP$; return 
8680 rem 
8690 let TEMP$=RESPONSE$; gosub 8700; let RESPONSE$=TEMP$; return 
8700 rem 
8710 let TMP=pos(":"=TMP$); if TMP=0 then let TMP=pos(" "=TMP$+" ")
8720 let TMP=pos(cvs(TMP$(1,TMP),4)=cvs(TEMP$,4)); if TMP=0 then goto 8760
8730 if pos(CR$=TEMP$(TMP))=1 then let TMP=TMP+len(CR$); goto 8730
8740 let TMP$=TEMP$(TMP,pos(" ">TEMP$(TMP))-1)
8750 let TEMP$=TEMP$(1,TMP-1)+TEMP$(TMP+pos(" ">TEMP$(TMP)))
8760 return 
8770 let PORT$="?"
8780 if pos("//"=cvs(URL$,4))=1 then let PORT$="80",URL$=URL$(3)
8790 if pos("HTTP://"=cvs(URL$,4))=1 then let PORT$="80",URL$=URL$(8)
8800 if pos("HTTPS://"=cvs(URL$,4))=1 then let PORT$="443",URL$=URL$(9)
8810 let TMP=pos("/"=URL$+"/")
8820 let TMP$=URL$(1,TMP-1),URL$=URL$(TMP); if URL$="" then let URL$="/"
8830 let TMP=pos(":"=TMP$)
8840 if TMP then let PORT$=TMP$(TMP+1),TMP$=TMP$(1,TMP-1)
8850 let TMP_HOST$=TMP$,TMP_PORT=80,TMP_PORT=num(PORT$,err=8860)
8860 return 
9000 rem 9000"DEFINITION SECTION
9010 let CMD_HTTP$="1OPTIONS 2GET 3HEAD 4POST 5PUT 6DELETE 7TRACE 8CONNECT "
9020 let PROTO_NAME$="http smtp pop3 imap ftp  xmpp "
9030 let CR$=$0A$
9040 let ORG_FLAG$=FLAG$
9050 return 
9300 rem 9300"ROUTINE PROGRAM
9310 rem 
9320 rem "ERROR I/O FILE
9330 call "^IOERR",err,tcb(5),"^PROTO.TCP"; retry
9340 return ; rem "Press ESC... retry
9700 rem 9700"READ TABLE
9710 let Z$=cvs(Z$,2); find record(FILES+1,key=Z$,dom=9720)Z$; return 
9720 dim Z$(100); return 
9730 def fnSEEK$(SEEKKEY$,FILE_ID$)=fnBIT$(SEEKKEY$+$00$,FILE_ID$,$00FF$,max(p
9730:os($00$<>SEEKKEY$,-1),1))
9740 def fnBIT$(SEEKKEY$,FILE_ID$,MOST$,LENGTH)=SEEKKEY$(1,LENGTH-1)+chr(max(a
9740:sc(SEEKKEY$(LENGTH)),1)-1)+fill(max(asc(FILE_ID$(2))-LENGTH,0),MOST$(1+mi
9740:n(1,asc(SEEKKEY$(LENGTH))),1))
9800 rem 9800"EDIT ERROR
9810 print (0,err=9810)'RB',; return 
9900 rem 9900"END OF PROGRAM
9910 gosub ETX
9920 seterr 9930; exit 
9930 stop

CEMS

unread,

Dec 11, 2015, 5:37:01 PM12/11/15

to MundoBBx

Saludos Edgar

Podrás probar como funciona el programa en el siguiente link:

Envío de Correo Electrónico

colocar la clave "demo" cuando te sea solicitado.

Aquí tienes un ejemplo de la configuración que debes colocar en el programa para enviar correos con el servidor de Gmail, Cada vez que envíes un correo debes solicitar autorización pulsando el botón "Autorizar".

Te recomiendo que actives la casilla "Debugger", esta permite mostrar cada acción que el programa hace durante el proceso de conexión y envío del mensaje.

Reply all

Reply to author

Forward