The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

http://www.rubbermallet.org/software.html

November 17 2011 at 9:50 PM
Anonymous  (no login)


Response to chat bas no tested

 
chase bas


DECLARE FUNCTION Blacklisted% (chkuidl$)
DECLARE SUB Forward (subj$, fwdfl$)
DECLARE FUNCTION DecQP$ (text$)
DECLARE FUNCTION DecMIME64$ (text$)
DECLARE SUB MoveMail (box%, mailnum%, newbox%)
DECLARE SUB DoSMTP ()
DECLARE SUB Compose (to$, subj$, rplto$)
DECLARE FUNCTION EncMIME64$ (text$)
DECLARE FUNCTION exists% (theuidl$)
DECLARE SUB DeleteMail (box%, mailnum%)
DECLARE SUB DoPOP ()
DECLARE SUB SayFail ()
DECLARE FUNCTION TestSMTP% ()
DECLARE FUNCTION TestPOP% ()
DECLARE SUB DrawBox ()
DECLARE FUNCTION Enc$ (orig$)
DECLARE FUNCTION Conv$ (orig$)
DECLARE SUB Populate (wb%)
DECLARE SUB InboxStatus ()
DECLARE SUB WriteStatusBar (textwrite$)
TYPE Registers
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE

'Define custom data type for nTCP-related data.
TYPE nTCP
Enabled AS INTEGER
IntVector AS INTEGER
ErrorCode AS INTEGER
LocalIP AS LONG
LocalNetmask AS LONG
LocalGateway AS LONG
LocalDNS AS LONG
LocalDomain AS STRING * 256
DomainLen AS INTEGER
Timeserver AS LONG
MTU AS INTEGER
TTL AS INTEGER
TOS AS INTEGER
MSS AS INTEGER
RWIN AS INTEGER
FreeInputPkts AS INTEGER
FreeOutputPkts AS INTEGER
Timeout AS INTEGER
END TYPE

'Define custom error type constants and other frequently used values.
CONST errBadCall = 1
CONST errCritical = 2
CONST errNoHandles = 3
CONST errBadHandle = 4
CONST errTimeout = 5
CONST errBadSession = 6

CONST sckListening = 1
CONST sckOpen = 4
CONST sckClosed = 7

DECLARE FUNCTION Conv2IP$ (DWord AS LONG)
DECLARE FUNCTION Conv2DWord$ (inString AS STRING)
DECLARE FUNCTION HighByte% (Word AS INTEGER)
DECLARE FUNCTION LowByte% (Word AS INTEGER)

