renegadebbs/SOURCE/EMAIL.PAS

{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}

{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}

UNIT EMail;

INTERFACE

USES
  Common;

PROCEDURE SSMail(MenuOption: Str50);
PROCEDURE SMail(MassMail: Boolean);
PROCEDURE SEMail(UNum: Integer; ReplyHeader: MHeaderRec);
PROCEDURE AutoReply(ReplyHeader: MHeaderRec);
PROCEDURE ReadMail;
PROCEDURE ShowEmail;

IMPLEMENTATION

USES
  Dos,
  Common5,
  File6,
  Mail0,
  Mail1,
  Mail3,
  SysOp2G,
  SysOp3,
  ShortMsg,
  TimeFunc,
  NodeList,
  MiscUser;

PROCEDURE SSMail(MenuOption: Str50);
VAR
  MHeader: MHeaderRec;
BEGIN
  InResponseTo := '';
  IF (Pos(';',MenuOption) = 0) AND (MenuOption <> '') THEN
    InResponseTo := #1'FeedBack'
  ELSE IF (MenuOption <> '') THEN
    IF (MenuOption[Pos(';', MenuOption) + 1] = '\') THEN
      InResponseTo := '\'+#1+Copy(MenuOption,(Pos(';',MenuOption) + 2),255)
    ELSE
      InResponseTo := #1+Copy(MenuOption,(Pos(';',MenuOption) + 1),255);
  IF (StrToInt(MenuOption) < 1) THEN
    SMail(FALSE)
  ELSE
  BEGIN
    MHeader.Status := [];
    SEMail(StrToInt(MenuOption),MHeader);
  END;
END;

PROCEDURE SMail(MassMail: Boolean);
VAR
  MaxMailListArray: ARRAY [1..255] OF Integer;
  User: UserRecordType;
  MHeader: MHeaderRec;
  SysOpName: STRING[36];
  MassACS: ACString;
  Cmd: Char;
  Counter,
  NumMassMailList: Byte;
  UNum: Integer;
  SaveEmailSent,
  Fee: Word;
  EmailOK: Boolean;

  PROCEDURE CheckItOut(VAR UNum1: Integer; ShowIt: Boolean);
  VAR
    User1: UserRecordType;
    ForUsrUNum,
    SaveUNum1,
    UNum2: Integer;
  BEGIN
    SaveUnum1 := UNum1;
    IF ((UNum1 < 1) OR (UNum1 > (MaxUsers - 1))) THEN
    BEGIN
      UNum1 := 0;
      Exit;
    END;
    LoadURec(User,UNum1);
    IF (User.Waiting >= General.MaxWaiting) OR (NoMail IN User.Flags) AND (NOT CoSysOp) THEN
    BEGIN
      UNum1 := 0;
      { Print(FString.CantEmail); }
      lRGLngStr(46,FALSE);
      Exit;
    END;
    ForUsrUNum := User.ForUsr;
    IF (ForUsrUNum < 1) OR (ForUsrUNum > (MaxUsers - 1)) THEN
      ForUsrUNum := 0;
    IF (ForUsrUNum <> 0) THEN
    BEGIN
      LoadURec(User1,ForUsrUNum);
      IF (ShowIt) THEN
        Print('[> '+Caps(User.Name)+' #'+IntToStr(UNum1)+': message forwarded to '+Caps(User1.Name)+'.');
      UNum1 := ForUsrUNum;
    END;
    IF (ShowIt) THEN
      FOR UNum2 := 1 TO NumMassMailList DO
        IF (MaxMailListArray[UNum2] = UNum1) THEN
        BEGIN
          IF (ShowIt) THEN
            Print('[> '+Caps(User.Name)+' #'+IntToStr(UNum1)+': Can''t send more than once.');
          UNum1 := 0;
          Exit;
        END;
    IF (SaveUNum1 <> UNum1) THEN
      IF ((SaveUNum1 >= 1) AND (SaveUNum1 <= (MaxUsers - 1))) THEN
        LoadURec(User,SaveUNum1);
  END;

  PROCEDURE SendIt(UNum1: Integer);
  BEGIN
    CheckItOut(UNum1,FALSE);
    IF (UNum1 = 0) OR (UNum1 = UserNum) THEN
      Exit;
    IF ((UNum1 >= 1) AND (UNum1 <= (MaxUsers - 1))) THEN
    BEGIN
      LoadURec(User,UNum1);
      IF (UNum1 = 1) THEN
      BEGIN
        Inc(ThisUser.FeedBack);

        IF (FeedBackPostsToday < 255) THEN
          Inc(FeedBackPostsToday);

      END
      ELSE
      BEGIN
        Inc(ThisUser.EmailSent);
        AdjustBalance(General.CreditEmail);

        IF (PrivatePostsToday < 255) THEN
          Inc(PrivatePostsToday);

      END;
      Inc(User.Waiting);
      SaveURec(User,UNum1);
    END;
    WITH MHeader.MTO DO
    BEGIN
      UserNum := UNum1;
      A1S := AllCaps(User.Name);
      Real := AllCaps(User.RealName);
      Name := AllCaps(User.Name);
    END;
    SaveHeader((HiMsg + 1),MHeader);
  END;

  PROCEDURE DoIt(Cmd1: Char);
  VAR
    UNum1: Integer;
  BEGIN
    InitMsgArea(-1);
    FillChar(MHeader,SizeOf(MHeader),0);
    MHeader.MTO.A1S := 'Mass private message';
    MHeader.MTO.Real := MHeader.MTO.A1S;
    IF (NOT InputMessage(FALSE,TRUE,'',MHeader,'',78,500)) THEN
      Exit;
    CASE Cmd1 OF
      '1' : BEGIN
              { Print(FString.MassEmail); }
              lRGLngStr(48,FALSE);
              SysOpLog('Mass-private message sent to: (by ACS "'+MassACS+'")');
              FOR UNum1 := 1 TO (MaxUsers - 1) DO
              BEGIN
                LoadURec(User,UNum1);
                IF (AACS1(User,UNum1,MassACS)) AND (UNum1 <> UserNum) AND (NOT (Deleted IN User.SFlags))
                   AND (NOT (LockedOut IN User.SFlags)) THEN
                BEGIN
                  SendIt(UNum1);
                  SysOpLog('   '+Caps(User.Name));
                  Print('   '+Caps(User.Name));
                END;
              END;
            END;
      '2' : BEGIN
              { Print(FString.MassEmailAll); }
              lRGLngStr(49,FALSE);
              SysOpLog('Mass-private message sent to ALL USERS.');
              FOR UNum1 := 1 TO (MaxUsers - 1) DO
              BEGIN
                LoadURec(User,UNum1);
                IF (UNum1 <> UserNum) AND (NOT (Deleted IN User.SFlags))
                   AND (NOT (LockedOut IN User.SFlags)) THEN
                  SendIt(UNum1);
              END;
            END;
      '3' : BEGIN
              { Print(FString.MassEmail); }
              lRGLngStr(48,FALSE);
              SysOpLog('Mass-private message sent to:');
              FOR UNum1 := 1 TO NumMassMailList DO
              BEGIN
                SendIt(MaxMailListArray[UNum1]);
                SysOpLog('   '+Caps(User.Name));
                Print('   '+Caps(User.Name));
              END;
            END;
    END;
  END;

BEGIN
  EmailOK := TRUE;

  IF ((REmail IN ThisUser.Flags) OR (NOT AACS(General.NormPrivPost))) AND (NOT CoSysOp) THEN
  BEGIN
    NL;
    Print('^7Your access privledges do not include sending private messages!^1');
    EmailOk := FALSE;
  END
  ELSE IF ((PrivatePostsToday >= General.MaxPrivPost) AND (NOT CoSysOp)) THEN
  BEGIN
    NL;
    Print('^7You have already sent the maximum private messages allowed per day!^1');
    EmailOk := FALSE;
  END
  ELSE IF (AccountBalance < General.CreditEmail) AND (General.CreditEmail > 0) AND (NOT (FNoCredits IN ThisUser.Flags)) THEN
  BEGIN
    NL;
    Print('^7Insufficient account balance to send private messages!^1');
    EmailOk := FALSE;
  END;

  IF (NOT EmailOk) THEN
  BEGIN
    IF (InWFCMenu) THEN
      PauseScr(FALSE);
    Exit;
  END;

  IF (NOT MassMail) THEN
  BEGIN
    IF (AACS(General.NetMailACS)) AND PYNQ(lRGLngStr(51,TRUE){FString.IsNetMail},0,FALSE) THEN
    BEGIN

      PrintF('NETMHELP');

      SysOpName := '';

      WITH MHeader.From DO
        GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,FALSE);

      IF (SysOpName = '') THEN
        Exit;

      MHeader.From.Name := SysOpName;

      MHeader.Status := [NetMail];

      SaveEmailSent := ThisUser.EmailSent;

      SEMail(0,MHeader);

      IF (ThisUser.EmailSent > SaveEmailSent) THEN
        Inc(ThisUser.Debit,Fee);

    END
    ELSE
    BEGIN

      { Print(FString.SendEMail); }
      lRGLngStr(47,FALSE);
      NL;
      Print('Enter User Number, Name, or Partial Search String.');
      Prt(': ');
      lFindUserWS(UNum);
      IF (UNum < 1) THEN
      BEGIN
        NL;
        PauseScr(FALSE);
      END
      ELSE
      BEGIN
        MHeader.Status := [];
        SEMail(UNum,MHeader);
      END;
    END;
  END
  ELSE
  BEGIN
    InResponseTo := '';
    NumMassMailList := 0;
    FillChar(MaxMailListArray,SizeOf(MaxMailListArray),0);
    NL;
    Print('Mass private message: Send message to multiple users.');
    IF (NOT CoSysOp) THEN
      Cmd := '3'
    ELSE
    BEGIN
      NL;
      Print('(1) Send to users with a certain ACS.');
      Print('(2) Send to all system users.');
      Print('(3) Send private messages to a list of users.');
      NL;
      Prt('Your choice [^51^4-^53^4,^5Q^4=^5Quit^4]: ');
      OneK(Cmd,'Q123',TRUE,TRUE);
    END;
    CASE Cmd OF
      '1' : BEGIN
              NL;
              Prt('Enter ACS: ');
              MPL((SizeOf(ACString) - 1));
              InputL(MassACS,(SizeOf(ACString) - 1));
              IF (MassACS <> '') THEN
              BEGIN
                NL;
                Print('Users marked by ACS "'+MassACS+'":');
                Abort := FALSE;
                Next := FALSE;
                Reset(UserFile);
                UNum := 1;
                WHILE (UNum <= (MaxUsers - 1)) AND (NOT Abort) AND (NOT HangUp) DO
                BEGIN
                  LoadURec(User,UNum);
                  IF (AACS1(User,UNum,MassACS)) AND (UNum <> UserNum) AND (NOT (Deleted IN User.SFlags))
                     AND (NOT (LockedOut IN User.SFlags)) THEN
                  BEGIN
                    PrintACR('   '+Caps(User.Name));
                    Inc(NumMassMailList);
                  END;
                  Inc(UNum);
                  WKey;
                END;
                Close(UserFile);
              END;
            END;
      '2' : BEGIN
              NL;
              Print('All users marked for mass-private messages.');
              Abort := FALSE;
              Next := FALSE;
              Reset(UserFile);
              UNum := 1;
              WHILE (UNum <= (MaxUsers - 1)) AND (NOT Abort) AND (NOT HangUp) DO  (* Was X - 1 *)
              BEGIN
                LoadURec(User,UNum);
                IF (UNum <> UserNum) AND (NOT (Deleted IN User.SFlags)) AND (NOT (LockedOut IN User.SFlags)) THEN
                BEGIN
                  PrintACR('   '+Caps(User.Name));
                  Inc(NumMassMailList);
                END;
                Inc(UNum);
                WKey;
              END;
              Close(UserFile);
            END;
      '3' : BEGIN
              NL;
              Print('You can send mass private messages to '
                    +AOnOff(CoSysOp,'255',IntToStr(General.MaxMassMailList))+' user''s');
              Print('Enter a blank line to stop entering names.');
              UNum := 1;
              WHILE (UNum <> 0) AND (NumMassMailList < General.MaxMassMailList) OR (UNum <> 0) AND (NumMassMailList < 255)
                AND (CoSysOp) DO
              BEGIN
                NL;
                Print('Enter User Number, Name, or Partial Search String.');
                Prt(': ');
                lFindUserWS(UNum);
                FOR Counter := 1 TO NumMassMailList DO
                  IF (MaxMailListArray[Counter] = UNum) THEN
                    UNum := 0;
                IF (UNum = UserNum) THEN
                  UNum := 0;
                IF (UNum > 0) THEN
                BEGIN
                  LoadURec(User,UNum);
                  IF (LockedOut IN User.SFlags) OR (Deleted IN User.SFlags) THEN
                    UNum := 0
                  ELSE
                  BEGIN
                    Inc(NumMassMailList);
                    MaxMailListArray[NumMassMailList] := UNum;
                  END;
                END;
              END;
              IF (NumMassMailList > 0) THEN
              BEGIN
                NL;
                Print('Users marked:');
                Abort := FALSE;
                Next := FALSE;
                Reset(UserFile);
                UNum := 1;
                WHILE (UNum <= NumMassMailList) AND (NOT Abort) AND (NOT HangUp) DO
                BEGIN
                  LoadURec(User,MaxMailListArray[UNum]);
                  PrintACR('   '+Caps(User.Name));
                  Inc(UNum);
                  WKey;
                END;
                Close(UserFile);
              END;
            END;
    END;
    IF (Cmd <> 'Q') THEN
    BEGIN
      NL;
      Print('Total users listed: '+IntToStr(NumMassMailList));
      IF (NumMassMailList > 0) THEN
      BEGIN
        NL;
        IF PYNQ('Send mass-private messages to the above list? ',0,FALSE) THEN
          DoIt(Cmd);
      END;
    END;
  END;
  SaveURec(ThisUser,UserNum);
