unit message1;
{$O+,F+}
interface

uses dos,crt,bbskv,bbskern,engine2,rgoods,ranchlin,sys_msg;

procedure savemsg(tm:messagerec);
procedure entermsg(name,name2:string; reply:boolean);
procedure purgemsg(name:namestr);
procedure readmsg(name:string);

implementation

const tmsg='$tmpmsg$.$$$';

procedure savemsg(tm:messagerec);
begin
  if send2robot then begin ditchmem ; exit; end;
  if
    not(exist(msgname))
  then
    begin
      assign(msgfile,msgname);
      rewrite(msgfile);
      write(msgfile,tm);
      close(msgfile);
      exit;
    end;
  assign(msgfile,msgname);
  reset(msgfile);
  seek(msgfile,filesize(msgfile));
  write(msgfile,tm);
  close(msgfile);
  ditchmem;
end;

procedure entermsg(name,name2:string; reply:boolean);
var tq,bq:string;
    tqi,bqi,shit:integer;
    quit,done:boolean;
    ctmp2:char;
    tch:char;
begin
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  done:=false; tq:=''; bq:=''; tqi:=1; bqi:=-1;
  fillchar(tempmsg,sizeof(tempmsg),#00);
  startmsg;
  sendln('');
  repeat
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    sysmsg(360);
    get('seclaq');
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    ctmp2:=upcase(ctmp);
    case ctmp2 of
      'E' : begin
              quit:=false;
              sysmsg(361);
              if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
              get('clidq');
              tch:=upcase(ctmp);
              case tch of
                'C' : begin
                        sysmsg(362);
                        tq:=getln(2);
                        sysmsg(363);
                        displin(tq);
                        sysmsg(364);
                        editlin(tq);
                      end;
                'L' : begin
                        sysmsg(365);
                        listmsg;
                      end;
                'I' : begin
                        sysmsg(366);
                        if
                          thisline>16
                        then
                          begin
                            sysmsg(367);
                          end
                        else
                          begin
                            sysmsg(368);
                            tq:=getln(2);
                            instxt(tq);
                          end;
                      end;
                'D' : begin
                        sysmsg(369);
                        tq:=getln(2);
                        dellin(tq,tq);
                      end;
              end; {case ctmp - edit menu}
            end;
      'Q' : begin
              quit:=false;
              if
                not(reply)
              then
                sysmsg(370)
              else
                begin
                  sysmsg(385);
                  repeat
                    sysmsg(371);
                    tq:=getln(2);
                    val(tq,tqi,shit);
                    if
                      tq[1]='?'
                    then
                      begin
                        sendln('');
                        listquo;
                      end;
                    if
                      upcase(tq[1])='Q'
                    then
                      quit:=true;
                  until (tqi>0) or quit or quitnow or lostcarrier;
                  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                  if not quit then
                  repeat
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    sysmsg(372);
                    bq:=getln(2);
                    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                    val(bq,bqi,shit);
                    if
                      bq[1]='?'
                    then
                      begin
                        sendln('');
                        listquo;
                      end;
                    if
                      upcase(bq[1])='Q'
                    then
                      quit:=true;
                  until (bqi>0) or quit or quitnow or lostcarrier;
                  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
                  if tq>bq then quit:=true;
                  if
                    not(quit)
                  then
                    copyquote(tq,bq);
                end;
              end;

      'A' : begin
              sysmsg(373);
              done:=true;
            end;

      'S' : begin
              sysmsg(374);
              for
                index:=1 to 16
              do
                tempmsg.text[index]:=message[index]^;
              tempmsg.name:=name2;
              tempmsg.from:=name;
              tempmsg.lines:=bottomline;
              savemsg(tempmsg);
              done:=true;
              sysmsg(375);
            end;
      'C' : begin
              sysmsg(376);
              if
                thisline>16
              then
                sysmsg(377)
              else
                contmsg;
            end;
      'L' : begin
              sysmsg(378);
              listmsg;
            end;
    end; {case}
  until done or quitnow or lostcarrier;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

procedure purgemsg(name:namestr);
var f1,f2:file of messagerec;
    te:messagerec;
begin
  nukefile(tmsg);
  if
    not(exist(msgname))
  then
    exit;
  if
    fsize(msgname)=0
  then
    exit;
  assign(f1,msgname);
  rename(f1,tmsg);
  assign(f1,tmsg);
  assign(f2,msgname);
  reset(f1);
  rewrite(f2);
  repeat
    read(f1,te);
    if
      not(upcasestr(te.name)=upcasestr(user.name))
    then
      write(f2,te);
  until eof(f1);
  close(f1);
  close(f2);
  erase(f1);
end;

procedure readmsg(name:string);
var tch:char;
    msgfrom,msgto:string;
    currentmsg:word;
    zeromsg,
    done:boolean;
    mcount:word;
begin
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  currentmsg:=0;  done:=false; mcount:=0; zeromsg:=false;
  if
    not(exist(msgname))
  then
    zeromsg:=true;
  if
    fsize(msgname)=0
  then
    zeromsg:=true;
  if not zeromsg then assign(msgfile,msgname);
  if not zeromsg then
  repeat
    reset(msgfile);
    seek(msgfile,currentmsg);
    read(msgfile,tempmsg);
    if eof(msgfile) then done:=true;
    close(msgfile);
    inc(currentmsg);
    if
      upcasestr(tempmsg.name)=upcasestr(name)
    then
      begin
        inc(mcount);
        parameter[1]:=tempmsg.from;
        sysmsg(379);
        index:=0;
        repeat
          inc(index);
          sendln(tempmsg.text[index]);
        until (tempmsg.text[index]='') or quitnow or lostcarrier;
        if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
        sysmsg(380);
        get('rn');
        if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
        tch:=upcase(ctmp);
        if
          tch='R'
        then
          begin
            sysmsg(381);
            msgfrom:=tempmsg.name;
            msgto:=tempmsg.from;
            copymsgtoquo(tempmsg);
            quoted:=true;
            entermsg(msgfrom,msgto,quoted);
            sendln('');
          end
        else
          sysmsg(382);
      end;
  until done or quitnow or lostcarrier;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  if
    mcount=0
  then
    sysmsg(383)
  else
    begin
      purgemsg(user.name);
      sysmsg(384);
    end;
end;

begin
end.
