Category : Communication (modem) tools and utilities
Archive   : ASPHST.ZIP
Filename : MAIL.INC

; Mail subroutines for Host Mode script

;**************************************************************************
;* MAIL.INC *
;* *
;* Copyright (C) 1992 DATASTORM TECHNOLOGIES, INC. *
;* *
;* All rights reserved. *
;* *
;**************************************************************************

;**************************************************************************
;* *
;* structure of HOST.HDR for each message in the HOST.MSG file *
;* *
;* integer 2 bytes message number *
;* long 4 bytes offset *
;* integer 2 bytes message Length *
;* char 1 bytes flag *
;* string 31 bytes destination (To:) *
;* string 31 bytes from *
;* string 37 bytes subject *
;* string 9 bytes date *
;* string 11 bytes time *
;* *
;* all strings include a NULL at the last position for a terminator *
;* *
;**************************************************************************

;**************************************************************************

;* *
;* Function: LeaveMail *
;* Purpose: Leave a mail message to another user *
;* Input: subject and destination in case this is a REPLY *
;* from READMAIL *
;* Return: Nothing *
;* Notes: *
;* *
;**************************************************************************
proc LeaveMail
strparm subject
strparm destination

string line, line_num, choice
integer mailflag, line_count
integer count,Length,msg_num, dummy
long msgfile_offset

isfile TempFile
if success
delete TempFile
endif

while 1
line_count=1
strcmp destination ""
if success
call HostPutS with "`r`n`r`n To: "
call HostGetS with &destination 30 DISP
strupr destination
endif

strcmp subject ""
if success
call HostPutS with "`r`nSubj: "
call HostGetS with &subject 40 DISP
endif

call HostPutS with "`r`n`r`n"

call HostPutS with "Private Mail (Y/n)? "
call HostGetYN
if success
mailflag=PRIVATE+NEWMAIL
else
mailflag=PUBLIC+NEWMAIL
endif

call HostPutS with "`r`n`r`n To: "
call HostPutS with destination
call HostPuts with "`r`nFrom: "
call HostPutS with name
call HostPutS with "`r`nSubj: "
call HostPutS with subject
call HostPutS with "`r`n`r`nIs this correct (Y/n/q)? "
call HostGetC with &choice
if failure
call SetFailure
return
endif
call HostPutS with choice
call HostPutS with "`r`n"
strupr choice
switch choice
case "Y"
endcase
case "N"
destination = ""
subject = ""
loopwhile
endcase
case "Q"
return
endcase
endswitch
fopen 1 TempFile "W+"
if failure
call HostPutS with "FATAL ERROR - Can't open TEMP file!"
call ExitHost with 0
endif

GETMESSAGE:

fseek 1 0 2
while 1
strfmt line_num "%5d: " line_count
call HostPutS with "`r`n"
call HostPutS with line_num
call MailGetLine with &line
if failure
exitwhile
endif
strcmp line ""
if success
exitwhile
endif

fputs 1 line ; write line to TempFile
fputc 1 0x0A ; append LF to line

line_count++
endwhile

JMPMARK:
call HostPutS with "`r`n`r`nS)ave A)bort D)isplay C)ontinue ? "
while 1
call HostGetC with &choice
if failure
RETURN
endif
strupr choice
strpeek choice 0 n0
if (n0==83) || (n0==65) || (n0==68) || (n0==67) ;Is it (S,A,D,or C)?
exitwhile
endif
endwhile

call HostPutS with choice
if success
call HostPutS with "`r`n"
strupr choice
switch choice
case "S"
call HostPuts with "`r`nSaving message ...`r`n"
isfile msgfile
if success
fopen 0 msgfile "R+"
if failure
strfmt s0 "FATAL ERROR - Can't open %s file!" msgfile
call HostPuts with s0
return
endif
else
fopen 0 msgfile "W"
endif
fseek 0 0 2
ftell 0 msgfile_offset

fclose 1
findfirst TempFile
MsgLength=$FSIZE
fopen 1 TempFile "R+"
Length=MsgLength
CharsToRead = MsgLength

fseek 0 0 2
while CharsToRead > 0
if CharsToRead > 79
BlockSize = 79
else
BlockSize = CharsToRead
endif

fread 1 line BlockSize dummy
fwrite 0 line BlockSize
if failure
strfmt s0 "FATAL ERROR - Can't open %s file!" msgfile
call HostPuts with s0
return
endif
CharsToRead = CharsToRead - BlockSize
endwhile
fclose 0
fclose 1
delete TempFile