DECLARE FUNCTION tcpInit% (Vector AS INTEGER)
DECLARE FUNCTION tcpConnect% (RemoteIP AS STRING, RemotePort AS INTEGER)
DECLARE FUNCTION tcpStatus% (tcpHandle AS INTEGER)
DECLARE FUNCTION MakeReg% (h AS INTEGER, l AS INTEGER)
DECLARE FUNCTION tcpListen% (ListenPort AS INTEGER)
DECLARE SUB AddBuffer (textadd AS STRING)
DECLARE SUB DrawScreen ()
DECLARE SUB tcpUnload ()
DECLARE SUB tcpSetTimeout (TimeoutSeconds AS INTEGER)
DECLARE SUB RegBlank ()
DECLARE FUNCTION tcpGetData$ (tcpHandle AS INTEGER)
DECLARE SUB tcpClose (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpInBuffer% (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpInputQueue% (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpRemoteIP$ (tcpHandle AS INTEGER)
DECLARE SUB tcpSendData (tcpHandle AS INTEGER, Data2Send AS STRING)
DECLARE SUB tcpDoIO ()
DECLARE SUB showErrorMsg ()

DECLARE SUB interruptx (intnum AS INTEGER, inreg AS Registers, outreg AS Registers)

DEFINT A-Z

'Dimension variables that are shared between all subroutines and functions.
DIM SHARED tcpCall AS Registers
DIM SHARED tcpReturn AS Registers
DIM SHARED tcpDriver AS nTCP
DIM SHARED isActive AS INTEGER
DIM SHARED strGetData AS STRING * 4096
DIM SHARED strSendData AS STRING * 1024

DIM SHARED menubg, menufg, textbg, textfg, unreadfg, vert, curbox, mails, sel, seltop, bname$
DIM SHARED folder$
DIM SHARED index(1 TO 500, 1 TO 6) AS STRING

menubg = 7
menufg = 0
textbg = 1
textfg = 7
unreadfg = 15
vert = 25

SCREEN 0: WIDTH 80, vert
COLOR textfg, textbg: CLS
COLOR menufg, menubg

LOCATE 1, 1: PRINT SPACE$(160);
ln$ = "Compose (Alt+C) | Next mailbox (Alt+S) | Send/receive now (Alt+T)"
LOCATE 1, 40 - (LEN(ln$) / 2): PRINT ln$;
ln$ = "Delete selected (Alt+D) | Exit (Alt+X)"
LOCATE 2, 40 - (LEN(ln$) / 2): PRINT ln$;

WriteStatusBar "Reading configuration from CHASE.INI..."
vec$ = "61"
DIM SHARED nextidx AS LONG
DIM SHARED realname$, addy$
DIM SHARED popserv$, popport%, poplogin$, poppass$
DIM SHARED smtpserv$, smtpport%, smtplogin$, smtppass$
DIM SHARED doauth
DIM SHARED leave
DIM SHARED debugtrue
DIM SHARED trim

IF INSTR(1, COMMAND$, "/DEBUG") > 0 THEN debugtrue = 1
IF debugtrue = 1 AND INSTR(1, COMMAND$, "/COM") < 1 THEN OPEN "debug.txt" FOR OUTPUT AS #15 'ELSE OPEN "COM1:9600,N,8,1" FOR OUTPUT AS #15

OPEN "next.idx" FOR BINARY AS #1: CLOSE #1
OPEN "next.idx" FOR INPUT AS #1
INPUT #1, nextidx
CLOSE #1

OPEN "chase.ini" FOR BINARY AS #1: sz& = LOF(1): CLOSE #1
IF sz& = 0 THEN
COLOR 7, 0: CLS
PRINT "You need to run CONFIG.EXE to set up CHASE first!"
END
END IF

OPEN "chase.ini" FOR INPUT AS #1
DO UNTIL EOF(1)
INPUT #1, directive$
IF EOF(1) THEN EXIT DO
SELECT CASE LCASE$(directive$)
CASE "trimheader"
LINE INPUT #1, tmp$
IF LCASE$(tmp$) = "true" THEN trim = 1
CASE "smtpauth"
LINE INPUT #1, tmp$
IF LCASE$(tmp$) = "true" THEN doauth = 1
CASE "leavemail"
LINE INPUT #1, tmp$
IF LCASE$(tmp$) = "true" THEN leave = 1
CASE "vec"
LINE INPUT #1, vec$
CASE "address"
LINE INPUT #1, addy$
CASE "name"
LINE INPUT #1, realname$
CASE "popserv"
LINE INPUT #1, popserv$
CASE "popport"
INPUT #1, popport%
CASE "poplogin"
LINE INPUT #1, poplogin$
CASE "poppass"
LINE INPUT #1, poppass$
CASE "smtpserv"
LINE INPUT #1, smtpserv$
CASE "smtpport"
INPUT #1, smtpport%
CASE "smtplogin"
LINE INPUT #1, smtplogin$
CASE "smtppass"
LINE INPUT #1, smtppass$
END SELECT
LOOP
CLOSE #1

WriteStatusBar "Initializing TCP/IP... (If this locks up, check your settings)"
dummy% = tcpInit(VAL("&H" + vec$))
WriteStatusBar "Closing any previously open TCP/IP sockets..."
FOR n = 0 TO 7
tcpClose n
NEXT n
WriteStatusBar "TCP/IP was successfully enabled."
SLEEP 1



Populate 1

COLOR textfg, textbg
DO: LOOP UNTIL INKEY$ = ""

DO
key$ = INKEY$
SELECT CASE key$
CASE CHR$(13)
IF mails > 0 THEN GOSUB viewmsg

CASE CHR$(0) + CHR$(32) 'alt+d
WriteStatusBar "This will *PERMANENTLY* erase the message!! Are you SURE? (Y/N)"
DO: LOOP UNTIL INKEY$ = ""
DO
SELECT CASE INKEY$
CASE "y", "Y"
DeleteMail curbox, sel
EXIT DO

CASE "n", "N"
WriteStatusBar "Message delete ABORTED!"
EXIT DO
END SELECT
LOOP

CASE CHR$(0) + CHR$(46) 'alt+c
Compose "", "", ""
Populate curbox

CASE CHR$(0) + CHR$(20) 'alt+t
DoSMTP
DoPOP
Populate curbox

CASE CHR$(0) + CHR$(31) 'alt+s
newbox = curbox + 1
IF newbox = 4 THEN newbox = 1
Populate newbox
CASE CHR$(0) + CHR$(45) 'alt+x
EXIT DO

CASE CHR$(0) + CHR$(73) 'pgup
IF sel > 1 THEN
sel = sel - 20
IF sel < 1 THEN sel = 1
IF sel < seltop THEN seltop = sel
DrawBox
END IF

CASE CHR$(0) + CHR$(81) 'pgdn
IF sel < mails THEN
sel = sel + 20
IF sel > mails THEN sel = mails
seltop = sel
DrawBox
END IF

CASE CHR$(0) + CHR$(72) 'up
IF sel > 1 THEN
sel = sel - 1
IF sel < seltop THEN seltop = sel
DrawBox
END IF

CASE CHR$(0) + CHR$(80) 'down
IF sel < mails THEN
sel = sel + 1
IF sel > seltop + 20 THEN seltop = seltop + 1
DrawBox
END IF
END SELECT
LOOP
COLOR 7, 0
CLS
IF debugtrue = 1 THEN
CLOSE #15
PRINT "The file DEBUG.TXT has been created, logging all TCP communications"
PRINT "from this session. Note that the next time you use /DEBUG, this file"
PRINT "will be overwritten. Thus, you should rename it if you want to keep it."
PRINT
END IF
PRINT "CHASE v1.0 (c)2008 Mike Chambers - http://www.rubbermallet.org"
PRINT "The GNU GPL v3 license applies to this software."
PRINT
PRINT "Exiting to DOS..."
END

viewmsg:
COLOR menufg, menubg
LOCATE 1, 1: PRINT SPACE$(80);
ln$ = "Reply (Alt+R) | Print (Alt+P) | Delete (Alt+D) | Back (Escape)"
LOCATE 1, 40 - (LEN(ln$) / 2): PRINT ln$;

COLOR textfg, textbg
FOR n = 2 TO 24
LOCATE n, 1
PRINT SPACE$(80);
NEXT n
top = 1
show = 1
OPEN folder$ + index(sel, 1) FOR BINARY AS #16: CLOSE #16
OPEN folder$ + index(sel, 1) FOR INPUT AS #16
OPEN "tempmail" FOR OUTPUT AS #1
WriteStatusBar "Parsing message, please wait... (" + MID$(STR$(LOF(1)), 2) + " bytes)"
lines = 0
DO UNTIL EOF(16)
LINE INPUT #16, dummy$
DO
lines = lines + 1
PRINT #1, LEFT$(dummy$, 80)
dummy$ = MID$(dummy$, 81)
LOOP UNTIL dummy$ = ""
LOOP
CLOSE #1, #16
OPEN "tempmail" FOR INPUT AS #1
COLOR textfg, textbg
DO
IF show = 1 THEN
SEEK #1, 1
FOR n = 1 TO top - 1
LINE INPUT #1, dummy$
NEXT n

FOR n = 1 TO 23
LOCATE 1 + n, 1
IF EOF(1) THEN
PRINT SPACE$(80);
ELSE
LINE INPUT #1, ln$
PRINT LEFT$(ln$ + SPACE$(80), 80);
END IF
NEXT n
COLOR menufg, menubg
LOCATE 1, 1: PRINT "Reply (Alt+R) | Forward (Alt+F) | Print (Alt+P) | Delete (Alt+D) | Back (Escape)";
WriteStatusBar MID$(STR$(top), 2) + " of" + STR$(lines) + " lines | From " + CHR$(34) + index(sel, 4) + CHR$(34) + " <" + index(sel, 2) + ">"
COLOR textfg, textbg
show = 0
END IF

key$ = INKEY$
SELECT CASE key$
CASE CHR$(0) + CHR$(19) 'alt+r - reply
IF LEFT$(LCASE$(index(sel, 5)), 4) = "re: " THEN newsubj$ = "" ELSE newsubj$ = "RE: "
Compose index(sel, 2), newsubj$ + index(sel, 5), index(sel, 1)
show = 1

CASE CHR$(0) + CHR$(33) 'alt+f - forward
Forward "FW: " + index(sel, 5), index(sel, 1)

CASE CHR$(0) + CHR$(32) 'alt+d - delete
DeleteMail curbox, sel
CLOSE #1
KILL "tempmail"
RETURN

CASE CHR$(0) + CHR$(25) 'alt+p - print
WriteStatusBar "Printing this message to LPT1, please wait..."
SEEK #1, 1
OPEN "LPT1:BIN" FOR OUTPUT AS #10
PRINT #10, "Printed from CHASE v1.0 e-mail client for DOS."
PRINT #10, "This message contains" + STR$(lines) + " lines of text."
PRINT #10, "Printed on " + DATE$ + " at " + TIME$ + "."
PRINT #10, ""
PRINT #10, "-=BEGIN E-MAIL DOCUMENT=-"

ptd = 5
DO UNTIL EOF(1)
LINE INPUT #1, pline$
PRINT #10, pline$
ptd = ptd + 1
WriteStatusBar "Printed" + STR$(ptd) + " of" + STR$(lines + 5) + " lines to LPT1..."
LOOP
PRINT #10, CHR$(12);
CLOSE #10
WriteStatusBar "Printing complete."
COLOR textfg, textbg

CASE CHR$(0) + CHR$(73)
top = top - 23
IF top < 1 THEN top = 1
show = 1
CASE CHR$(0) + CHR$(81)
top = top + 23
IF top > lines THEN top = lines
show = 1
CASE CHR$(0) + CHR$(72)
IF top > 1 THEN top = top - 1
show = 1
CASE CHR$(0) + CHR$(80)
IF top < lines THEN top = top + 1
show = 1
CASE CHR$(27)
EXIT DO
END SELECT
LOOP
CLOSE #1
KILL "tempmail"
DrawBox
RETURN

FUNCTION Blacklisted% (chkuidl$)
Blacklisted% = 0
EXIT FUNCTION

OPEN "BLACKLST.IDX" FOR INPUT AS #17
DO UNTIL EOF(17)
LINE INPUT #17, chkbl$
IF chkuidl$ = chkbl$ THEN
Blacklisted% = 1
CLOSE #17
EXIT FUNCTION
END IF
LOOP
CLOSE #17
END FUNCTION

SUB Compose (to$, subj$, rplto$)
COLOR 7, 0: CLS
PRINT "Welcome to the CHASE e-mail composer."
PRINT
IF rplto$ <> "" THEN
DO
LINE INPUT "Do you wish to to append the original mail to the end of this reply? (Y/N)", ur$
SELECT CASE LCASE$(ur$)
CASE "y"
EXIT DO

CASE "n"
rplto$ = ""
EXIT DO
END SELECT
LOOP
PRINT
END IF

IF to$ = "" THEN
LINE INPUT "Recipient: ", to$
ELSE
PRINT "Recipient: " + to$
END IF
IF subj$ = "" THEN
LINE INPUT "Subject: ", subj$
IF subj$ = "" THEN LOCATE CSRLIN - 1, 1: PRINT "Subject: <no subject>": subj$ = "<no subject>"
PRINT
ELSE
PRINT "Subject: " + subj$
DO
LINE INPUT "Do you wish to change this automatically generated subject? (Y/N)", ur$
SELECT CASE LCASE$(ur$)
CASE "y"
LINE INPUT "Subject: ", subj$
IF subj$ = "" THEN LOCATE CSRLIN - 1, 1: PRINT "Subject: <no subject>": subj$ = "<no subject>"
EXIT DO

CASE "n"
EXIT DO
END SELECT
LOOP
PRINT
END IF
PRINT "Begin typing your e-mail below. When you are finished, type /s or . on a new"
PRINT "line and hit enter to send it. Otherwise, type /c on a new line to cancel."
PRINT
OPEN "OUTBOX\" + MID$(STR$(nextidx), 2) FOR OUTPUT AS #2
PRINT #2, "From: " + CHR$(34) + realname$ + CHR$(34) + " <" + addy$ + ">"
PRINT #2, "To: " + CHR$(34) + to$ + CHR$(34) + " <" + to$ + ">"
dl$ = DATE$ + " " + TIME$
PRINT #2, "Date: " + dl$
PRINT #2, "Subject: " + subj$
PRINT #2, ""

PRINT "-=Begin composing=-"
COLOR 15, 0
DO
LINE INPUT "", newline$
IF LCASE$(newline$) = "/c" THEN CLOSE #2: KILL "OUTBOX\" + MID$(STR$(nextidx), 2): DrawBox: EXIT SUB
IF LCASE$(newline$) = "/s" OR newline$ = "." THEN EXIT DO
PRINT #2, newline$
LOOP

COLOR 7, 0
IF rplto$ <> "" THEN
PRINT
PRINT "Please wait, appending original mail to the end of this one..."
PRINT #2, ""
PRINT #2, "----==== Original message shown below ====----"
OPEN folder$ + rplto$ FOR INPUT AS #4
DO UNTIL EOF(4)
LINE INPUT #4, lnc$
PRINT #2, lnc$
LOOP
CLOSE #4
END IF
CLOSE #2

OPEN "OUTBOX.IDX" FOR BINARY AS #2
ta$ = Enc(MID$(STR$(nextidx), 2)) + "," + Enc(to$) + "," + Enc(DATE$) + "," + Enc(to$) + "," + Enc(subj$) + ",no-uidl" + CHR$(13) + CHR$(10)
SEEK #2, LOF(2) + 1
PUT #2, , ta$
CLOSE #2

nextidx = nextidx + 1
OPEN "next.idx" FOR OUTPUT AS #2
PRINT #2, STR$(nextidx)
CLOSE #2
PRINT
PRINT "Your new outgoing e-mail has been stored in your outbox. It has NOT been sent"
PRINT "to the recipient yet. To send it, use the Alt+T command from the main mailbox"
PRINT "browser. You may also navigate to the outbox, and delete this mail from there"
PRINT "first if you have changed your mind about sending it."
PRINT
PRINT "Press ENTER to return to the mailbox view..."
DO: LOOP UNTIL INKEY$ = ""
DO: LOOP UNTIL INKEY$ = CHR$(13)
DrawBox
END SUB

FUNCTION Conv$ (orig$)
temp$ = ""
FOR n = 1 TO LEN(orig$)
cc$ = MID$(orig$, n, 1)
IF cc$ = "/" THEN
n = n + 1
SELECT CASE MID$(orig$, n, 1)
CASE "/"
cc$ = "/"
CASE "c"
cc$ = ","
CASE "q"
cc$ = CHR$(34)
CASE ELSE
cc$ = "/"
END SELECT
END IF
temp$ = temp$ + cc$
NEXT n
Conv$ = temp$
END FUNCTION

DEFSNG A-Z
FUNCTION Conv2DWord$ (inString AS STRING)
'The inString variable should be an IPv4 address in the standard
'format of x.x.x.x

DIM tempArray(3) AS STRING * 1
DIM tempVal AS INTEGER

tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(0) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF

tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(1) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF

tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(2) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF

tempArray(3) = CHR$(VAL(inString))
Conv2DWord$ = tempArray(0) + tempArray(1) + tempArray(2) + tempArray(3)
END FUNCTION

FUNCTION Conv2IP$ (DWord AS LONG)
DIM tempStr AS STRING * 4

tempStr = MKL$(DWord)
Conv2IP$ = MID$(STR$(ASC(LEFT$(tempStr, 1))), 2) + "." + MID$(STR$(ASC(MID$(tempStr, 2, 1))), 2) + "." + MID$(STR$(ASC(MID$(tempStr, 3, 1))), 2) + "." + MID$(STR$(ASC(RIGHT$(tempStr, 1))), 2)
END FUNCTION

DEFINT A-Z
FUNCTION DecMIME64$ (text$)
'not working... not even tried to mod this code yet really.
EXIT FUNCTION

FOR nua = 1 TO LEN(text$)
'v=asc(mid$(text$,)
'SELECT CASE v
NEXT nua
mime$ = ""
bina$ = ""
FOR nua = 1 TO LEN(text$)
vb = 32
v = ASC(MID$(text$, nua, 1))
IF CHR$(v) <> "=" THEN
FOR nub = 1 TO 6
IF v - vb >= 0 THEN
bina$ = bina$ + "1"
v = v - vb
ELSE
bina$ = bina$ + "0"
END IF
vb = vb / 2
NEXT nub
END IF
NEXT nua

DO UNTIL bina$ = ""
bs$ = LEFT$(bina$, 6)
bina$ = MID$(bina$, 7)
vb = 32
v = 0
FOR nub = 1 TO 6
IF MID$(bs$, nub, 1) = "1" THEN v = v + vb
vb = vb / 2
NEXT nub
SELECT CASE v
CASE 0 TO 25
mime$ = mime$ + CHR$(65 + v)
CASE 26 TO 51
v = v - 26
mime$ = mime$ + CHR$(97 + v)
CASE 52 TO 61
v = v - 52
mime$ = mime$ + CHR$(48 + v)
CASE 62
mime$ = mime$ + " "
CASE 63
mime$ = mime$ + "/"
END SELECT
LOOP
DecMIME64$ = mime$
END FUNCTION

FUNCTION DecQP$ (text$)
IF RIGHT$(text$, 1) = "=" THEN text$ = LEFT$(text$, LEN(text$) - 1): crlf = 0 ELSE crlf = 1
tn = 1
DO UNTIL tn > LEN(text$)
cc$ = MID$(text$, tn, 1)
IF cc$ = "=" THEN
cc$ = CHR$(VAL("&H" + MID$(text$, tn + 1, 2)))
text$ = LEFT$(text$, tn - 1) + cc$ + MID$(text$, tn + 3)
END IF
tn = tn + 1
LOOP
IF crlf = 1 THEN text$ = text$ + CHR$(13) + CHR$(10)
DecQP$ = text$
END FUNCTION

SUB DeleteMail (box, mailnum)
IF mailnum < 1 OR mailnum > 500 THEN EXIT SUB

WriteStatusBar "Deleting message" + STR$(mailnum) + " from " + bname$ + ", please wait..."
SELECT CASE box
CASE 1
bf$ = "inbox.idx"
fld$ = "INBOX\"
CASE 2
bf$ = "outbox.idx"
fld$ = "OUTBOX\"
CASE 3
bf$ = "sentmail.idx"
fld$ = "SENTMAIL\"
END SELECT

OPEN bf$ FOR INPUT AS #3
OPEN "temp.idx" FOR OUTPUT AS #4
FOR nd = 1 TO mailnum - 1
LINE INPUT #3, passln$
PRINT #4, passln$
NEXT nd
LINE INPUT #3, dummy$
xp = INSTR(dummy$, ",")
IF xp > 0 THEN
msgfile$ = LEFT$(dummy$, xp - 1)
ON ERROR RESUME NEXT
KILL fld$ + msgfile$
END IF
DO UNTIL EOF(3)
LINE INPUT #3, passln$
PRINT #4, passln$
LOOP
CLOSE #3, #4
KILL bf$
NAME "temp.idx" AS bf$

savesel = sel
IF box = curbox THEN Populate curbox
sel = savesel
IF sel > mails THEN sel = mails
DrawBox
END SUB

SUB DoPOP
OPEN "BLACKLST.IDX" FOR BINARY AS #17: CLOSE #17
tcpClose 0
inbuf$ = ""
WriteStatusBar "Fetching mail from " + popserv$ + ":" + MID$(STR$(popport%), 2) + "..."
tempserv$ = popserv$
tempport% = popport%
hand = tcpConnect(tempserv$, tempport%)
IF hand < 0 THEN
SayFail
tcpClose hand
SLEEP 5
EXIT SUB
END IF
IF debugtrue = 1 THEN PRINT #15, "": PRINT #15, "-=BEGIN POP3 SESSION (" + DATE$ + " " + TIME$ + ")=-"
state = 1
msgct = 0
oldct = 0
curdl = 1
LOCATE 1, 1
DIM tempuidl(1 TO 500) AS STRING
DIM templist(1 TO 500) AS LONG
totallen& = 0
DO
IF INKEY$ = CHR$(27) THEN
WriteStatusBar "USER ABORTED POP3 FETCH!"
SLEEP 5
EXIT DO
END IF

newin$ = tcpGetData(hand)
inbuf$ = inbuf$ + newin$
xp = INSTR(1, inbuf$, CHR$(13))

IF xp > 0 THEN
indat$ = LEFT$(inbuf$, xp - 1)
inbuf$ = MID$(inbuf$, xp + 1)
IF LEFT$(inbuf$, 1) = CHR$(10) THEN inbuf$ = MID$(inbuf$, 2)
IF debugtrue = 1 THEN PRINT #15, indat$ + CHR$(13) + CHR$(10)
SELECT CASE state
CASE 1
IF LEFT$(indat$, 1) = "+" THEN
state = 2
tcpSendData hand, "USER " + poplogin$ + CHR$(13) + CHR$(10)
ELSE
SayFail
SLEEP 1
EXIT DO
END IF

CASE 2
IF LEFT$(indat$, 1) = "+" THEN
state = 3
tcpSendData hand, "PASS " + poppass$ + CHR$(13) + CHR$(10)
ELSE
SayFail
SLEEP 1
EXIT DO
END IF

CASE 3
IF LEFT$(indat$, 1) = "+" THEN
state = 4
tcpSendData hand, "STAT" + CHR$(13) + CHR$(10)
ELSE
SayFail
SLEEP 1
EXIT DO
END IF

CASE 4
IF LEFT$(indat$, 1) = "+" THEN
xp = INSTR(1, indat$, " ")
indat$ = MID$(indat$, xp + 1)
xp = INSTR(1, indat$, " ")
IF xp < 1 THEN xp = LEN(indat$) + 1
msgct = VAL(LEFT$(indat$, xp - 1))
state = 5
tcpSendData hand, "UIDL" + CHR$(13) + CHR$(10)
ELSE
SayFail
SLEEP 1
EXIT DO
END IF

CASE 5
IF indat$ = "." THEN
state = 6
tcpSendData hand, "LIST" + CHR$(13) + CHR$(10)
END IF

IF LEFT$(indat$, 1) = "-" THEN
'no uidl?
tcpSendData hand, "LIST" + CHR$(12) + CHR$(13)
state = 6
ELSE
cc$ = LEFT$(indat$, 1)
IF cc$ <> "+" AND cc$ <> "." THEN
xp = INSTR(1, indat$, " ")
'PRINT "meep "; xp; indat$
nm = VAL(LEFT$(indat$, xp - 1))
indat$ = MID$(indat$, xp + 1)
IF indat$ = "" THEN tempuidl(nm) = "no-uidl"
tempuidl(nm) = indat$
END IF
END IF

CASE 6
IF LEFT$(indat$, 1) = "+" THEN
state = 7
ELSE
SayFail
SLEEP 1
EXIT DO
END IF

CASE 7
IF msgct = 0 THEN
WriteStatusBar "No new mail on POP3 server."
SLEEP 1
EXIT DO
END IF

IF LEFT$(indat$, 1) = "." AND LEFT$(indat$, 1) <> "+" THEN
state = 8
FOR fdnd = 1 TO 500
IF templist(fdnd) > 0 THEN
IF exists(tempuidl(fdnd)) = 0 THEN
IF Blacklisted(tempuidl(curdl)) = 0 THEN EXIT FOR ELSE oldct = oldct + 1
ELSE
oldct = oldct + 1
END IF
END IF
NEXT fdnd
IF fdnd = 501 THEN tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10): EXIT DO
curdl = fdnd
WriteStatusBar "Fetching message" + STR$(curdl) + " of" + STR$(msgct) + " (" + MID$(STR$(templist(curdl)), 2) + " bytes)"
IF curdl > 500 THEN tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10): EXIT DO
enctype = 0: didhead = 0
tcpSendData hand, "RETR" + STR$(curdl) + CHR$(13) + CHR$(10)
nextidx = nextidx + 1
ELSE
xp = INSTR(1, indat$, " ")
'PRINT "meep "; xp; indat$
IF xp < 1 THEN xp = LEN(indat$) + 1
nm = VAL(LEFT$(indat$, xp - 1))
templist(nm) = VAL(MID$(indat$, xp + 1))
totallen& = totallen& + templist(nm)
END IF

CASE 8
IF LEFT$(indat$, 1) = "+" THEN
OPEN "INBOX\" + MID$(STR$(nextidx), 2) FOR OUTPUT AS #2
state = 9
didhead = 0
tempemail$ = ""
tempname$ = ""
tempsubj$ = ""
tempdate$ = ""
ELSE
PRINT indat$
SayFail
SLEEP 1
EXIT DO
END IF

CASE 9
IF indat$ = "." THEN 'end of message
WriteStatusBar "Fetching message" + STR$(curdl) + " of" + STR$(msgct) + " (" + MID$(STR$(templist(curdl)), 2) + " of" + STR$(templist(curdl)) + " bytes)"
state = 8
CLOSE #2
IF leave = 0 THEN
state = 10
tcpSendData hand, "DELE" + STR$(curdl) + CHR$(13) + CHR$(10)
END IF
OPEN "INBOX.IDX" FOR BINARY AS #2
ta$ = Enc(MID$(STR$(nextidx), 2)) + "," + Enc(tempemail$) + "," + Enc(tempdate$) + "," + Enc(tempname$) + "," + Enc(tempsubj$) + "," + Enc(tempuidl(curdl)) + CHR$(13) + CHR$(10)
SEEK #2, LOF(2) + 1
PUT #2, , ta$
CLOSE #2
'OPEN "BLACKLST.IDX" FOR BINARY AS #2
'SEEK #2, LOF(2) + 1
'ta$ = tempuidl(curdl) + CHR$(13) + CHR$(10)
'PUT #2, , ta$
'CLOSE #2

FOR fdnd = curdl + 1 TO 500
IF templist(fdnd) > 0 THEN
IF exists(tempuidl(fdnd)) = 0 THEN
IF Blacklisted(tempuidl(curdl)) = 0 THEN EXIT FOR ELSE oldct = oldct + 1
ELSE
oldct = oldct + 1
END IF
END IF
NEXT fdnd
IF fdnd = 501 THEN
tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10)
WriteStatusBar "Fetched" + STR$(msgct - oldct) + " messages, ignored" + STR$(oldct) + " old messages."
SLEEP 2
EXIT DO
END IF
curdl = fdnd
WriteStatusBar "Fetching message" + STR$(curdl) + " of" + STR$(msgct) + "..."
IF curdl > 500 THEN tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10): EXIT DO
enctype = 0: didhead = 0
tcpSendData hand, "RETR" + STR$(curdl) + CHR$(13) + CHR$(10)


