home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / MODEM / HOST1.ZIP / HOSTMSG.SCR < prev    next >
Text File  |  1993-12-06  |  7KB  |  242 lines
  1. ' Message area routines for host mode.
  2.  
  3. sub PackMessages
  4.   dim numkept as integer, numdeleted as integer
  5.   dim oldhdrfile as integer, newhdrfile as integer
  6.   dim oldmsgfile as integer, newmsgfile as integer
  7.   print "Packing messages...";
  8.   numkept = 0
  9.   numdeleted = 0
  10.   oldhdrfile = freefile
  11.   open MsgHeaderFileName for random as #oldhdrfile len = len(TMessageHeader)
  12.   newhdrfile = freefile
  13.   open "hdr.$$$" for random as #newhdrfile len = len(TMessageHeader)
  14.   oldmsgfile = freefile
  15.   open MsgDetailFileName for input as #oldmsgfile
  16.   newmsgfile = freefile
  17.   open "msg.$$$" for output as #newmsgfile
  18.   while not eof(oldhdrfile)
  19.     dim Msg as TMessageHeader
  20.     get #oldhdrfile, , Msg
  21.     if Msg.Killed then
  22.       numdeleted = numdeleted + 1
  23.     else
  24.       seek #oldmsgfile, Msg.DetailPos
  25.       Msg.DetailPos = lof(newmsgfile) + 1
  26.       put #newhdrfile, lof(newhdrfile)+1, Msg
  27.       dim i as integer
  28.       dim s as string
  29.       for i = 0 to Msg.Lines-1
  30.         input #oldmsgfile, s
  31.         print #newmsgfile, s
  32.       next
  33.       numkept = numkept + 1
  34.     end if
  35.     print ".";
  36.   wend
  37.   close oldhdrfile, newhdrfile, oldmsgfile, newmsgfile
  38.   del MsgHeaderFileName
  39.   del MsgDetailFileName
  40.   name "hdr.$$$" as MsgHeaderFileName
  41.   name "msg.$$$" as MsgDetailFileName
  42.   print "Done."
  43.   print numdeleted; " message(s) removed."
  44.   print numkept; " message(s) remaining."
  45.   print
  46. catch err_fileopen
  47.   print
  48.   print
  49. end sub
  50.  
  51. sub WriteMessage(Msg as TMessageHeader)
  52.   dim hfile as integer, dfile as integer, i as integer
  53.   dim tried as integer
  54. tryagain:
  55.   hfile = freefile
  56.   open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
  57.   dfile = freefile
  58.   open MsgDetailFileName for append as #dfile
  59.   Msg.DetailPos = lof(dfile)+1
  60.   put #hfile, lof(hfile)+1, Msg
  61.   for i = 0 to Msg.Lines-1
  62.     print #dfile, MsgLines(i)
  63.   next
  64.   close dfile, hfile
  65. catch err_fileopen
  66.   if tried then
  67.     send #Port, "Error - could not create message file"
  68.   else
  69.     tried = true
  70.     hfile = freefile
  71.     open MsgHeaderFileName for append as #hfile
  72.     close hfile
  73.     goto tryagain
  74.   end if
  75. end sub
  76.  
  77. ' Enter a message
  78.  
  79. declare sub EnterMessage(receiver as string = "", subject as string = "")
  80. sub EnterMessage(receiver as string, subject as string)
  81.   dim Msg as TMessageHeader
  82.   dim tempuser as TUser
  83.   dim i as integer, j as integer, s as string
  84.   if receiver = "" then
  85.     do
  86.       Msg.Receiver = GetLine("     To: ")
  87.       if Msg.Receiver = "" or CallerHungUp then exit sub
  88.       if LookupUser(Msg.Receiver, tempuser) then
  89.         Msg.Receiver = tempuser.Name
  90.         exit do
  91.       elseif OemUpper(Msg.Receiver) = "ALL" then
  92.         exit do
  93.       else
  94.         send #Port,
  95.         send #Port, "The name ";chr(34);Msg.Receiver;chr(34);" was not found in the user list.  Send anyway? ";
  96.         if OemUpper(left(GetLine(), 1)) = "Y" then
  97.           exit do
  98.         end if
  99.       end if
  100.     loop
  101.     Msg.Subject  = GetLine("Subject: ")
  102.     if Msg.Subject = "" then exit sub
  103.   else
  104.     Msg.Receiver = receiver
  105.     Msg.Subject = subject
  106.   end if
  107.   Msg.Private = OemUpper(left(GetLine("Private? N"+BS), 1)) = "Y"
  108.   Msg.Sender = User.Name
  109.   Msg.DateTime = Date + " " + Time
  110.   send #Port,
  111.   send #Port, "Enter your message in the lines below."
  112.   send #Port, "Press enter on a line by itself to save your message."
  113.   send #Port, "    +"; string(70, "-"); "+"
  114.   do
  115.     dim wrapped as string
  116.     wrapped = ""
  117.     do
  118.       if Msg.Lines+1 < 10 then
  119.         send #Port, " ";
  120.       end if
  121.       send #Port, Msg.Lines+1; ": ";
  122.       MsgLines(Msg.Lines) = GetLine("", 72, wrapped)
  123.       if CallerHungUp then exit sub
  124.       if MsgLines(Msg.Lines) = "" then exit do
  125.       wrapped = ""
  126.       if len(MsgLines(Msg.Lines)) >= 72 then
  127.         if instr(MsgLines(Msg.Lines), " ") then
  128.           i = len(MsgLines(Msg.Lines))
  129.           j = 0
  130.           while mid(MsgLines(Msg.Lines), i, 1) <> " "
  131.             i = i - 1
  132.             j = j + 1
  133.           wend
  134.           wrapped = right(MsgLines(Msg.Lines), j)
  135.           MsgLines(Msg.Lines) = left(MsgLines(Msg.Lines), i-1)
  136.           send #Port, string(j, BS);
  137.           send #Port, string(j, " ");
  138.         end if
  139.         send #Port,
  140.       end if
  141.       Msg.Lines = Msg.Lines + 1
  142.     loop
  143.     send #Port,
  144.     s = GetLine("(C)ontinue, (S)ave, or (A)bort? ")
  145.     select case OemUpper(left(s, 1))
  146.       case "S"
  147.         exit do
  148.       case "A"
  149.         send #Port,
  150.         send #Port, "Message aborted."
  151.         exit sub
  152.     end select
  153.     send #Port,
  154.   loop until CallerHungUp
  155.   send #Port,
  156.   send #Port, "Saving message...";
  157.   call WriteMessage(Msg)
  158.   send #Port, "Done."
  159. end sub
  160.  
  161. ' Read messages
  162.  
  163. sub ReadMessages
  164.   dim Msg as TMessageHeader
  165.   dim num as integer, i as integer, s as string
  166.   dim killable as integer
  167.   dim hfile as integer, dfile as integer
  168.   hfile = freefile
  169.   open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
  170.   dfile = freefile
  171.   open MsgDetailFileName for input as #dfile
  172.   num = val(GetLine("Message number to start with (1-"+str(lof(hfile))+")? "))
  173.   do while num > 0 and num <= lof(hfile) and not CallerHungUp
  174.     do
  175.       get #hfile, num, Msg
  176.       killable = (User.Name = Msg.Sender or User.Name = Msg.Receiver or User.Level > 0)
  177.       if User.Level > 0 then exit do
  178.       if not Msg.Killed and (not msg.Private or killable) then exit do
  179.       num = num + 1
  180.       if num > lof(hfile) then
  181.         send #Port,
  182.         send #Port, "End of messages."
  183.         exit sub
  184.       end if
  185.     loop
  186.     send #Port,
  187.     send #Port, " Number: "; num;
  188.     if killable and Msg.Killed then
  189.       send #Port, " (Killed)";
  190.     end if
  191.     send #Port, tab(40); "    Date: "; Msg.DateTime
  192.     send #Port, "     To: "; Msg.Receiver; tab(40); " Private: "; YesNo(Msg.Private)
  193.     send #Port, "   From: "; Msg.Sender;   tab(40); "Received: "; YesNo(Msg.Received)
  194.     send #Port, "Subject: "; Msg.Subject
  195.     send #Port,
  196.     seek #dfile, Msg.DetailPos
  197.     for i = 1 to Msg.Lines
  198.       input #dfile, s
  199.       send #Port, s
  200.     next
  201.     send #Port,
  202.     s = "[N]ext, [R]eply"
  203.     if killable then
  204.       s = s + ", [K]ill"
  205.     end if
  206.     s = s + ", [Q]uit? "
  207.     s = GetLine(s)
  208.     select case OemUpper(left(s, 1))
  209.       case "0" to "9"
  210.         i = val(s)
  211.         if i >= 1 and i <= lof(hfile) then
  212.           num = i
  213.         else
  214.           send #Port,
  215.           send #Port, "There is no message number "; i; "."
  216.         end if
  217.       case "N", ""
  218.         num = num + 1
  219.         if num > lof(hfile) then
  220.           send #Port,
  221.           send #Port, "End of messages."
  222.           exit do
  223.         end if
  224.       case "R"
  225.         call EnterMessage(Msg.Sender, Msg.Subject)
  226.       case "K"
  227.         if killable then
  228.           Msg.Killed = True
  229.           put #hfile, num, Msg
  230.           send #Port, "Message "; num; " killed."
  231.         end if
  232.       case "Q"
  233.         exit do
  234.     end select
  235.   loop
  236.   close hfile, dfile
  237. catch err_fileopen
  238.   send #Port, "No messages available to read"
  239. end sub
  240.  
  241.  
  242.