; count messages to get this message number

call CountMsg with &msg_num

; write header info
isfile hdrfile
if success
fopen 2 hdrfile "R+"
if failure
strfmt s0 "FATAL ERROR - Can't open %s file!" hdrfile
call HostPuts with s0
return
endif
else
fopen 2 hdrfile "W"
endif

fseek 2 0 2
inc msg_num
call fputi with 2 msg_num
call fputl with 2 msgfile_offset
call fputi with 2 Length
fputc 2 mailflag
fwrite 2 destination 31
fwrite 2 name 31
fwrite 2 subject 37
fwrite 2 $DATE 9
fwrite 2 $TIME0 11
fclose 2
endcase

case "A"
call HostPutS with "`r`nAbort message (Y/N)? "
call HostGetYN
if success
fclose 1
delete TempFile
return
endif
call HostPutS with "`r`n"
goto JMPMARK
endcase

case "D"
call hostputs with "`r`n"
count=1
rewind 1
fseek 1 0 0
while 1
fgets 1 line
if EOF 1
exitwhile
endif
call HostPutS with line


call hostputs with "`r"
inc count
if count==23
count=1
call HostPutS with "-MORE? (Y/n)-" ; display prompt
call HostGetC with &choice
call HostPutS with "`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b"
strupr choice
strcmp choice "N"
if success
exitwhile
endif
endif
endwhile
goto JMPMARK
endcase

case "C"
goto GETMESSAGE
endcase

default
goto JMPMARK
endcase
endswitch
endif
call SetFailure
return
endwhile
endproc

;***********************************************************************
;* *
;* READMAIL *
;* *
;* This procedure reads and displays mail messages *
;* Modifies globals: msg, MsgNumber *
;* Labels : LOOP2 *
;* *
;***********************************************************************
proc ReadMail
string choice
integer MsgTotal, searchflag

LOOP2:
call CountMsg with &MsgTotal
strfmt msg "`r`n`r`nTotal messages: %d`r`n`r`n" MsgTotal
call HostPutS with msg
call HostPutS with "F)orward read`r`n"
call HostPutS with "N)ew mail`r`n"
call HostPutS with "S)earch mail`r`n"
call HostPutS with "Q)uit`r`n`r`n? "
call HostGetC with &choice
if not success
call SetFailure
return
endif

call HostPuts with choice
call HostPuts with "`r`n"
strupr choice
switch choice
case "F"
call HostPutS with "`r`nStarting message number ( for first): "
call HostGetS with &choice 5 DISP
if not success
Call SetFailure
return
endif
call HostPutS with "`r`n"
strcmp choice ""
if success
MsgNumber=1
else
atoi choice MsgNumber
if MsgNumber>MsgTotal
call HostPutS with "`r`nInvalid msg number!`r`n"
goto LOOP2
endif
endif
while MsgNumber<=MsgTotal
call ReadMsg with 0
if not success
exitwhile
endif
endwhile
call HostPutS with "`r`nEnd of messages.`r`n"
goto LOOP2
endcase

case "N"
MsgNumber=1
while MsgNumber<=MsgTotal
call ReadMsg with 1
if not success
exitwhile
endif
endwhile
call HostPutS with "`r`nEnd of messages.`r`n"
goto LOOP2
endcase

case "S"
call HostPutS with "`r`n`r`nWhich field: T)o F)rom or S)ubject ? "
call HostGetS with &choice 1 DISP
if not success
Call SetFailure
return
endif
call HostPutS with "`r`n"
strupr choice
switch choice
case "T"
searchflag=2
endcase
case "F"
searchflag=3
endcase
case "S"
searchflag=4
endcase

default
return
endcase
endswitch
call HostPutS with "Search string: "
call HostGetS with &searchstr 30 DISP
call HostPutS with "`r`n"
if not success
Call SetFailure
return
endif
MsgNumber=1
while MsgNumber<=MsgTotal
call ReadMsg with searchflag
if not success
exitwhile
endif
endwhile
call HostPutS with "`r`nEnd of messages.`r`n"
goto LOOP2

endcase

case "Q"
return
endcase

default
goto LOOP2
endcase
endswitch
endproc

;**************************************************************************
;* *
;* Function: ReadMsg *
;* Purpose: Open and display a mail message *
;* Input: Nothing *
;* return: Nothing *
;* Notes: *
;* *
;**************************************************************************
proc ReadMsg
intparm readflag
long offset, hdr_offset
string destination, from, subject,flag, line, choice, reply="REPLY - "
integer msg_num,dummy