nextidx = nextidx + 1
IF nextidx > 999999 THEN nextidx = 1
ELSE
IF didhead = 0 THEN
IF trim = 0 THEN keep = 1 ELSE keep = 0
IF LEFT$(LCASE$(indat$), 4) = "to: " THEN keep = 1
IF LEFT$(LCASE$(indat$), 6) = "from: " THEN
tempname$ = MID$(indat$, 7)
IF LEFT$(tempname$, 1) = CHR$(34) THEN
tempname$ = MID$(tempname$, 2)
t2$ = tempname$
xp = INSTR(1, tempname$, CHR$(34) + " <")
IF xp < 1 THEN xp = LEN(tempname$) + 1
tempemail$ = MID$(indat$, xp + 10)
tempemail$ = LEFT$(tempemail$, LEN(tempemail$) - 1)
tempname$ = LEFT$(tempname$, xp - 1)
ELSE
tempemail$ = tempname$
END IF
keep = 1
END IF
IF LEFT$(LCASE$(indat$), 6) = "date: " THEN
tempdate$ = MID$(indat$, 7)
keep = 1
END IF
IF LEFT$(LCASE$(indat$), 9) = "subject: " THEN
tempsubj$ = MID$(indat$, 10)
keep = 1
END IF
IF LEFT$(LCASE$(indat$), 27) = "content-transfer-encoding: " THEN
IF INSTR(28, LCASE$(indat$), "quoted-printable") > 0 THEN
enctype = 1
END IF
keep = 0
END IF
IF INSTR(1, "content-type:", LCASE$(indat$)) THEN keep = 1
ELSE
IF tempemail$ = "" THEN tempemail$ = "UKNOWN@UNKNOWN.COM"
IF tempname$ = "" THEN tempname$ = "UKNOWN SENDER"
IF tempsubj$ = "" THEN tempsubj$ = "(No subject)"
IF tempdate$ = "" THEN tempdate$ = "UNKNOWN DATE"
keep = 1
END IF
IF indat$ = "" THEN didhead = 1: keep = 1
IF keep = 1 THEN
IF enctype = 1 THEN indat$ = DecQP(indat$) ELSE indat$ = indat$ + CHR$(13) + CHR$(10)
PRINT #2, indat$;
END IF
WriteStatusBar "Fetching message" + STR$(curdl) + " of" + STR$(msgct) + " (" + MID$(STR$(LOF(2)), 2) + " of" + STR$(templist(curdl)) + " bytes)"
END IF

