home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
MODEM
/
HOST1.ZIP
/
HOSTMSG.SCR
< prev
next >
Wrap
Text File
|
1993-12-06
|
7KB
|
242 lines
' Message area routines for host mode.
sub PackMessages
dim numkept as integer, numdeleted as integer
dim oldhdrfile as integer, newhdrfile as integer
dim oldmsgfile as integer, newmsgfile as integer
print "Packing messages...";
numkept = 0
numdeleted = 0
oldhdrfile = freefile
open MsgHeaderFileName for random as #oldhdrfile len = len(TMessageHeader)
newhdrfile = freefile
open "hdr.$$$" for random as #newhdrfile len = len(TMessageHeader)
oldmsgfile = freefile
open MsgDetailFileName for input as #oldmsgfile
newmsgfile = freefile
open "msg.$$$" for output as #newmsgfile
while not eof(oldhdrfile)
dim Msg as TMessageHeader
get #oldhdrfile, , Msg
if Msg.Killed then
numdeleted = numdeleted + 1
else
seek #oldmsgfile, Msg.DetailPos
Msg.DetailPos = lof(newmsgfile) + 1
put #newhdrfile, lof(newhdrfile)+1, Msg
dim i as integer
dim s as string
for i = 0 to Msg.Lines-1
input #oldmsgfile, s
print #newmsgfile, s
next
numkept = numkept + 1
end if
print ".";
wend
close oldhdrfile, newhdrfile, oldmsgfile, newmsgfile
del MsgHeaderFileName
del MsgDetailFileName
name "hdr.$$$" as MsgHeaderFileName
name "msg.$$$" as MsgDetailFileName
print "Done."
print numdeleted; " message(s) removed."
print numkept; " message(s) remaining."
print
catch err_fileopen
print
print
end sub
sub WriteMessage(Msg as TMessageHeader)
dim hfile as integer, dfile as integer, i as integer
dim tried as integer
tryagain:
hfile = freefile
open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
dfile = freefile
open MsgDetailFileName for append as #dfile
Msg.DetailPos = lof(dfile)+1
put #hfile, lof(hfile)+1, Msg
for i = 0 to Msg.Lines-1
print #dfile, MsgLines(i)
next
close dfile, hfile
catch err_fileopen
if tried then
send #Port, "Error - could not create message file"
else
tried = true
hfile = freefile
open MsgHeaderFileName for append as #hfile
close hfile
goto tryagain
end if
end sub
' Enter a message
declare sub EnterMessage(receiver as string = "", subject as string = "")
sub EnterMessage(receiver as string, subject as string)
dim Msg as TMessageHeader
dim tempuser as TUser
dim i as integer, j as integer, s as string
if receiver = "" then
do
Msg.Receiver = GetLine(" To: ")
if Msg.Receiver = "" or CallerHungUp then exit sub
if LookupUser(Msg.Receiver, tempuser) then
Msg.Receiver = tempuser.Name
exit do
elseif OemUpper(Msg.Receiver) = "ALL" then
exit do
else
send #Port,
send #Port, "The name ";chr(34);Msg.Receiver;chr(34);" was not found in the user list. Send anyway? ";
if OemUpper(left(GetLine(), 1)) = "Y" then
exit do
end if
end if
loop
Msg.Subject = GetLine("Subject: ")
if Msg.Subject = "" then exit sub
else
Msg.Receiver = receiver
Msg.Subject = subject
end if
Msg.Private = OemUpper(left(GetLine("Private? N"+BS), 1)) = "Y"
Msg.Sender = User.Name
Msg.DateTime = Date + " " + Time
send #Port,
send #Port, "Enter your message in the lines below."
send #Port, "Press enter on a line by itself to save your message."
send #Port, " +"; string(70, "-"); "+"
do
dim wrapped as string
wrapped = ""
do
if Msg.Lines+1 < 10 then
send #Port, " ";
end if
send #Port, Msg.Lines+1; ": ";
MsgLines(Msg.Lines) = GetLine("", 72, wrapped)
if CallerHungUp then exit sub
if MsgLines(Msg.Lines) = "" then exit do
wrapped = ""
if len(MsgLines(Msg.Lines)) >= 72 then
if instr(MsgLines(Msg.Lines), " ") then
i = len(MsgLines(Msg.Lines))
j = 0
while mid(MsgLines(Msg.Lines), i, 1) <> " "
i = i - 1
j = j + 1
wend
wrapped = right(MsgLines(Msg.Lines), j)
MsgLines(Msg.Lines) = left(MsgLines(Msg.Lines), i-1)
send #Port, string(j, BS);
send #Port, string(j, " ");
end if
send #Port,
end if
Msg.Lines = Msg.Lines + 1
loop
send #Port,
s = GetLine("(C)ontinue, (S)ave, or (A)bort? ")
select case OemUpper(left(s, 1))
case "S"
exit do
case "A"
send #Port,
send #Port, "Message aborted."
exit sub
end select
send #Port,
loop until CallerHungUp
send #Port,
send #Port, "Saving message...";
call WriteMessage(Msg)
send #Port, "Done."
end sub
' Read messages
sub ReadMessages
dim Msg as TMessageHeader
dim num as integer, i as integer, s as string
dim killable as integer
dim hfile as integer, dfile as integer
hfile = freefile
open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
dfile = freefile
open MsgDetailFileName for input as #dfile
num = val(GetLine("Message number to start with (1-"+str(lof(hfile))+")? "))
do while num > 0 and num <= lof(hfile) and not CallerHungUp
do
get #hfile, num, Msg
killable = (User.Name = Msg.Sender or User.Name = Msg.Receiver or User.Level > 0)
if User.Level > 0 then exit do
if not Msg.Killed and (not msg.Private or killable) then exit do
num = num + 1
if num > lof(hfile) then
send #Port,
send #Port, "End of messages."
exit sub
end if
loop
send #Port,
send #Port, " Number: "; num;
if killable and Msg.Killed then
send #Port, " (Killed)";
end if
send #Port, tab(40); " Date: "; Msg.DateTime
send #Port, " To: "; Msg.Receiver; tab(40); " Private: "; YesNo(Msg.Private)
send #Port, " From: "; Msg.Sender; tab(40); "Received: "; YesNo(Msg.Received)
send #Port, "Subject: "; Msg.Subject
send #Port,
seek #dfile, Msg.DetailPos
for i = 1 to Msg.Lines
input #dfile, s
send #Port, s
next
send #Port,
s = "[N]ext, [R]eply"
if killable then
s = s + ", [K]ill"
end if
s = s + ", [Q]uit? "
s = GetLine(s)
select case OemUpper(left(s, 1))
case "0" to "9"
i = val(s)
if i >= 1 and i <= lof(hfile) then
num = i
else
send #Port,
send #Port, "There is no message number "; i; "."
end if
case "N", ""
num = num + 1
if num > lof(hfile) then
send #Port,
send #Port, "End of messages."
exit do
end if
case "R"
call EnterMessage(Msg.Sender, Msg.Subject)
case "K"
if killable then
Msg.Killed = True
put #hfile, num, Msg
send #Port, "Message "; num; " killed."
end if
case "Q"
exit do
end select
loop
close hfile, dfile
catch err_fileopen
send #Port, "No messages available to read"
end sub