END;

PROCEDURE SEMail(UNum: Integer; ReplyHeader: MHeaderRec);
VAR
  User: UserRecordType;
  MHeader: MHeaderRec;
  Counter,
  Counter1: Byte;
  SaveReadMsgArea: Integer;
  EmailOk: Boolean;
BEGIN

  IF (NOT (NetMail IN ReplyHeader.Status)) THEN
  BEGIN

    IF (UNum < 1) OR (UNum > (MaxUsers - 1)) THEN
      Exit;

    LoadURec(User,UNum);

    MHeader.Status := [];

    EmailOk := TRUE;

    IF ((REmail IN ThisUser.Flags) OR (NOT AACS(General.NormPrivPost))) AND (NOT CoSysOp) THEN
    BEGIN
      NL;
      Print('^7Your access privledges do not include sending private messages!^1');
      EmailOk := FALSE;
    END
    ELSE IF (AccountBalance < General.CreditEmail) AND (General.CreditEmail > 0) AND (NOT (FNoCredits IN ThisUser.Flags)) THEN
    BEGIN
      NL;
      Print('^7Insufficient account balance to send private messages!^1');
      EmailOk := FALSE;
    END
    ELSE IF (PrivatePostsToday >= General.MaxPrivPost) AND (NOT CoSysOp) THEN
    BEGIN
      NL;
      Print('^7You have already sent the maximum private messages allowed per day!^1');
      EmailOk := FALSE;
    END
    ELSE IF ((UNum = 1) AND (FeedbackPostsToday >= General.MaxFBack) AND (NOT CoSysOp)) THEN
    BEGIN
      NL;
      Print('^7You have already sent the maximum allowed feedback per day!^1');
      EmailOk := FALSE;
    END
    ELSE IF (User.Waiting >= General.MaxWaiting) AND (NOT CoSysOp) THEN
    BEGIN
      NL;
      Print('^7The mailbox for this user is full!^1');
      EmailOk := FALSE;
    END
    ELSE IF (NoMail IN User.Flags) AND (NOT CoSysOp) THEN
    BEGIN
      NL;
      Print('^7The mailbox for this user is closed!^1');
      EmailOk := FALSE;
    END;

    IF (NOT EmailOk) THEN
    BEGIN
      IF (INWFCMenu) THEN
        PauseScr(FALSE);
      Exit;
    END;

    IF ((User.ForUsr < 1) OR (User.ForUsr > (MaxUsers - 1))) THEN
      User.ForUsr := 0;

    IF (User.ForUsr > 0) THEN
    BEGIN
      UNum := User.ForUsr;
      LoadURec(User,UNum);
      IF (CoSysOp) THEN
      BEGIN
        NL;
        IF (NOT PYNQ('Send private message to '+Caps(User.Name)+'? ',0,FALSE)) THEN
          Exit;
      END;
    END;
  END
  ELSE
  BEGIN

    IF (NOT AACS(General.NetMailACS)) THEN
    BEGIN
      { Print(FString.NoNetMail); }
      lRGLngStr(50,FALSE);
      PauseScr(FALSE);
      Exit;
    END;

    User.Name := ReplyHeader.From.Name;
    User.RealName := ReplyHeader.From.Name;
    UNum := 0;
    MHeader.Status := [NetMail];

  END;

  SaveReadMsgArea := ReadMsgArea;

  InitMsgArea(-1);

  WITH MHeader.MTO DO
  BEGIN
    UserNum := UNum;
    A1S := AllCaps(User.Name);
    Real := AllCaps(User.RealName);
    Name := AllCaps(User.Name);
  END;

  IF (InputMessage(FALSE,TRUE,'',MHeader,'',78,500)) THEN
  BEGIN

    IF (NetMail IN ReplyHeader.Status) THEN
    BEGIN
      Include(MHeader.Status,NetMail);

      MHeader.NetAttribute := General.NetAttribute * [Intransit,Private,Crash,KillSent,Hold,Local];

      ChangeFlags(MHeader);

      Counter1 := 0;
      Counter := 0;
      WHILE (Counter <= 19) AND (Counter1 = 0) DO
      BEGIN
        IF (General.AKA[Counter].Zone = ReplyHeader.From.Zone) AND (General.AKA[Counter].Zone <> 0) THEN
          Counter1 := Counter;
        Inc(Counter);
      END;

      IF (CoSysop) AND (General.AKA[Counter1].Zone <> ReplyHeader.From.Zone) THEN
      BEGIN
        FOR Counter := 0 TO 19 DO
          IF (General.AKA[Counter].Net > 0) THEN
          BEGIN
            PrintACR(PadLeftInt((Counter + 1),2)+'. '+
                     IntToStr(General.AKA[Counter].Zone)+':'+
                     IntToStr(General.AKA[Counter].Net)+'/'+
                     IntToStr(General.AKA[Counter].Node)+
                     AOnOff((General.AKA[Counter].Point > 0),'.'+IntToStr(General.AKA[Counter].Point),''));
          END;
        InputByteWOC('%LFUse which AKA',Counter,[NumbersOnly],1,20);
        IF (Counter >= 1) OR (Counter <= 20) THEN
          Counter1 := (Counter - 1);
      END;

      WITH MHeader.From DO
      BEGIN
        Zone := General.AKA[Counter1].Zone;
        Net := General.AKA[Counter1].Net;
        Node := General.AKA[Counter1].Node;
        Point := General.AKA[Counter1].Point;
      END;

      WITH MHeader.MTO DO
      BEGIN
        Zone := ReplyHeader.From.Zone;
        Net := ReplyHeader.From.Net;
        Node := ReplyHeader.From.Node;
        Point := ReplyHeader.From.Point;
      END;

    END;

    IF (UNum = 1) THEN
    BEGIN
      Inc(ThisUser.FeedBack);

      IF (FeedBackPostsToday < 255) THEN
        Inc(FeedbackPostsToday);

    END
    ELSE
    BEGIN
      Inc(ThisUser.EmailSent);
      AdjustBalance(General.CreditEmail);

      IF (PrivatePostsToday < 255) THEN
        Inc(PrivatePostsToday);
    END;

    IF (UNum >= 1) AND (UNum <= (MaxUsers - 1)) THEN
    BEGIN
      LoadURec(User,UNum);
      Inc(User.Waiting);
      SaveURec(User,UNum);
    END;

    SaveHeader((HiMsg + 1),MHeader);

    IF (UserOn) THEN
      SysOpLog(AOnOff((NetMail IN MHeader.Status),'Netmail','Private message')+' sent to ^5'+Caps(User.Name)+'.');

    Print('^1'+AOnOff((NetMail IN MHeader.Status),'Netmail','Private message')+' sent to ^5'+Caps(User.Name)+'^1.');

    Update_Screen;
  END;

  InitMsgArea(SaveReadMsgArea);

  SaveURec(ThisUser,UserNum);