CASE 10
state = 8
DO UNTIL Blacklisted(tempuidl(curdl)) = 0 OR curdl > 500
curdl = curdl + 1
LOOP
IF curdl > 500 THEN tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10): EXIT DO
enctype = 0: didhead = 0
tcpSendData hand, "RETR" + STR$(curdl) + CHR$(13) + CHR$(10)
END SELECT
END IF
LOOP
tcpClose hand
OPEN "next.idx" FOR OUTPUT AS #1
PRINT #1, nextidx
CLOSE #1
END SUB

SUB DoSMTP
WriteStatusBar "Populating outbox..."
tcpClose 0
outct = 0
OPEN "OUTBOX.IDX" FOR BINARY AS #3: CLOSE #3
DIM idx(1 TO 50, 1 TO 5) AS STRING
OPEN "OUTBOX.IDX" FOR INPUT AS #3
DO UNTIL EOF(3) OR outct = 50
INPUT #3, mailfile$: mailfile$ = Conv(mailfile$)
IF mailfile$ <> "" THEN
INPUT #3, fromaddy$: fromaddy$ = Conv(fromaddy$)
INPUT #3, fromdate$: fromdate$ = Conv(fromdate$)
INPUT #3, fromname$: fromname$ = Conv(fromname$)
INPUT #3, fromsubj$: fromsubj$ = Conv(fromsubj$)
INPUT #3, uidl$: uidl$ = Conv(uidl$)
outct = outct + 1
idx(outct, 1) = mailfile$
idx(outct, 2) = fromaddy$
idx(outct, 3) = fromdate$
idx(outct, 4) = fromname$
idx(outct, 5) = fromsubj$
END IF
LOOP
CLOSE #3
IF outct = 0 THEN DrawBox: EXIT SUB