isfile hdrfile
if failure
call HostPutS with "`r`nNo mail file found!`r`n"
return
endif

fopen 0 hdrfile "R+"
if failure
strfmt s0 "FATAL ERROR - Can't open %s file!" hdrfile
call HostPuts with s0
call ExitHost with 0
endif

hdr_offset=(MsgNumber-1)*128 ; goto a specific record in
; in .HDR file
fseek 0 hdr_offset 0

LOOP3:

call fgeti with 0 &msg_num
if EOF 0
inc MsgNumber
return
endif
call fgetl with 0 &offset
call fgeti with 0 &MsgLength
fgetc 0 MsgFlag
if (MsgFlag & 1) == 1
flag="Private" ;remove new mail flag
else
flag="Public"
endif
fread 0 destination 31 dummy
fread 0 from 31 dummy
fread 0 subject 37 dummy
fread 0 _date 9 dummy
fread 0 _time 11 dummy

if (MsgFlag & 1)==1 ; if message is PRIVATE
strcmp access "2"
if failure
strcmp name destination ; compare user name to TO:
if failure
strcmp name from ; compare user name to FROM:
if failure
inc MsgNumber
goto LOOP3
endif
endif
endif
endif

if (MsgFlag & 4)==DELETED
inc MsgNumber
goto LOOP3
endif

switch readflag
case 1 ; read new mail only
strcmp destination name
if not success
inc MsgNumber
goto LOOP3
endif
if (MsgFlag & 2)!=NEWMAIL
inc MsgNumber
goto LOOP3
endif
endcase

case 2 ; search for TO:
find destination searchstr
if !found
inc MsgNumber
goto LOOP3
endif
endcase

case 3 ; search for FROM:

find from searchstr
if !found
inc MsgNumber
goto LOOP3
endif
endcase

case 4 ; search for SUBJECT
find subject searchstr
if !found
inc MsgNumber
goto LOOP3
endif
endcase
endswitch

fclose 0

strcmp destination name
if success
MsgFlag=MsgFlag & 1 ;unset NEWMAIL flag
call ChangeFlag with MsgFlag
endif

strfmt msg "`r`n Msg: %d (%s, sent %s at %s)`r`n" msg_num flag _date _time
call HostPutS with msg
strfmt msg "From: %s`r`n" from
call HostPuts with msg
strfmt msg " To: %s`r`n" destination
call HostPutS with msg
strfmt msg "Subj: %s`r`n`r`n" subject
call HostPutS with msg

isfile msgfile
if failure
call HostPuts with "No message file!"
return
else
fopen 1 msgfile "R"
if failure
call HostPuts with "Can't open message file!"
return
endif
fopen 2 TempFile "W"
if failure
call HostPuts with "Can't open temp file!"
return
endif

fseek 1 offset 1

CharsToRead = MsgLength
while CharsToRead > 0
if CharsToRead > 79
BlockSize = 79
else
blockSize = CharsToRead
endif
fread 1 line BlockSize dummy
fwrite 2 line BlockSize
if failure
call HostPuts with "Can't write to temp file!"
return
endif
CharsToRead = CharsToRead - BlockSize
endwhile

fclose 1
fclose 2
call DisplayFile with TempFile 17
delete TempFile

call HostPutS with "`r`nR)eply D)elete Q)uit ( for another): "
call HostGetC with &choice
if failure
call SetFailure
return
endif
strupr choice
call HostPutS with choice
call HostPutS with "`r`n"
switch choice
case "R"
substr msg subject 0 21
strcat reply msg
call LeaveMail with reply from
inc MsgNumber
return
endcase
case "D"
call DeleteMsg
endcase
case "Q"
MsgNumber = 9999
return
endcase
case "`r"
inc MsgNumber
return
endcase
default
choice=""
endcase
endswitch
endif
endproc

;**************************************************************************
;* *
;* Function: CountMsg *
;* Purpose: Count the number of messages *
;* Input: integer to be used for return value *
;* Return: number of messages *
;* Notes: *
;* *
;**************************************************************************
proc CountMsg
intparm num

num=0
isfile hdrfile
if failure
return
endif

findfirst hdrfile
div $fsize 128 num ; num = $fsize / 128 (remainder purged)
endproc

