{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
Unit Rg_Msg;
INTERFACE
uses
  dos, overlay, CommDec, common, rg_scan, rg_mbase,
  MkMsgJam;
{
Code: 3358
Data: 12

ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Message Read Object ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions that require a message base to be active in order to run
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}

TYPE
  MsgObj=Object(MsgBaseObj)
    ScanList:pMsgScanListObj;
    { The scan pointers }
    JamBase:JamMsgObj;
    BaseOpen:Boolean;
    { TRUE if base is open }
    MessageFound:Boolean;
    { May or may not be used }

    Constructor Init;
    Destructor  Done; virtual;

    Procedure SelectBase(Which:Word);
              { Picks em out of thousands }
    Procedure OpenBase;
              { Opens the base selected }
    Procedure DelBase;
              { Deletes the base selected }
    Procedure CloseBase;
              { Closes the base }
    Procedure CreateBase;
              { Makes the data files from current data }
    Procedure OpenMakeBase;
              { If there, opens, if not it creates base }
    Function  BaseExists(Which:Word):Boolean;
              { TRUE if base files exist }
    Function  ReturnMCI(Which:Str2):Str255;
              { Returns the info from the specified MCI code as a string }
    Procedure ShowOutboundMail;
              { Searches current base for mail from user, and allows user
                to edit/kill the message }
    Procedure MassMail;
              { Sends copies to multiple recpts in current base, only in
                PrivateOnly bases (email, Netmail)}
    Procedure NewscanBase(Idx:Word);
              { Newscans Idx }
    Procedure Newscan(Opt:Str1);
              { Opt: C, G }
    Procedure LoadMessage;
              { Loads message header and body }
    Procedure LoadMessageHeader;
              { Loads ONLY message header }
    Procedure LoadMessageBody;
              { Loads ONLY message body - Used when LoadMessageHeader is used }
    Procedure PostMessage;
              { Starts posting process }
    Procedure ReadMessages;
              { Reads messages starting from first avail }
    Procedure ScanMessages;
              { Scans for text by user selected options }
    Procedure ListUsers(Opt:Str1);
              { Lists users who meet ACS for Opt.  Opt:R=Read, P=Post, M=Mci }
    Procedure ToggleNewscan(Idx:Word);
              { Toggles newscan of specified base for online read }
    Procedure SetScanAreas;
              { Sets scan areas for online reading }
    Procedure ChangeBase(Idx:Word);
              { Change to base Idx }
    Procedure SetPointers;
              { Calls SetPointerDate based on user input }
    Procedure SetPointerDate(Dte:LongInt);
              { Set date/time of message pointers (UNIX Date) }
    Procedure DisplayMessage;
              { Displays the current message, calls DisplayMessageHdr and DisplayMessageBody }
    Procedure DisplayMessageHdr;
              { Displays the current message header }
    Procedure DisplayMessageBody;
              { Displays the current message body }
    Procedure PreviousMessage;
              { Moves to previous message with SeekPrior - Checks SeekFound }
    Procedure NextMessage;
              { Moves to next message with SeekNext - checks SeekFound }
    Procedure GotoMessage(Which:LongInt);
              { Goes to message specified, not ABS message number }
    Procedure MoveMessage;
              { Moves message to another base }
    Procedure ExtractMessage;
              { Extracts message to a text file }
    Procedure EditMessage;
              { Reposts message to END of base }
    Procedure DeleteMessage;
              { Deletes the message }
    Procedure ReplyToMessage;
              { Replies to current message }
    Procedure IgnoreRemaining;
              { Ignores remaining messages in base }
    Procedure ThreadBack;
              { Search by thread backwards }
    Procedure ThreadForward;
              { Search by thread forward }
    Procedure SetContinuousRead;
              { Turns on continuous read of bases }

{*** Do we keep this function? }
    Procedure ToggleDelete;
              { Toggle Delete? - May delete function }

    Procedure ToggleFlag(Flag:LongInt);
              { Toggles specified flag in message }
    Procedure SetHighMessage;
              { Sets LastRead to this message }
    Procedure AdvanceBase;
              { Advances to next base without reading remaining messages }
    Procedure QuitReading;
              { Stops reading entirely }
    Procedure ListTitles;
              { List titles of messages from current to finish }
    Procedure ZapMessage;
              { Makes no receipt for user when in private only base }
    Procedure ForwardMessage;
              { Forwards message, leaves original undeleted, works in private
                only bases}
    Procedure Extract(Which:LongInt);
              { Extracts message to file }
  end;
  pMsgObj=^MsgObj;

{
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Message Read Object ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
}
IMPLEMENTATION

Uses Rg_OFile;

CONST
  JamWorkBufSize=512;

Procedure NotDone(Const S:Astr);
begin
  Prt('* '+S+' is not implemented yet');
  SysopLog('* '+S+' is not implemented yet');
end;


Constructor MsgObj.Init;
begin
  Inherited init;
  New (ScanList, Init);
  if (ScanList=NIL) then
    Fail;

  JamBase.Init;
  BaseOpen := FALSE;
  MessageFound := FALSE;

end;

Destructor  MsgObj.Done;
begin
  JamBase.Done;
  Dispose(ScanList, Done);
end;

Procedure MsgObj.SelectBase(Which:Word);
begin
  GoToBase(Which);
  JamBase.SetMsgPath(General.DataPath+Data.FileName);
end;

Procedure MsgObj.OpenBase;
begin
  if (JamBase.OpenMsgBase <> 0) then
    begin
      SysopLog('* Unable to open base: '+data.filename);
      SetOk(FALSE);
    end;
  if Ok then BaseOpen := TRUE;
end;

Procedure MsgObj.DelBase;
begin
  JamBase.CloseMsgBase;
  DeleteBase(Currentbase);
end;

Procedure MsgObj.CloseBase;
begin
  JamBase.CloseMsgBase;
  BaseOpen := FALSE;
end;

Procedure MsgObj.CreateBase;
begin
  NotDone('CreateBase');
end;

Procedure MsgObj.OpenMakeBase;
begin
  if BaseExists(CurrentBase) then
    OpenBase
  else
    CreateBase;
end;

Function  MsgObj.BaseExists(Which:Word):Boolean;
begin
  BaseExists := JamBase.MsgBaseExists;
end;

Function  MsgObj.ReturnMCI(Which:Str2):Str255;
              { Returns the info from the specified MCI code as a string }
VAR
  CloseIt:Boolean;
begin
  CloseIt := Not(BaseOpen);
  if CloseIt then
    OpenMakeBase;

  Which := AllCaps(Which);
  Case Which[1] of
      'M' : begin
              Case Which[2] of
                '#' : ReturnMCI := cStr(CmBase(CurrentBase));
                { Message Base number }
                'B' : ReturnMCI := Data.Name;
                { Message Base name }
                'R' : ReturnMCI := cStr(JamBase.NumberOfMsgs-JamBase.GetLastRead(UserNum));
                { Messages remaining to read }
              end;
            end;
      'H' : begin
              Case Which[2] of
                'M' : ReturnMCI := cStr(JamBase.NumberOfMsgs);
                { Highest message available }
              end;
            end;
      'C' : begin
              Case Which[2] of
                'M' : ReturnMCI := cStr(JamBase.GetHighMsgNum);
                { Current Message number }
              end;
            end;
  end;
  if CloseIt then
    CloseBase;
end;

Procedure MsgObj.ShowOutboundMail;
              { Searches current base for mail from user and presents one by
                one to kill }
VAR
  I, J : LongInt;
  C:Char;
  Finished:Boolean;
  U:UserRec;
  AnyFound:Boolean;
  SavedBase:Word;
  CurMessage:LongInt;
  iFile:rgfileobj;
begin

  CurMessage := JamBase.GetLastRead(UserNum);
  readingmail:=TRUE; Finished:=FALSE; abort := FALSE;
  nl;
  i:=1; c:=#0;
  anyfound := FALSE;
  while ((i <= JamBase.NumberOfMsgs) and (not Finished) and (not hangup)) do
  begin
    Jambase.YoursFirst(ThisUser.RealName, ThisUser.Name);

    if JamBase.YoursFound then
    begin
      LoadMessage;
      DisplayMessage;
    end
    else
    begin
      if (c<>'?') then
        begin
          LoadMessage;
          cls;
          nl;
        end;
      prt('Outgoing mail (?=help) : '); onek(c,'QDENPRX?'^M^N);
      case c of
        '?':begin { What commands are available }
              print(^M^J'<^3CR^1>Next message');
              lcmds(20,3,'Re-read message','Edit message');
              lcmds(20,3,'Delete message','Previous message');
              if CoSysOp then
                lcmds(20,3,'Xtract to file','Quit')
              else
                print('<^3Q^1>uit');
              nl;
            end;
        'R':begin { Re-Read the message }
              DisplayMessage;
            end;

        'P':begin { Seek your previous message }
              NotDone('Seek Previous Message');
            end;
        'Q':finished:=TRUE;
        'X':if (MsgSysOp) then extract(i);
        'E':editmessage;
        'D':begin
              DeleteMessage;
            end;

      else
        begin
          JamBase.YoursNext;
        end;
      end;
    end;
  end;

  if (not AnyFound) then
    print('^3No outgoing messages.');
  readingmail:=FALSE;

  CurrentBase := SavedBase;
end;

Procedure MsgObj.MassMail;
              { Sends copies to multiple recpts in current base, only in
                PrivateOnly bases (email, Netmail)}
begin
end;

Procedure MsgObj.NewscanBase(Idx:Word);
              { Newscans Idx }
VAR
  MsgAt:LongInt;
begin
  GotoBase(Idx);
  MsgAt := JamBase.GetLastRead(UserNum-1);
  JamBase.SeekFirst(MsgAt);
  if JamBase.SeekFound then
    ReadMessages;
end;

Procedure MsgObj.Newscan(Opt:Str1);
              { Opt: C, G }
begin
  if caps(opt[1]) = 'C' then
  begin { Current Base }
    NewScanBase(CurrentBase);
  end
  else
  begin { Global }
  end;
end;

Procedure MsgObj.LoadMessage;
              { Loads message header and body }
begin
  NotDone('LoadMessage');
end;

Procedure MsgObj.LoadMessageHeader;
              { Loads ONLY message header }
begin
  NotDone('LoadMessageHeader');
end;

Procedure MsgObj.LoadMessageBody;
              { Loads ONLY message body - Used when LoadMessageHeader is used }
begin
  NotDone('LoadMessageBody');
end;


Procedure MsgObj.PostMessage;
              { Starts posting process }
begin
end;

Procedure MsgObj.ReadMessages;
              { Reads messages starting from first avail }
begin
end;

Procedure MsgObj.ScanMessages;
          { Scans for text by user selected options }
begin
end;

Procedure MsgObj.ListUsers(Opt:Str1);
          { Lists users who meet ACS for Opt.  Opt:R=Read, P=Post, M=Mci }
begin
{  if aacs(acsstring) = true, then user has access }
  Case Opt[1] of
    'R': ;
    'P': ;
    'M': ;
  end;
end;

Procedure MsgObj.ToggleNewscan(Idx:Word);
              { Toggles newscan of specified base for online read }
begin
  ScanList^.SelectUser(UserNum);
  ScanList^.SelectBase(General.MsgPath+Data.FileName);
  ScanList^.ToggleBase;
end;

Procedure MsgObj.SetScanAreas;
              { Sets scan areas for online reading }
begin
end;

Procedure MsgObj.ChangeBase(Idx:Word);
              { Change to base Idx }
begin
  GotoBase(Idx);
end;

Procedure MsgObj.SetPointers;
              { Calls SetPointerDate based on user input }
begin
end;

Procedure MsgObj.SetPointerDate(Dte:LongInt);
              { Set date/time of message pointers (UNIX Date) }
begin
end;

Procedure MsgObj.DisplayMessage;
begin
  DisplayMessageHdr;
  DisplayMessageBody;
end;

Procedure MsgObj.DisplayMessageHdr;
begin

end;

Procedure MsgObj.DisplayMessageBody;
begin
end;


Procedure MsgObj.PreviousMessage;
begin
end;

Procedure MsgObj.NextMessage;
begin
end;

Procedure MsgObj.GotoMessage(Which:LongInt);
              { Goes to message specified, not ABS message number }
begin
end;

Procedure MsgObj.MoveMessage;
begin
end;

Procedure MsgObj.ExtractMessage;
begin
end;

Procedure MsgObj.EditMessage;
              { Reposts message to END of base }
begin
end;

Procedure MsgObj.DeleteMessage;
  Var
    UserNumber : Word;
    U          : UserRec;
begin
  if not(JamBase.IsDeleted) then
  begin
    if (Data.mbtype=4) then { Is it Email? }
    begin
      UserNumber := SearchUser(JamBase.GetTO, TRUE);
      LoadURec(u, UserNum);
      if (U.Waiting > 0) then
        Dec(U.Waiting); { Remove the message from the count }
      SaveURec(U, userNum);
    end;
    JamBase.DeleteMsg;
    JamBase.RewriteHdr;
    SysopLog('* Deleted mail to ' + Jambase.GetTo);
    print('Mail deleted');
  end
  else
  begin
    (*
    if (Data.basetype=4) then { Is it Email? }
    begin
      UserNumber := SearchUser(JamBase.GetTO, TRUE);
      LoadURec(u, UserNumber);
      if (U.Waiting > 0) then
        inc(U.Waiting); { Remove the message from the count }
      SaveURec(U, userNumber);
    end;
    JamBase.NoUndeletFunction;
    JamBase.Rewritehdr;
    SysopLog('Mail undeleted.');
    *)
    NotDone('Message Undelete Function');
  end;
end;


Procedure MsgObj.ReplyToMessage;
              { Replies to current message }
begin
end;

Procedure MsgObj.IgnoreRemaining;
              { Ignores remaining messages in base }
begin
end;

Procedure MsgObj.ThreadBack;
begin
end;

Procedure MsgObj.ThreadForward;
begin
end;

Procedure MsgObj.SetContinuousRead;
begin
end;

Procedure MsgObj.ToggleDelete;
begin
end;

Procedure MsgObj.ToggleFlag(Flag:LongInt);
              { Toggles specified flag in message }
begin
end;

Procedure MsgObj.SetHighMessage;
              { Sets LastRead to this message }
begin
  JamBase.SetLastRead(UserNum, JamBase.GetMsgNum);
end;

Procedure MsgObj.AdvanceBase;
              { Advances to next base without reading remaining messages }
begin
end;

Procedure MsgObj.QuitReading;
              { Stops reading entirely }
begin
end;

Procedure MsgObj.ListTitles;
              { List titles of messages from current to finish }
begin
end;

Procedure MsgObj.ZapMessage;
              { Makes no receipt for user when in private only base }
begin
end;

Procedure MsgObj.ForwardMessage;
              { Forwards message, leaves original undeleted, works in private
                only bases}
begin
end;

procedure MsgObj.extract;
var t:text;
		totload:word;
		s:string;
		b:boolean;
		mheader:mheaderrec;

begin
(*
		 prt(^M^J'Extract filename: ');
		 inputdefault(s,'MSG.TXT',40,'UL',TRUE);
		 if pynq('Are you sure? ') then begin
			 b:=pynq('Strip color codes from output? ');

			 loadheader(x,mheader);

			 assign(t,s);
			 append(t);

			 if (ioresult <> 0) then
				 begin
					 rewrite(t);
					 if (ioresult <> 0) then
						 begin
							 print('Cannot create file.');
							 exit;
						 end;
				 end;

			 for totload := 1 to 7 do
				 begin
					 s:=headerline(mheader,x,himsg,totload);
					 if s <> '' then writeln(t,stripcolor(s));
				 end;

			 writeln(t);

			 totload:=0;
			 reset(msgtxtf,1);
			 seek(msgtxtf,mheader.pointer-1);
			 repeat
					blockread(msgtxtf,s[0],1);
					blockread(msgtxtf,s[1],ord(s[0]));
					Lasterror := IOResult;
					if (Lasterror <> 0) then
						begin
							sysoplog('error loading message text.');
							totload := mheader.textsize;
						end;

					inc(totload,length(s)+1);
					if b then
						s:=stripcolor(s);
					if s[length(s)]=#29 then
						begin
							dec(s[0]);
							write(t,s);
						end
					else
						writeln(t,s);
				until (totload>=mheader.textsize);
				writeln(t);
				close(msgtxtf);
				close(t);
				print(^M^J'Message extracted.'^M^J);
		 end;
	 Lasterror := IOResult;
*)
end;


begin
end.


{ Use this to display a message! }
procedure readmsg(anum,mnum,tnum:word);
var
	mheader:mheaderrec;
	s:string;
	totload,i:word;
	dok,kabort:boolean;
	tooktime:longint;
	f:file;
begin
	allowabort := (CoSysOp) or not (mbforceread in memboard.mbstat);

  AllowContinue := TRUE;

	with mheader do begin

		loadheader(anum,mheader);

    if ((mdeleted in status) or (unvalidated in status)) and
       not (CoSysOp or FromYou(mheader) or ToYou(mheader)) then exit;

		abort:=FALSE;
		next:=FALSE;

    for i := 1 to 6 do
			begin
				s:=headerline(mheader,mnum,tnum,i);
				if (i <> 2) then
					mciallowed := (allowmci in status); { allowit in base name }
				if s<>'' then printacr(s);
				mciallowed := TRUE;
			end;

		nl;
		reset(msgtxtf,1);
		if (IOResult <> 0) then
			begin
				sysoplog('error accessing message text.');
				Allowabort := TRUE;
				exit;
			end;

		if (not abort) then begin
			reading_a_msg:=TRUE;
			mciallowed:=(allowmci in status);
			totload:=0;
			abort:=FALSE;
			next:=FALSE;
			UserColor(memboard.text_color);
			if textsize>0 then
			if (pointer-1+textsize<=filesize(msgtxtf)) and
				 (pointer>0) then begin
					seek(msgtxtf,mheader.pointer-1);
					repeat
						blockread(msgtxtf,s[0],1);
						blockread(msgtxtf,s[1],ord(s[0]));
						Lasterror := IOResult;
						if (Lasterror <> 0) then
							begin
								sysoplog('error loading message text.');
								totload := mheader.textsize;
							end;
						inc(totload,length(s)+1);
						if (' * Origin: ' = copy(s,1,11)) then
							s := '^' + cstr(memboard.origin_color) + s
						else
							if ('---'=copy(s,1,3)) and ((length(s)=3) or (s[4]<>'-')) then
								s:='^'+cstr(memboard.tear_color)+s
							else
								if (pos('> ',copy(s,1,5)) > 0) then
									s:='^'+cstr(memboard.quote_color)+s+'^'+cstr(memboard.text_color)
								else
									if pos(#254,copy(s,1,5))>0 then
										s:='^'+cstr(memboard.tear_color)+s;
						 printacr(s);
					until (totload>=textsize) or (abort);
			end;
			mciallowed:=TRUE;
			reading_a_msg:=FALSE;
			if (dosansion) then redrawforansi;
		end;
		close(msgtxtf);
	end;

	Lasterror := IOResult;

  if (mheader.fileattached > 0) and exist(mheader.subject) then
		begin
      begin
        print(^M^J'^4The following has been attached:');
        findfirst(Mheader.Subject, AnyFile - Directory - VolumeID, DirInfo);
        if (Doserror = 0) then
          begin
            printacr(^M^J'^4Filename.Ext Bytes   hh:mm:ss');
            printacr('------------ ------- --------');
            i := 0;
            while (Doserror = 0) do
              begin
                printacr('^5' + align(Dirinfo.Name) + ' ^4' + mrn(cstr(DirInfo.Size), 7) +
                         ' ^7' + ctim(DirInfo.Size div Rate));
                findnext(DirInfo);
                inc(i, DirInfo.Size div Rate);
            end;
            nl;
            if (incom) and (i <= nsl) and pynq('Download now? ') then
              begin
                i := fileboard;
                fileboard := -1;
                send(Mheader.Subject, FALSE, FALSE, dok, kabort, false, tooktime);
                if dok and not kabort then
                  ssm(Mheader.From.UserNum, caps(thisuser.name) +
                      ' downloaded ' + stripname(Mheader.Subject));
                fileboard := i;
              end
            else
              if (not incom) and (CoSysOp) and (pynq('Move file(s)? ')) then
                begin
                  prt(^M^J'Enter path to move file(s) to: ');
                  input(s, 40);
                  if (s <> '') then
                    begin
                      s := s + stripname(Mheader.Subject);
                      if ((s[length(s)]) <> '\') then
                        s := s + '\';
                      movefile(dok, kabort, FALSE, Mheader.Subject, s);
                    end;
                end
              else
                if (incom) and (i > nsl) then
                  print('Insufficient time for download.'^M^J);
          end
        else
          print('Nothing.'^M^J);
      end;
		end;
	allowabort := TRUE;
  TempPause := (pause in thisuser.flags);
end;