END;

PROCEDURE AutoReply(ReplyHeader: MHeaderRec);
VAR
  SysOpName: Str36;
  Fee: Word;
  TotPrivMsg: LongInt;
BEGIN

  IF AACS(General.NetMailACS) AND (NOT (NetMail IN ReplyHeader.Status)) AND
     PYNQ(lRGLngStr(51,TRUE){FString.IsNetMail},0,FALSE) THEN
  BEGIN
    ReplyHeader.Status := [NetMail];
    LastAuthor := 0;
    SysOpName := UseName(ReplyHeader.From.Anon,
                         AOnOff(MARealName IN MemMsgArea.MAFlags,
                         ReplyHeader.From.Real,
                         ReplyHeader.From.A1S));
    WITH ReplyHeader.From DO
      GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,FALSE);
    IF (SysOpName = '') THEN
      Exit;
    ReplyHeader.From.Name := SysOpName;
  END;

  TotPrivMsg := (ThisUser.EmailSent + ThisUser.FeedBack);

  IF (LastAuthor = 0) AND (NOT (NetMail IN ReplyHeader.Status)) THEN
  BEGIN
    LastAuthor := SearchUser(ReplyHeader.From.A1S,TRUE);
    IF (LastAuthor = 0) THEN
      Print('^7That user does not have an account on this BBS!^1')
    ELSE
      SEMail(LastAuthor,ReplyHeader);
  END
  ELSE
  BEGIN
    SEMail(LastAuthor,ReplyHeader);
    IF ((ThisUser.EmailSent + ThisUser.FeedBack) > TotPrivMsg) THEN
      IF (NetMail IN ReplyHeader.Status) THEN
      BEGIN
        WITH ReplyHeader.From DO
          GetNetAddress(SysOpName,Zone,Net,Node,Point,Fee,TRUE);
        Inc(ThisUser.Debit,Fee)
      END
      ELSE
        SendShortMessage(ReplyHeader.From.UserNum,
                         Caps(ThisUser.Name)+' replied to "'+AOnOff((ReplyHeader.FileAttached > 0),
                         StripName(ReplyHeader.Subject),ReplyHeader.Subject)+'" on '+DateStr+' '+TimeStr+'.');
  END;
