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