movelist$ = ""
inbuf$ = ""
'WriteStatusBar "Sending" + STR$(outct) + " mails via " + smtpserv$ + ":" + MID$(STR$(smtpport%), 2) + "..."
WriteStatusBar "Connecting to server " + smtpserv$ + ":" + MID$(STR$(smtpport%), 2) + "(" + MID$(STR$(outct), 2) + " outgoing mails)"
tempserv$ = smtpserv$
tempport% = smtpport%
hand = tcpConnect(tempserv$, tempport%)
IF hand < 0 THEN
SayFail
tcpClose hand
SLEEP 5
CLOSE #3
EXIT SUB
END IF
IF debugtrue = 1 THEN PRINT #15, "": PRINT #15, "-=BEGIN SMTP SESSION (" + DATE$ + " " + TIME$ + ")=-"
state = 1
msgct = 0
oldct = 0
curul = 1
LOCATE 1, 1
state = 1
DO
IF INKEY$ = CHR$(27) THEN
WriteStatusBar "USER ABORTED SMTP OPERATION!"
SLEEP 5
EXIT DO
END IF

newin$ = tcpGetData(hand)
inbuf$ = inbuf$ + newin$
xp = INSTR(1, inbuf$, CHR$(13))

IF xp > 0 THEN
indat$ = LEFT$(inbuf$, xp - 1)
inbuf$ = MID$(inbuf$, xp + 1)
IF LEFT$(inbuf$, 1) = CHR$(10) THEN inbuf$ = MID$(inbuf$, 2)

IF debugtrue = 1 THEN PRINT #15, indat$ + CHR$(13) + CHR$(10)

SELECT CASE state
CASE 1
IF LEFT$(indat$, 3) = "220" THEN
state = 2
tcpSendData hand, "HELO " + smtpserv$ + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "Server returned an unexpected response upon connection! Aborting..."
SLEEP 2
EXIT DO
END IF

CASE 2
IF LEFT$(indat$, 3) = "250" THEN
IF doauth = 1 THEN
state = 3
WriteStatusBar "Sending SMTP authentication... (AUTH PLAIN, MIME base64 encoding)"
tcpSendData hand, "AUTH PLAIN" + CHR$(13) + CHR$(10)
ELSE
'first msg send!
state = 5
tcpSendData hand, "MAIL FROM: <" + addy$ + ">" + CHR$(13) + CHR$(10)
END IF
ELSE
WriteStatusBar "Server returned an unexpected response upon connection! Aborting..."
SLEEP 2
EXIT DO
END IF

CASE 3
IF LEFT$(indat$, 3) = "235" THEN
state = 4
tcpSendData hand, EncMIME64(CHR$(0) + smtplogin$ + CHR$(0) + smtppass$) + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "AUTH command FAILED! Aborting..."
SLEEP 2
EXIT DO
END IF

CASE 4
IF LEFT$(indat$, 3) = "235" THEN
IF outct < curul THEN EXIT DO
state = 5
tcpSendData hand, "MAIL FROM: <" + addy$ + ">" + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "Authorization failed! Check your settings."
SLEEP 2
EXIT DO
END IF

CASE 5 'MAIL FROM response
IF LEFT$(indat$, 3) = "250" THEN
state = 6
tcpSendData hand, "RCPT TO: <" + idx(curul, 2) + ">" + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "Sending mail failed! Check your settings."
SLEEP 2
EXIT DO
END IF

CASE 6 'MAIL TO response
IF LEFT$(indat$, 3) = "250" THEN
state = 7
tcpSendData hand, "DATA" + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "Sending mail failed! Check your settings."
SLEEP 2
EXIT DO
END IF

CASE 7 'DATA response
IF LEFT$(indat$, 3) = "354" THEN
'w00t! okay, let's send that message.
state = 8
OPEN "OUTBOX\" + idx(curul, 1) FOR INPUT AS #2
DO UNTIL EOF(2)
LINE INPUT #2, sndln$
tcpSendData hand, sndln$ + CHR$(13) + CHR$(10)
LOOP
CLOSE #2
tcpSendData hand, "." + CHR$(13) + CHR$(10)
ELSE
WriteStatusBar "Sending mail failed! Check your settings."
SLEEP 2
EXIT DO
END IF

CASE 8
IF LEFT$(indat$, 3) = "250" THEN
WriteStatusBar "Sent" + STR$(curul) + " of" + STR$(outct) + " messages..."
'movelist$ = movelist$ + MKI$(curul)
MoveMail 2, 1, 3
curul = curul + 1
IF curul = 51 OR curul > outct THEN
IF NOT curul > outct AND curul = 51 THEN
WriteStatusBar "Can only send 50 messages at a time! Use Alt+T again to send the rest."
SLEEP 2
END IF
EXIT DO
ELSE
state = 5
tcpSendData hand, "MAIL FROM: <" + addy$ + ">" + CHR$(13) + CHR$(10)
END IF

ELSE
WriteStatusBar "Sending mail failed! Check your settings."
SLEEP 2
EXIT DO
END IF

END SELECT
END IF
LOOP
tcpSendData hand, "QUIT" + CHR$(13) + CHR$(10)
tcpClose hand
'DO UNTIL movelist$ = ""
' cm = CVI(LEFT$(movelist$, 2))
' movelist$ = MID$(movelist$, 3)
' MoveMail 2, cm, 3
'LOOP
CLOSE #3
EXIT SUB