END;

PROCEDURE ReadMail;
TYPE
  MessageArrayType = ARRAY [1..255] OF SmallWord;
VAR
  MessageArray: MessageArrayType;
  User: UserRecordType;
  MHeader: MHeaderRec;
  InputStr: AStr;
  Cmd: Char;
  SNum,
  MNum: Byte;
  UNum,
  SaveReadMsgArea: Integer;
  DeleteOk,
  ReplyOk: Boolean;

  PROCEDURE RemoveCurrent(VAR SNum1,MNum1: Byte; VAR MessageArray1: MessageArrayType);
  VAR
    MsgNum: Byte;
  BEGIN
    Dec(MNum1);
    FOR MsgNum := SNum1 TO MNum1 DO
      MessageArray1[MsgNum] := MessageArray1[MsgNum + 1];
    IF (SNum1 > MNum1) THEN
      SNum1 := MNum1;
  END;

  PROCEDURE ReScan(VAR MNum1: Byte; VAR MessageArray1: MessageArrayType);
  VAR
    MsgNum: Word;
  BEGIN
    FillChar(MessageArray1,SizeOf(MessageArray1),0);
    MNum1 := 0;
    MsgNum := 1;
    WHILE (MsgNum <= HiMsg) DO
    BEGIN
      LoadHeader(MsgNum,MHeader);
      IF (MHeader.MTO.UserNum = UserNum) AND (NOT (MDeleted IN MHeader.Status)) THEN
      BEGIN
        Inc(MNum1);
        MessageArray1[MNum1] := MsgNum;
      END;
      Inc(MsgNum);
    END;
    ThisUser.Waiting := 0;
    SaveURec(ThisUser,UserNum);
  END;

  PROCEDURE ListYourEmail(VAR SNum1: Byte; MNum1: Byte; MessageArray1: MessageArrayType);
  VAR
    DT: DateTime;
    TempStr: AStr;
    j,
    NumDone: Byte;
  BEGIN
    IF (SNum1 < 1) OR (SNum1 > MNum1) THEN
      SNum1 := 1;
    Abort := FALSE;
    Next := FALSE;
    (*
    CLS;
    PrintACR('<13><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
    PrintACR('<13><><13> Num <13><><13> Date/Time         <13><><13> Sender                 <13><><13> Subject                  <13><>');
    PrintACR('<13><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
    *)
    lRGLngStr(60,FALSE);
    NumDone := 1;
    WHILE (NumDone < (PageLength - 5)) AND (SNum1 >= 1) AND (SNum1 <= MNum) AND (NOT Abort) AND (NOT HangUp) DO
    BEGIN
      LoadHeader(MessageArray1[SNum1],MHeader);
      TempStr := '<13>'+PadRightInt(SNum1,5);
      IF (MHeader.From.Anon IN [1,2]) THEN
        TempStr := TempStr + '  <13>[Unknown]          '
      ELSE
      BEGIN
        PackToDate(DT,MHeader.Date);
        j := DT.Hour;
        IF (j > 12) THEN
          Dec(j,12);
        IF (j = 0) THEN
          j := 12;
        TempStr := TempStr + '  <13>'+ZeroPad(IntToStr(DT.Day))+
                             ' '+Copy(MonthString[DT.Month],1,3)+
                             ' '+IntToStr(DT.Year)+
                             '  '+ZeroPad(IntToStr(j))+
                             ':'+ZeroPad(IntToStr(DT.Min))+
                             AOnOff((DT.Hour >= 12),'p','a');
      END;
      TempStr := TempStr + ' <13>'+PadLeftStr(UseName(MHeader.From.Anon,MHeader.From.A1S),23);
      IF (MHeader.FileAttached = 0) THEN
        TempStr := TempStr + '  <13>'+Copy(MHeader.Subject,1,25)
      ELSE
        TempStr := TempStr + '  <13>'+StripName(Copy(MHeader.Subject,1,25));
      PrintACR(TempStr);
      WKey;
      Inc(SNum1);
      Inc(NumDone);
    END;
  END;

BEGIN
  ReadingMail := TRUE;
  SaveReadMsgArea := ReadMsgArea;
  InitMsgArea(-1);
  ReScan(MNum,MessageArray);
  IF (MNum = 0) THEN
    lRGLngStr(52,FALSE) { Print(FString.NoMailWaiting); }
  ELSE
  BEGIN
    Abort := FALSE;
    Next := FALSE;
    SNum := 1;
    Cmd := 'L';
    REPEAT

      REPEAT
        IF (Cmd = 'L') THEN
          ListYourEmail(SNum,MNum,MessageArray);
        NL;
        Prt('Select message (^51^4-^5'+IntToStr(MNum)+'^4) [^5?^4=^5First^4,^5<CR>^4=^5Next^4,^5Q^4=^5Quit^4)]: ');
        MPL(Length(IntToStr(MNum)));
        ScanInput(InputStr,'Q?'^M);
        Cmd := InputStr[1];
        IF (Cmd = 'Q') THEN
          SNum := 0
        ELSE
        BEGIN
          IF (Cmd IN ['-',^M]) THEN
            Cmd := 'L'
          ELSE IF (Cmd = '?') THEN
          BEGIN
            SNum := 1;
            Cmd := 'L';
          END
          ELSE
          BEGIN
            SNum := StrToInt(InputStr);
            IF (SNum >= 1) AND (SNum <= MNum) THEN
              Cmd := 'Q'
            ELSE
            BEGIN
              NL;
              Print('^7The range must be from 1 to '+IntToStr(MNum)+'^1');
              PauseScr(FALSE);
              SNum := 1;
              Cmd := 'L';
            END;
          END;
        END;
      UNTIL (Cmd = 'Q') OR (HangUp);

      IF (SNum >= 1) AND (SNum <= MNum) AND (NOT HangUp) THEN
      BEGIN
        Cmd := #0;
        REPEAT
          LoadHeader(MessageArray[SNum],MHeader);
          IF (Cmd <> '?') THEN
          BEGIN
            CLS;
            ReadMsg(MessageArray[SNum],SNum,MNum);
          END;
          { Prt(FString.ReadingEmail); }
          LOneK(lRGLngStr(13,TRUE),Cmd,'Q-ADFGLNRSUVXZM?'^M,TRUE,TRUE);
          CASE Cmd OF
            '-' : IF (SNum > 1) THEN
                    Dec(SNum)
                  ELSE
                    SNum := MNum;
            'A' : ;
            'D' : BEGIN
                    DeleteOk := TRUE;
                    IF (MHeader.FileAttached > 0) THEN
                      IF (CheckBatchDL(MHeader.Subject)) THEN
                      BEGIN
                        NL;
                        Print('If you delete this message, you will not be able to download');
                        Print('the attached file currently in your batch queue.');
                        NL;
                        IF NOT PYNQ('Continue with deletion? ',0,FALSE) THEN
                          DeleteOk := FALSE;
                      END;
                    IF (DeleteOk) THEN
                    BEGIN
                      Include(MHeader.Status,MDeleted);
                      SaveHeader(MessageArray[SNum],MHeader);
                      IF (MHeader.FileAttached = 1) THEN
                        Kill(MHeader.Subject);

                      IF (NOT (NetMail IN Mheader.Status)) AND
                         (MHeader.From.UserNum >= 1) AND
                         (MHeader.From.UserNum >= (MaxUsers - 1)) THEN
                        SendShortMessage(MHeader.From.UserNum,Caps(ThisUser.Name)+' read "'+StripName(MHeader.Subject)+
                                         '" on '+DateStr+' '+TimeStr+'.');
                      RemoveCurrent(SNum,MNum,MessageArray);
                    END;
                  END;
            'F' : ForwardMessage(MessageArray[SNum]);
            'G' : InputByteWOC('%LFGoto message',SNum,[NumbersOnly],1,MNum);
            'M' : IF (NOT MsgSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE
                  BEGIN
                    MoveMsg(MessageArray[SNum]);
                    LoadHeader(MessageArray[SNum],MHeader);
                    IF (MDeleted IN MHeader.Status) THEN
                      RemoveCurrent(SNum,MNum,MessageArray);
                  END;
            'R' : BEGIN
                    ReplyOk := TRUE;
                    IF (MHeader.From.Anon IN [1,2]) THEN
                      CASE MHeader.From.Anon OF
                        1 : ReplyOk := AACS(General.AnonPrivRead);
                        2 : ReplyOk := AACS(General.CSOP);
                      END;
                    IF (NOT ReplyOk) THEN
                      Print('%LF^7You can not reply to an anonymous message!^1%LF%PA')
                    ELSE
                    BEGIN
                      DumpQuote(MHeader);
                      AutoReply(MHeader);
                      DeleteOk := TRUE;
                      NL;
                      IF (NOT PYNQ('Delete original message? ',0,TRUE)) THEN
                        DeleteOk := FALSE;
                      IF (DeleteOk) AND (MHeader.FileAttached > 0) THEN
                        IF (CheckBatchDL(MHeader.Subject)) THEN
                        BEGIN
                          NL;
                          Print('If you delete this message, you will not be able to download the attached');
                          Print('file currently in your batch queue.');
                          NL;
                          IF NOT PYNQ('Continue with deletion? ',0,FALSE) THEN
                            DeleteOk := FALSE;
                        END;
                      IF (DeleteOk) THEN
                      BEGIN
                        Include(MHeader.Status,MDeleted);
                        IF (MHeader.FileAttached = 1) THEN
                          Kill(MHeader.Subject);
                        SaveHeader(MessageArray[SNum],MHeader);
                        RemoveCurrent(SNum,MNum,MessageArray);
                      END;
                    END;
                  END;
            'S' : IF (NOT CoSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN
                    Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA')
                  ELSE
                  BEGIN
                    LoadURec(User,LastAuthor);
                    ShowUserInfo(1,LastAuthor,User);
                    NL;
                    PauseScr(FALSE);
                  END;
            'U' : IF (NOT CoSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN
                    Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA')
                  ELSE IF (CheckPW) THEN
                    UserEditor(LastAuthor);
            'V' : IF (NOT CoSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE IF (LastAuthor < 1) OR (LastAuthor > (MaxUsers - 1)) THEN
                    Print('%LF^7The sender of this message does not have an account on this BBS!^1%LF%PA')
                  ELSE
                  BEGIN
                    LoadURec(User,LastAuthor);
                    AutoVal(User,LastAuthor);
                  END;
            'X' : IF (NOT CoSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE
                    ExtractMsgToFile(MessageArray[SNum],MHeader);
            'Z' : IF (NOT MsgSysOp) THEN
                    Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
                  ELSE
                  BEGIN
                    DeleteOk := TRUE;
                    IF (MHeader.FileAttached > 0) THEN
                      IF CheckBatchDL(MHeader.Subject) THEN
                      BEGIN
                        NL;
                        Print('If you zap this message, you will not be able to download the attached');
                        Print('file currently in your batch queue.');
                        NL;
                        IF NOT PYNQ('Continue with zapping? ',0,FALSE) THEN
                          DeleteOk := FALSE;
                      END;
                    IF (DeleteOk) THEN
                    BEGIN
                      Include(MHeader.Status,MDeleted);
                      SaveHeader(MessageArray[SNum],MHeader);
                      IF (MHeader.FileAttached = 1) THEN
                        Kill(MHeader.Subject);
                      RemoveCurrent(SNum,MNum,MessageArray);
                    END;
                  END;
            '?' : BEGIN
                    NL;
                    LCmds(17,3,'-Read previous','Again');
                    LCmds(17,3,'Delete message','Forward messages');
                    LCmds(17,3,'Goto message','List messages');
                    LCmds(17,3,'Move message','Next message');
                    LCmds(17,3,'Reply to message','Show user');
                    LCmds(17,3,'User editor','Validate user');
                    LCmds(17,3,'Xtract to file','Zap (Delete w/o reciept)');
                    LCmds(17,3,'Quit','');
                  END;
          ELSE
            IF (SNum < MNum) THEN
              Inc(SNum)
            ELSE
              SNum := 1;
          END;
          IF (MNum = 0) THEN
            Cmd := 'Q';
        UNTIL (Cmd IN ['L','Q']) OR (HangUp);
      END;
      IF (Cmd = 'Q') THEN
        IF (RMsg IN ThisUser.Flags) AND (NOT CoSysOp) AND (MNum > 0) AND (NOT InWFCMenu) THEN
        BEGIN
          { Print(FString.SorryReply); }
          lRGLngStr(53,FALSE);
          SNum := 1;
          Cmd := 'L';
        END;
    UNTIL (Cmd = 'Q') OR (HangUp);
  END;
  Inc(ThisUser.Waiting,MNum);
  SaveURec(ThisUser,UserNum);
  LoadMsgArea(SaveReadMsgArea);
  ReadingMail := FALSE;
END;

PROCEDURE ShowEmail;
VAR
  User: UserRecordType;
  MHeader: MHeaderRec;
  Cmd: Char;
  SaveReadMsgArea: Integer;
  MsgNum,
  PreviousMsgNum,
  MaxMsgs: Word;
  AnyFound: Boolean;
BEGIN
  ReadingMail := TRUE;
  SaveReadMsgArea := ReadMsgArea;
  InitMsgArea(-1);
  Abort := FALSE;
  Next := FALSE;
  AnyFound := FALSE;
  Cmd := #0;
  MaxMsgs := HiMsg;
  MsgNum := 1;
  WHILE ((MsgNum <= MaxMsgs) AND (Cmd <> 'Q') AND (NOT HangUp)) DO
  BEGIN
    LoadHeader(MsgNum,MHeader);
    IF (MHeader.From.UserNum <> UserNum) THEN
      Inc(MsgNum)
    ELSE
    BEGIN
      AnyFound := TRUE;
      IF (Cmd <> '?') THEN
      BEGIN
        CLS;
        ReadMsg(MsgNum,MsgNum,MaxMsgs);
      END;
      NL;
      Prt('Private messages sent [^5?^4=^5Help^4]: ');
      IF (CoSysOp) THEN
        OneK(Cmd,'Q-ADENX?'^M,TRUE,TRUE)
      ELSE
        OneK(Cmd,'Q-ADEN?'^M,TRUE,TRUE);
      CASE Cmd OF
        '-' : BEGIN
                PreviousMsgNum := (MsgNum - 1);
                WHILE (PreviousMsgNum >= 1) AND (PreviousMsgNum <> MsgNum) DO
                BEGIN
                  LoadHeader(PreviousMsgNum,MHeader);
                  IF (MHeader.From.UserNum <> UserNum) THEN
                    Dec(PreviousMsgNum)
                  ELSE
                    MsgNum := PreviousMsgNum;
                END;
              END;
        'A' : ;
        'D' : IF (NOT (MDeleted IN MHeader.Status)) THEN
              BEGIN
                Include(MHeader.Status,MDeleted);
                SaveHeader(MsgNum,MHeader);
                LoadURec(User,MHeader.MTO.UserNum);
                IF (User.Waiting > 0) THEN
                  Dec(User.Waiting);
                SaveURec(User,MHeader.MTO.UserNum);
                Print('%LFPrivate message deleted.');
                SysOpLog('* Deleted private message to '+Caps(MHeader.From.A1S));
              END
              ELSE
              BEGIN
                Exclude(MHeader.Status,MDeleted);
                SaveHeader(MsgNum,MHeader);
                LoadURec(User,MHeader.MTO.UserNum);
                IF (User.Waiting < 255) THEN
                  Inc(User.Waiting);
                SaveURec(User,MHeader.MTO.UserNum);
                Print('%LFPrivate message undeleted.');
                SysOpLog('* Undeleted private message to '+Caps(MHeader.From.A1S));
              END;
        'E' : EditMessageText(MsgNum);
        'X' : IF (NOT CoSysOp) THEN
                Print('%LF^7You do not have the required access level for this option!^1%LF%PA')
              ELSE
                ExtractMsgToFile(MsgNum,MHeader);
        '?' : BEGIN
                Print('%LF<^3CR^1>Next message');
                LCmds(20,3,'Again','Edit message');
                LCmds(20,3,'Delete message','-Previous message');
                IF (CoSysOp) THEN
                  LCmds(20,3,'Xtract to file','Quit')
                ELSE
                  LCmds(20,3,'Quit','');
              END;
      ELSE
        Inc(MsgNum);
      END;
    END;
  END;
  IF (NOT AnyFound) THEN
  BEGIN
    NL;
    Print('^3No private messages sent.');
  END;
  LoadMsgArea(SaveReadMsgArea);
  ReadingMail := FALSE;
END;

END.