;************************************************************************
;* *
;* Function: ChangeFlag *
;* Purpose: modifies the flag byte for a message *
;* Input: *
;* return: *
;* Notes: *
;* *
;**************************************************************************
proc ChangeFlag
intparm flagbyte
long hdr_offset

fopen 0 hdrfile "R+"
hdr_offset=((MsgNumber-1)*128)+8
fseek 0 hdr_offset 0
fputc 0 flagbyte
fclose 0
endproc

;**************************************************************************
;* *
;* Function: DeleteMsg *
;* Purpose: mark a mail message for deletion *
;* Input: nothing *
;* return: nothing *
;* Notes: *
;* *
;**************************************************************************
proc DeleteMsg
long hdr_offset
integer msg_num,dummy
string destination,from,subject

isfile hdrfile
if failure
return
endif

fopen 0 hdrfile "R"
if failure
errormsg "FATAL ERROR - Can't open HOST.HDR"
call exithost with 0
return
endif

hdr_offset=(MsgNumber-1)*128
fseek 0 hdr_offset 0

call fgeti with 0 &msg_num
if EOF 0
fclose 0
return
endif
call fgetl with 0 &hdr_offset
call fgeti with 0 &MsgLength
fgetc 0 MsgFlag
fread 0 destination 31 dummy
fread 0 from 31 dummy
fread 0 subject 37 dummy
fread 0 _date 9 dummy
fread 0 _time 11 dummy
strcmp destination name ; compare TO: and user name
if failure
strcmp from name ; compare FROM: and user name
if failure
strcmp access "2" ; is user level 2 security
if failure ; not send message and return
Call HostPutS with "`r`nYou can't delete this message.`r`n"
return
endif
endif
endif
fclose 0
MsgFlag=MsgFlag+4
call ChangeFlag with MsgFlag
endproc

;**************************************************************************
;* *
;* Function: CheckMail *
;* *
;* Purpose: Notify a user that there is new mail waiting *
;* *
;* Input: nothing *
;* *
;* return: nothing *
;* *
;* *
;* Notes: *
;* *
;* *
;**************************************************************************
proc CheckMail
string destination, from, subject
integer msg_num,dummy
long offset
integer mfound=0

call hostputs with "`r`n`r`nChecking Mail...`r"

isfile hdrfile ; is HOST.HDR present
if failure ; if not return
call hostputs with "Sorry, No Mail `r`n"
return
endif

fopen 0 hdrfile "R+" ; open HOST.HDR for read only
if failure ; error opening file
message "Error Opening Header File"
return
endif
while 1 ; loop forever
call fgeti with 0 &msg_num ; get the message number
if EOF 0 ; if EOF exit the while loop
exitwhile
endif
call fgetl with 0 &offset ; get message file offset
call fgeti with 0 &MsgLength ; get Length of message
fgetc 0 MsgFlag ; get message flag
fread 0 destination 31 dummy ; get TO:
fread 0 from 31 dummy ; get FROM:
fread 0 subject 37 dummy ; get subject
fread 0 _date 9 dummy ; get message date
fread 0 _time 11 dummy ; get message time

strupr destination
strupr name
strcmp destination name ; compare message TO: and user name
if success ; if this is there message
if (MsgFlag & 2)==NEWMAIL ; check to see if NEWMAIL flag is set
call HostPutS with "`aYou have mail waiting!`r`n"
mfound=1
exitwhile ; leave the while loop
endif
endif
endwhile
if !mfound
call hostputs with "Sorry, No Mail `r`n"
endif
fclose 0 ; close HOST.HDR
endproc

;**************************************************************************
;* *
;* Function: MailGetLine *
;* Purpose: Input a character string from the port or local keyboard *
;* Input: string parameter for return value *
;* Return: If success, string variable contains the string *
;* FAILURE if connection lost *
;* Notes: *
;* *
;**************************************************************************
proc MailGetLine
strparm s
integer max=69
integer i
string response

strpoke s 0 0
i = 0
while 1
call HostGetC with &response
if failure
exitwhile
endif
switch response
case "`r"
call SetSuccess
exitwhile
endcase
case "`b"
if i != 0
Call HostPutS with "`b `b"
i--
strpoke s i 0
endif
endcase
case " " ; This SPACE case must immediately
if i>55 ; precede the DEFAULT so it will
i=max ; fall through
endif ; do wordwrap stuff here!!!
default
if i >= max
call HostPutS with response
strcat s response
call SetSuccess
return
else
call HostPutS with response
strcat s response
i++
endif
endcase
endswitch
endwhile
endproc