END SUB

SUB DrawBox
COLOR menufg, menubg

LOCATE 1, 1: PRINT SPACE$(160);
ln$ = "Compose (Alt+C) | Next mailbox (Alt+S) | Send/receive now (Alt+T)"
LOCATE 1, 40 - (LEN(ln$) / 2): PRINT ln$;
ln$ = "Delete selected (Alt+D) | Exit (Alt+X)"
LOCATE 2, 40 - (LEN(ln$) / 2): PRINT ln$;
COLOR 7, 0
LOCATE 3, 1, 0: PRINT SPACE$(80);

ln$ = "Browsing: " + bname$ + " (" + MID$(STR$(mails), 2) + " messages)"
LOCATE 3, 40 - (LEN(ln$) / 2)
PRINT ln$;
COLOR textfg, textbg
ps = 4
LOCATE 4, 1
last = seltop + 20
IF last > mails THEN last = mails: seltop = mails - 20
IF seltop < 1 THEN seltop = 1
FOR n = seltop TO last
IF n <> sel THEN COLOR textfg, textbg ELSE COLOR 0, 7
ln$ = LEFT$(MID$(STR$(n), 2) + " ", 4) + ""
ln$ = ln$ + LEFT$(index(n, 4) + SPACE$(19), 19) + ""
ln$ = ln$ + LEFT$(index(n, 5) + SPACE$(53), 53)
PRINT ln$;
ps = ps + 1
NEXT n
COLOR textfg, textbg
DO UNTIL ps > 24
LOCATE ps, 1: PRINT SPACE$(79);
ps = ps + 1
LOOP
IF mails > 0 THEN
WriteStatusBar CHR$(34) + index(sel, 4) + CHR$(34) + " <" + index(sel, 2) + "> on " + index(sel, 3)
ELSE
WriteStatusBar "There are no messages in this folder."
END IF
IF mails < 21 THEN divby = mails ELSE divby = 21
IF divby = 0 THEN divby = 1: rat! = mails / divby
IF rat! = 0 THEN rat! = 1: vp = FIX(sel / rat!)
IF vp < 1 THEN vp = 1
IF vp > 21 THEN vp = 21
vp = vp + 3
COLOR 7, 0
FOR n = 4 TO 24
LOCATE n, 80
IF n = vp THEN PRINT ""; ELSE PRINT "";
NEXT n
COLOR textfg, textbg
END SUB

FUNCTION Enc$ (orig$)
temp$ = ""
FOR n = 1 TO LEN(orig$)
cc$ = MID$(orig$, n, 1)
IF ASC(cc$) < 32 OR ASC(cc$) > 173 THEN cc$ = " "
IF cc$ = "/" THEN cc$ = "//"
IF cc$ = "," THEN cc$ = "/c"
IF cc$ = CHR$(34) THEN cc$ = "/q"
temp$ = temp$ + cc$
NEXT n
Enc$ = temp$
END FUNCTION

FUNCTION EncMIME64$ (text$)
mime$ = ""
bina$ = ""
FOR nua = 1 TO LEN(text$)
vb = 128
v = ASC(MID$(text$, nua, 1))
FOR nub = 1 TO 8
IF v - vb >= 0 THEN
bina$ = bina$ + "1"
v = v - vb
ELSE
bina$ = bina$ + "0"
END IF
vb = vb / 2
NEXT nub
NEXT nua

DO UNTIL bina$ = ""
bs$ = LEFT$(bina$, 6)
bina$ = MID$(bina$, 7)
vb = 32
v = 0
FOR nub = 1 TO 6
IF MID$(bs$, nub, 1) = "1" THEN v = v + vb
vb = vb / 2
NEXT nub
SELECT CASE v
CASE 0 TO 25
mime$ = mime$ + CHR$(65 + v)
CASE 26 TO 51
v = v - 26
mime$ = mime$ + CHR$(97 + v)
CASE 52 TO 61
v = v - 52
mime$ = mime$ + CHR$(48 + v)
CASE 62
mime$ = mime$ + " "
CASE 63
mime$ = mime$ + "/"
END SELECT
LOOP
rat! = LEN(mime$) / 4
IF rat! <> FIX(LEN(mime$) / 4) THEN rat! = FIX(LEN(mime$) / 4) + 1
EncMIME64$ = LEFT$(mime$ + "===", rat! * 4)
END FUNCTION

FUNCTION exists% (theuidl$)
exists% = 0
FOR nc = 1 TO 500
IF index(nc, 6) = theuidl$ THEN exists% = 1: EXIT FOR
NEXT nc
END FUNCTION

SUB Forward (subj$, fwdfl$)
COLOR 7, 0: CLS
PRINT "Welcome to the CHASE e-mail forwarding wizard."
PRINT
LINE INPUT "Recipient: ", to$
IF to$ = "" THEN DrawBox: EXIT SUB

IF subj$ = "" THEN
LINE INPUT "Subject: ", subj$
IF subj$ = "" THEN LOCATE CSRLIN - 1, 1: PRINT "Subject: <no subject>": subj$ = "<no subject>"
PRINT
ELSE
PRINT "Subject: " + subj$
DO
LINE INPUT "Do you wish to change this automatically generated subject? (Y/N)", ur$
SELECT CASE LCASE$(ur$)
CASE "y"
LINE INPUT "Subject: ", subj$
IF subj$ = "" THEN LOCATE CSRLIN - 1, 1: PRINT "Subject: <no subject>": subj$ = "<no subject>"
EXIT DO

CASE "n"
EXIT DO
END SELECT
LOOP
PRINT
END IF

OPEN "OUTBOX\" + MID$(STR$(nextidx), 2) FOR OUTPUT AS #2
PRINT #2, "From: " + CHR$(34) + realname$ + CHR$(34) + " <" + addy$ + ">"
PRINT #2, "To: " + CHR$(34) + to$ + CHR$(34) + " <" + to$ + ">"
dl$ = DATE$ + " " + TIME$
PRINT #2, "Date: " + dl$
PRINT #2, "Subject: " + subj$
PRINT #2, ""

PRINT "Please wait, writing new mail file for forwarding..."
PRINT #2, "----====Forwarded data below====----"
OPEN folder$ + fwdfl$ FOR INPUT AS #4
DO UNTIL EOF(4)
LINE INPUT #4, lnc$
PRINT #2, lnc$
LOOP
CLOSE #4
CLOSE #2

OPEN "OUTBOX.IDX" FOR BINARY AS #2
ta$ = Enc(MID$(STR$(nextidx), 2)) + "," + Enc(to$) + "," + Enc(DATE$) + "," + Enc(to$) + "," + Enc(subj$) + ",no-uidl" + CHR$(13) + CHR$(10)
SEEK #2, LOF(2) + 1
PUT #2, , ta$
CLOSE #2

nextidx = nextidx + 1
OPEN "next.idx" FOR OUTPUT AS #2
PRINT #2, STR$(nextidx)
CLOSE #2
PRINT
PRINT "Your new outgoing e-mail has been stored in your outbox. It has NOT been sent"
PRINT "to the recipient yet. To send it, use the Alt+T command from the main mailbox"
PRINT "browser. You may also navigate to the outbox, and delete this mail from there"
PRINT "first if you have changed your mind about sending it."
PRINT
PRINT "Press ENTER to return to the mailbox view..."
DO: LOOP UNTIL INKEY$ = ""
DO: LOOP UNTIL INKEY$ = CHR$(13)
DrawBox
END SUB

DEFSNG A-Z
FUNCTION HighByte% (Word AS INTEGER)
HighByte% = ASC(RIGHT$(MKI$(Word), 1))
END FUNCTION

FUNCTION LowByte% (Word AS INTEGER)
LowByte% = ASC(LEFT$(MKI$(Word), 1))
END FUNCTION

FUNCTION MakeReg% (h AS INTEGER, l AS INTEGER)
MakeReg% = CVI(CHR$(l) + CHR$(h))
END FUNCTION

DEFINT A-Z
SUB MoveMail (box, mailnum, newbox)
IF mailnum < 1 OR mailnum > 500 THEN EXIT SUB

WriteStatusBar "Deleting message" + STR$(mailnum) + " from " + bname$ + ", please wait..."
SELECT CASE box
CASE 1
bf$ = "inbox.idx"
fld$ = "INBOX\"
CASE 2
bf$ = "outbox.idx"
fld$ = "OUTBOX\"
CASE 3
bf$ = "sentmail.idx"
fld$ = "SENTMAIL\"
END SELECT
SELECT CASE newbox
CASE 1
newbf$ = "inbox.idx"
newfld$ = "INBOX\"
CASE 2
newbf$ = "outbox.idx"
newfld$ = "OUTBOX\"
CASE 3
newbf$ = "sentmail.idx"
newfld$ = "SENTMAIL\"
END SELECT

OPEN bf$ FOR INPUT AS #3
OPEN "temp.idx" FOR OUTPUT AS #4
FOR nd = 1 TO mailnum - 1
LINE INPUT #3, passln$
PRINT #4, passln$
NEXT nd
IF NOT EOF(3) THEN LINE INPUT #3, dummy$
xp = INSTR(dummy$, ",")
IF xp > 0 THEN
msgfile$ = LEFT$(dummy$, xp - 1)
NAME fld$ + msgfile$ AS newfld$ + msgfile$
END IF
DO UNTIL EOF(3)
LINE INPUT #3, passln$
PRINT #4, passln$
LOOP
CLOSE #3, #4
OPEN newbf$ FOR APPEND AS #3
PRINT #3, dummy$
CLOSE #3

KILL bf$
NAME "temp.idx" AS bf$

IF box = curbox THEN Populate curbox
END SUB

SUB Populate (wb)
COLOR textfg, textbg
FOR n = 3 TO 24
LOCATE n, 1
PRINT SPACE$(80);
NEXT n
SELECT CASE wb
CASE 1
bname$ = "Inbox"
boxfile$ = "inbox.idx"
folder$ = "INBOX\"
CASE 2
bname$ = "OutBox"
boxfile$ = "outbox.idx"
folder$ = "OUTBOX\"
CASE 3
bname$ = "Sent mail"
boxfile$ = "sentmail.idx"
folder$ = "SENTMAIL\"
END SELECT
curbox = wb
WriteStatusBar "Populating " + bname$ + ", please wait..."
OPEN boxfile$ FOR BINARY AS #1: CLOSE #1
OPEN boxfile$ FOR INPUT AS #1
mails = 0
DO UNTIL EOF(1)
INPUT #1, mailfile$: mailfile$ = Conv(mailfile$)
IF mailfile$ <> "" THEN
INPUT #1, fromaddy$: fromaddy$ = Conv(fromaddy$)
INPUT #1, fromdate$: fromdate$ = Conv(fromdate$)
INPUT #1, fromname$: fromname$ = Conv(fromname$)
INPUT #1, fromsubj$: fromsubj$ = Conv(fromsubj$)
INPUT #1, uidl$: uidl$ = Conv(uidl$)
mails = mails + 1
index(mails, 1) = mailfile$
index(mails, 2) = fromaddy$
index(mails, 3) = fromdate$
index(mails, 4) = fromname$
index(mails, 5) = fromsubj$
index(mails, 6) = uidl$
END IF
LOOP
CLOSE #1
sel = 1
seltop = 1
DrawBox
END SUB

DEFSNG A-Z
SUB RegBlank
tcpCall.ax = 0
tcpCall.bx = 0
tcpCall.cx = 0
tcpCall.dx = 0
tcpCall.bp = 0
tcpCall.si = 0
tcpCall.di = 0
tcpCall.flags = 0
tcpCall.ds = 0
tcpCall.es = 0
END SUB

DEFINT A-Z
SUB SayFail
WriteStatusBar "Unable to complete mail task!"
END SUB

DEFSNG A-Z
SUB showErrorMsg
PRINT "ERROR CODE" + STR$(tcpDriver.ErrorCode) + "!!! ";
SELECT CASE tcpDriver.ErrorCode
CASE errBadCall
PRINT "err_badcall"
CASE errCritical
PRINT "err_critical"
CASE errNoHandles
PRINT "err_nohandles"
CASE errBadHandle
PRINT "err_badhandle"
CASE errTimeout
PRINT "err_timeout"
CASE errBadSession
PRINT "err_badsession"
END SELECT
END SUB

SUB tcpClose (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H11, 1)
tcpCall.bx = tcpHandle
tcpCall.dx = tcpDriver.Timeout

CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
END SUB

FUNCTION tcpConnect% (RemoteIP AS STRING, RemotePort AS INTEGER)
DIM tempRemoteIP AS STRING
tempRemoteIP = Conv2DWord(RemoteIP)

tcpCall.ax = MakeReg(&H10, 0)
tcpCall.bx = 0
tcpCall.cx = RemotePort
tcpCall.dx = tcpDriver.Timeout
tcpCall.di = CVI(LEFT$(tempRemoteIP, 2))
tcpCall.si = CVI(RIGHT$(tempRemoteIP, 2))
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

dummyLocalPortNr% = tcpReturn.ax
'PRINT "Local port:"; dummyLocalPortNr%

tcpConnect% = tcpReturn.bx 'Makes this function return the TCPDRV handle number.
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)

tcpDoIO
END FUNCTION

SUB tcpDoIO
'Allows TCPDRV to perform processing of data. THIS MUST BE CALLED REGULARLY
'for packets to be processed! If you don't do this, TCPDRV will eventually
'crash when it runs out of storage space for input and output queues.

'RegBlank

tcpCall.ax = MakeReg(&H2, 0)
tcpCall.dx = 0 'tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END SUB

FUNCTION tcpGetData$ (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H12, 1)
tcpCall.bx = tcpHandle
tcpCall.es = VARSEG(strGetData)
tcpCall.di = VARPTR(strGetData)
tcpCall.cx = 4096
tcpCall.dx = 0 'tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpGetData$ = LEFT$(strGetData, tcpReturn.ax)

tcpDriver.ErrorCode = LowByte(tcpReturn.dx)

tcpDoIO
END FUNCTION

FUNCTION tcpInBuffer% (tcpHandle AS INTEGER)
dummy1% = tcpStatus%(tcpHandle)
IF isActive > 0 THEN
tcpInBuffer% = tcpReturn.ax
END IF
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION

FUNCTION tcpInit% (Vector AS INTEGER)
'If given vector value is zero, assume the usual vector 61h.
IF Vector = 0 THEN Vector = &H61

tcpCall.ax = MakeReg(&H0, &HFF)
CALL interruptx(Vector, tcpCall, tcpReturn)

'This next line sets tcpDriver.Enabled to zero, sets the tcpInit function
'return value to zero, and exits the function immediately if the interrupt
'call did not return the expected value of zero for a functional TCPDRV
'vector at the specified segment.
IF tcpReturn.ax <> 0 THEN tcpDriver.Enabled = 0: tcpInit% = 0: EXIT FUNCTION

tcpInit% = 1
tcpDriver.Enabled = 1
tcpDriver.IntVector = Vector
DEF SEG = tcpReturn.es
offset = tcpReturn.di

'The following lines of code parse all of the network-related data
'from the pointer value returned by TCPDRV.
tcpDriver.LocalIP = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4

tcpDriver.LocalNetmask = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4

tcpDriver.LocalGateway = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4

tcpDriver.LocalDNS = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4

tcpDriver.Timeserver = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4

tcpDriver.MTU = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 2

tcpDriver.TTL = PEEK(offset)
tcpDriver.TOS = PEEK(offset + 1)
offset = offset + 4 'Skip two unused bytes after TTL and TOS data.

tcpDriver.MSS = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 2

tcpDriver.RWIN = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 4 'Skip two unused bytes after RWIN data.

'The following code segment gets the local domain string.
DIM tempNum AS INTEGER
DIM tempCurByte AS STRING * 1
DIM tempStr AS STRING
FOR tempNum = offset TO offset + 255
tempCurByte = CHR$(PEEK(tempNum))
IF tempCurByte = CHR$(255) THEN
tcpDriver.DomainLen = tempNum - offset
tcpDriver.LocalDomain = tempStr
ELSE
tempStr = tempStr + tempCurByte
END IF
NEXT tempNum

tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION

FUNCTION tcpListen% (ListenPort AS INTEGER)
tcpCall.ax = MakeReg(&H10, 1)
tcpCall.bx = ListenPort
tcpCall.cx = 0
tcpCall.dx = tcpDriver.Timeout
tcpCall.si = 0
tcpCall.di = 0
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

tcpListen% = tcpReturn.bx
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)

tcpDoIO
END FUNCTION

DEFINT A-Z
FUNCTION tcpRemoteIP$ (tcpHandle AS INTEGER)
checkstat% = tcpStatus(tcpHandle)
IF checkstat% <> sckOpen THEN tcpRemoteIP$ = "0.0.0.0": EXIT FUNCTION

DEF SEG = tcpReturn.es
stateoffset = tcpReturn.di
ipdest$ = Conv2IP(CVL(CHR$(PEEK(stateoffset + 6)) + CHR$(PEEK(stateoffset + 7)) + CHR$(PEEK(stateoffset + 8)) + CHR$(PEEK(stateoffset + 9))))
'ipsrce$ = Conv2IP(CVL(CHR$(PEEK(stateoffset)) + CHR$(PEEK(stateoffset + 1)) + CHR$(PEEK(stateoffset + 2)) + CHR$(PEEK(stateoffset + 3))))

tcpRemoteIP$ = ipdest$
END FUNCTION

DEFSNG A-Z
SUB tcpSendData (tcpHandle AS INTEGER, Data2Send AS STRING)
'IF debugtrue = 1 THEN

DO UNTIL Data2Send = ""
sendsize = LEN(Data2Send)
IF sendsize > 1024 THEN sendsize = 1024
strSendData = LEFT$(Data2Send, sendsize)
IF debugtrue = 1 THEN PRINT #15, LEFT$(Data2Send, sendsize);
Data2Send = MID$(Data2Send, sendsize + 1)

tcpCall.ax = MakeReg(&H13, 4)
tcpCall.bx = tcpHandle
tcpCall.es = INT(VARSEG(strSendData))
tcpCall.di = INT(VARPTR(strSendData))
tcpCall.cx = sendsize
tcpCall.dx = 0 'tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
LOOP
END SUB

SUB tcpSetTimeout (TimeoutSeconds AS INTEGER)
tcpDriver.Timeout = INT(TimeoutSeconds * 18.2)
END SUB

FUNCTION tcpStatus% (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H14, 0)
tcpCall.bx = tcpHandle
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

DEF SEG = tcpReturn.es
stateoffset = tcpReturn.di
ipsrce$ = Conv2IP(CVL(CHR$(PEEK(stateoffset)) + CHR$(PEEK(stateoffset + 1)) + CHR$(PEEK(stateoffset + 2)) + CHR$(PEEK(stateoffset + 3))))
ipdest$ = Conv2IP(CVL(CHR$(PEEK(stateoffset + 4)) + CHR$(PEEK(stateoffset + 5)) + CHR$(PEEK(stateoffset + 6)) + CHR$(PEEK(stateoffset + 7))))
ipprot% = PEEK(stateoffset + 8)
active% = PEEK(stateoffset + 9)
ifActive = active%
'PRINT "======================"
'PRINT "Debug: Status data return values for TCP handle"; tcpHandle
'PRINT
'PRINT "Error code:"; LowByte(tcpReturn.dx)
'PRINT "TCP state:"; HighByte(tcpReturn.dx)
'PRINT
'PRINT "Bytes available for reading:"; tcpReturn.ax
'PRINT "Bytes still being transmitted:"; tcpReturn.cx
'PRINT
'PRINT "Session info gathered from pointer" + STR$(tcpReturn.es) + ":" + MID$(STR$(tcpReturn.di), 2)
'PRINT "IP source: " + ipsrce$
'PRINT "IP dest: " + ipsrce$
'PRINT "IP prot:"; ipprot%
'PRINT "Active:"; active%
'PRINT "======================"
tcpStatus% = HighByte(tcpReturn.dx)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION

SUB tcpUnload
tcpCall.ax = MakeReg(&H1, 0)
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)

tcpDriver.Enabled = 0
END SUB

DEFINT A-Z
SUB WriteStatusBar (textwrite$)
COLOR menufg, menubg
LOCATE vert, 1
'IF LEFT$(textwrite$, 1) = CHR$(34) THEN
PRINT LEFT$(" " + textwrite$ + SPACE$(80), 80);
'ELSE
' PRINT LEFT$(" " + textwrite$ + SPACE$(68), 69) + "CHASE v1.0 ";
'END IF
END SUB













config.bas





SCREEN 0: WIDTH 80, 25: COLOR 7, 0: CLS
PRINT "CHASE v1.0 configuration wizard."
PRINT
PRINT "Which interrupt vector will NTCPDRV be on? (Usually 61)"
LINE INPUT "NTCPDRV interrupt: ", vec$
vec$ = RIGHT$(vec$, 2)
PRINT
PRINT "What is the e-mail address you wish to use with CHASE?"
LINE INPUT "E-mail address: ", addy$
PRINT
PRINT "Your real name is required, and this is what recipients of mail that you"
PRINT "send will see your name as. (note: different than your e-mail address)"
LINE INPUT "Real name: ", realname$
PRINT
PRINT
PRINT "Now we need to configure your POP3/SMTP server settings. CHASE cannot use a"
PRINT "hostname, and needs an IP address. Ping your POP3/SMTP servers from another"
PRINT "machine to get this information, then enter it here."
PRINT
LINE INPUT "POP3 IP address: ", popserv$
INPUT "POP3 port (usually 110): ", popport%
LINE INPUT "POP3 account name: ", poplogin$
LINE INPUT "POP3 password: ", poppass$
PRINT
LINE INPUT "SMTP IP address: ", smtpserv$
INPUT "SMTP port (usually 25): ", smtpport%
LINE INPUT "SMTP account name: ", smtplogin$
LINE INPUT "SMTP password: ", smtppass$
PRINT
DO
LINE INPUT "Does your SMTP server require authentication? (Y/N)", res$
SELECT CASE LCASE$(res$)
CASE "y"
auth$ = "true"
EXIT DO
CASE "n"
auth$ = "false"
EXIT DO
END SELECT
LOOP
PRINT
DO
LINE INPUT "Trim extra/unnecessary lines from incoming mail headers? (Y/N)", res$
SELECT CASE LCASE$(res$)
CASE "y"
trim$ = "true"
EXIT DO
CASE "n"
trim$ = "false"
EXIT DO
END SELECT
LOOP
PRINT
DO
LINE INPUT "Leave mail on server during POP3 download? (Y/N)", res$
SELECT CASE LCASE$(res$)
CASE "y"
leave$ = "true"
EXIT DO
CASE "n"
leave$ = "false"
EXIT DO
END SELECT
LOOP
PRINT
PRINT "That is all the information I need."
PRINT "Press ENTER to create CHASE.INI and continue, or ESCAPE to abort..."
DO
SELECT CASE INKEY$
CASE CHR$(13)
OPEN "chase.ini" FOR OUTPUT AS #1
PRINT #1, "vec," + vec$
PRINT #1, "address," + addy$
PRINT #1, "name," + realname$
PRINT #1, "popserv," + popserv$
PRINT #1, "popport," + STR$(popport%)
PRINT #1, "poplogin," + poplogin$
PRINT #1, "poppass," + poppass$
PRINT #1, "smtpserv," + smtpserv$
PRINT #1, "smtpport," + STR$(smtpport%)
PRINT #1, "smtplogin," + smtplogin$
PRINT #1, "smtppass," + smtppass$
PRINT #1, "smtpauth," + auth$
PRINT #1, "leavemail," + leave$
PRINT #1, "trimheader," + trim$
CLOSE #1
EXIT DO

CASE CHR$(27)
PRINT
PRINT "Aborted config!"
END
END SELECT
LOOP
PRINT
PRINT "Configuration file saved. You can now use CHASE."
END




















 
 Respond to this message   
Response TitleAuthor and Date
http://www.rain.org/~mkummel/tbvault.html. (View Thread)Anonymous on Nov 17
   no workingAnonymous on Dec 2
      qbasicAnonymous on Dec 2
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums