eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
mysticbbs/mystic/bbs_msgbase.pas

4044 lines
111 KiB
ObjectPascal
Raw Blame History

Unit bbs_MsgBase;
{$I M_OPS.PAS}
Interface
Uses
m_FileIO,
m_DateTime,
bbs_Common,
bbs_General,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
bbs_MsgBase_Squish;
Type
TMsgBase = Class
MBaseFile : File of RecMessageBase;
MScanFile : File of MScanRec;
GroupFile : File of RecGroup;
TotalMsgs : Integer;
TotalConf : Integer;
MsgBase : PMsgBaseABS;
MBase : RecMessageBase;
MScan : MScanRec;
Group : RecGroup;
MsgText : RecMessageText;
MsgTextSize : SmallInt;
WereMsgs : Boolean;
Reading : Boolean;
Constructor Create (Var Owner: Pointer);
Destructor Destroy; Override;
Function IsQuotedText (Str: String) : Boolean;
Function OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean;
Procedure AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String);
Procedure AssignMessageData (Var Msg: PMsgBaseABS);
Function GetBaseByNum (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Function GetBaseCompressed (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Function GetBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Procedure GetMessageStats (Var TempBase: RecMessageBase; Var Total, New, Yours: LongInt);
Function GetTotalBases (Compressed: Boolean) : LongInt;
Function GetTotalMessages (Var TempBase: RecMessageBase) : LongInt;
Procedure PostTextFile (Data: String; AllowCodes: Boolean);
Function SaveMessage (mArea: RecMessageBase; mFrom, mTo, mSubj: String; mAddr: RecEchoMailAddr; mLines: Integer) : Boolean;
Function ListAreas (Compress: Boolean) : Integer;
Procedure ChangeArea (Data: String);
Procedure SetMessageScan;
Procedure GetMessageScan;
Procedure SendMassEmail;
Procedure MessageUpload (Var CurLine: SmallInt);
Procedure ReplyMessage (Email: Boolean; ListMode: Byte; ReplyID: String);
Procedure EditMessage;
Function ReadMessages (Mode : Char; SearchStr: String) : Boolean;
Procedure ToggleNewScan (QWK: Boolean; Data: String);
Procedure MessageGroupChange (Ops: String; FirstBase, Intro : Boolean);
Procedure PostMessage (Email: Boolean; Data: String);
Procedure CheckEMail;
Procedure MessageNewScan (Data: String);
Procedure MessageQuickScan (Data: String);
Procedure GlobalMessageSearch (Mode: Char);
Procedure SetMessagePointers;
Procedure ViewSentEmail;
Function ResolveOrigin (var mArea: RecMessageBase) : String;
// QWK and QWKE goodies
Procedure DownloadQWK (Extended: Boolean; Data: String);
Procedure UploadREP;
Procedure WriteCONTROLDAT (Extended: Boolean);
Procedure WriteTOREADEREXT;
Procedure WriteDOORID (Extended: Boolean);
Function WriteMSGDAT (Extended: Boolean) : LongInt;
End;
Implementation
Uses
m_Strings,
bbs_Core,
bbs_User,
bbs_NodeInfo,
bbs_cfg_UserEdit;
Const
QwkControlName = 'MYSTICQWK';
Type
BSingle = Array [0..3] of Byte;
QwkNdxHdr = Record
MsgPos : BSingle;
Junk : Byte;
End;
QwkDATHdr = Record {128 bytes}
Status : Char;
MSGNum : Array [1..7] of Char;
Date : Array [1..8] of Char;
Time : Array [1..5] of Char;
UpTO : Array [1..25] of Char;
UpFROM : Array [1..25] of Char;
Subject : Array [1..25] of Char;
PassWord : Array [1..12] of Char;
ReferNum : Array [1..8] of Char;
NumChunk : Array [1..6] of Char;
Active : Char; {225 active, 226 killed}
ConfNum : Word;
Junk : Word;
NetTag : Char;
End;
Constructor TMsgBase.Create (Var Owner: Pointer);
Begin
Inherited Create;
MBase.Name := 'None';
Group.Name := 'None';
WereMsgs := False;
Reading := False;
MsgTextSize := 0;
End;
Destructor TMsgBase.Destroy;
Begin
Inherited Destroy;
End;
Function TMsgBase.IsQuotedText (Str: String) : Boolean;
Var
Temp : Byte;
Begin
Temp := Pos('>', strStripL(Str, ' '));
Result := (Temp > 0) and (Temp < 5);
End;
Function TMsgBase.OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean;
Begin
Result := False;
Case Area.BaseType of
0 : Msg := New(PMsgBaseJAM, Init);
1 : Msg := New(PMsgBaseSquish, Init);
End;
Msg^.SetMsgPath (Area.Path + Area.FileName);
Msg^.SetTempFile (Session.TempPath + 'msgbuf.');
If Not Msg^.OpenMsgBase Then
If Not Msg^.CreateMsgBase (Area.MaxMsgs, Area.MaxAge) Then Begin
Dispose (Msg, Done);
Exit;
End Else
If Not Msg^.OpenMsgBase Then Begin
Dispose (Msg, Done);
Exit;
End;
Result := True;
End;
Function TMsgBase.GetBaseByNum (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Var
F : File;
Begin
Result := False;
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
If ioSeek(F, Num) And (ioRead(F, TempBase)) Then
Result := True;
Close (F);
End;
Function TMsgBase.GetBaseCompressed (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Var
F : File;
Count : LongInt;
Begin
If Not Config.MCompress Then Begin
Result := GetBaseByNum(Num, TempBase);
Exit;
End;
Result := False;
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
Count := 0;
While Not Eof(F) And (Count <> Num) Do Begin
ioRead (F, TempBase);
If Session.User.Access(TempBase.ListACS) Then Inc(Count);
End;
Close (F);
Result := Count = Num;
End;
Function TMsgBase.GetBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Var
F : File;
Begin
Result := False;
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
While Not Eof(F) Do Begin
ioRead(F, TempBase);
If TempBase.Index = Num Then Begin
Result := True;
Break;
End;
End;
Close (F);
End;
Function TMsgBase.GetTotalBases (Compressed: Boolean) : LongInt;
Var
F : File;
TempBase : RecMessageBase;
Begin
Result := 0;
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
If Not Compressed Then
Result := FileSize(F)
Else Begin
While Not Eof(F) Do Begin
ioRead (F, TempBase);
If Session.User.Access(TempBase.ListACS) Then
Inc (Result);
End;
End;
Close (F);
End;
Function TMsgBase.GetTotalMessages (Var TempBase: RecMessageBase) : LongInt;
Var
TempMsg : PMsgBaseABS;
Begin
Result := 0;
If TempBase.Name = 'None' Then Exit;
If OpenCreateBase(TempMsg, TempBase) Then Begin
Result := TempMsg^.NumberOfMsgs;
TempMsg^.CloseMsgBase;
Dispose (TempMsg, Done);
End;
End;
Procedure TMsgBase.GetMessageStats (Var TempBase: RecMessageBase; Var Total, New, Yours: LongInt);
Var
TempMsg : PMsgBaseABS;
MsgTo : String[40];
Begin
Total := 0;
New := 0;
Yours := 0;
If TempBase.Name = 'None' Then Exit;
If OpenCreateBase(TempMsg, TempBase) Then Begin
Total := TempMsg^.NumberOfMsgs;
TempMsg^.SeekFirst(TempMsg^.GetLastRead(Session.User.UserNum) + 1);
While TempMsg^.SeekFound Do Begin
Inc (New);
TempMsg^.MsgStartUp;
MsgTo := strUpper(TempMsg^.GetTo);
If (MsgTo = strUpper(Session.User.ThisUser.Handle)) or (MsgTo = strUpper(Session.User.ThisUser.RealName)) Then
Inc(Yours);
TempMsg^.SeekNext;
End;
TempMsg^.CloseMsgBase;
Dispose (TempMsg, Done);
End;
End;
Procedure TMsgBase.SetMessageScan;
Var
Count : Integer;
Temp : MScanRec;
Begin
Temp.NewScan := MBase.DefNScan;
Temp.QwkScan := MBase.DefQScan;
Assign (MScanFile, MBase.Path + MBase.FileName + '.scn');
{$I-} Reset (MScanFile); {$I+}
If IoResult <> 0 Then ReWrite (MScanFile);
If FileSize(MScanFile) < Session.User.UserNum - 1 Then Begin
Seek (MScanFile, FileSize(MScanFile));
For Count := FileSize(MScanFile) to Session.User.UserNum - 1 Do
Write (MScanFile, Temp);
End;
Seek (MScanFile, Session.User.UserNum - 1);
Write (MScanFile, MScan);
Close (MScanFile);
End;
Procedure TMsgBase.GetMessageScan;
Begin
MScan.NewScan := MBase.DefNScan;
MScan.QwkScan := MBase.DefQScan;
Assign (MScanFile, MBase.Path + MBase.FileName + '.scn');
{$I-} Reset (MScanFile); {$I+}
If IoResult <> 0 Then Exit;
If FileSize(MScanFile) >= Session.User.UserNum Then Begin {filesize and usernum are }
Seek (MScanFile, Session.User.UserNum - 1); {not zero based }
Read (MScanFile, MScan);
{ added security measure for forced reading bases }
If MBase.DefNScan = 2 Then MScan.NewScan := 2;
If MBase.DefQScan = 2 Then MScan.QwkScan := 2;
End;
Close (MScanFile);
End;
Procedure TMsgBase.AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String);
Var
DF : File;
S : String;
A : SmallInt;
Begin
If MBase.NetType > 0 Then Begin
Msg^.DoStringLn (#1 + 'MSGID: ' + strAddr2Str(Config.NetAddress[MBase.NetAddr]) + ' ' + strI2H(CurDateDos));
If ReplyID <> '' Then
Msg^.DoStringLn (#1 + 'REPLY: ' + ReplyID);
End;
For A := 1 to Lines Do
Msg^.DoStringLn(MsgText[A]);
If Session.User.ThisUser.SigUse and (Session.User.ThisUser.SigLength > 0) Then Begin
Assign (DF, Config.DataPath + 'autosig.dat');
Reset (DF, 1);
Seek (DF, Session.User.ThisUser.SigOffset);
Msg^.DoStringLn('');
For A := 1 to Session.User.ThisUser.SigLength Do Begin
BlockRead (DF, S[0], 1);
BlockRead (DF, S[1], Ord(S[0]));
Msg^.DoStringLn(S);
End;
Close (DF);
End;
If MBase.NetType > 0 Then Begin
Msg^.DoStringLn (#13 + '--- ' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ')');
Msg^.DoStringLn (' * Origin: ' + ResolveOrigin(MBase) + ' (' + strAddr2Str(Config.NetAddress[MBase.NetAddr]) + ')');
End;
End;
Procedure TMsgBase.AssignMessageData (Var Msg: PMsgBaseABS);
Var
Addr : RecEchoMailAddr;
SemFile : Text;
Begin
Msg^.StartNewMsg;
If MBase.Flags And MBRealNames <> 0 Then
Msg^.SetFrom(Session.User.ThisUser.RealName)
Else
Msg^.SetFrom(Session.User.ThisUser.Handle);
Msg^.SetLocal (True);
If MBase.NetType > 0 Then Begin
If MBase.NetType = 3 Then
Msg^.SetMailType(mmtNetMail)
Else
Msg^.SetMailType(mmtEchoMail);
Addr := Config.NetAddress[MBase.NetAddr];
Msg^.SetOrig(Addr);
Case MBase.NetType of
1 : Begin
Assign (SemFile, Config.SemaPath + fn_SemFileEcho);
If Session.ExitLevel > 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 5;
End;
2 : Begin
Assign (SemFile, Config.SemaPath + fn_SemFileNews);
If Session.ExitLevel > 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 5;
End;
3 : Begin
Assign (SemFile, Config.SemaPath + fn_SemFileNet);
If Session.ExitLevel = 5 Then Session.ExitLevel := 7 Else Session.ExitLevel := 6;
End;
End;
ReWrite (SemFile);
Close (SemFile);
End Else
Msg^.SetMailType(mmtNormal);
Msg^.SetPriv (MBase.Flags and MBPrivate <> 0);
Msg^.SetDate (DateDos2Str(CurDateDos, 1));
Msg^.SetTime (TimeDos2Str(CurDateDos, False));
End;
Procedure TMsgBase.ChangeArea (Data: String);
Var
Count : LongInt;
Total : Word;
TempBase : RecMessageBase;
Begin
If (Data = '+') or (Data = '-') Then Begin
Count := Session.User.ThisUser.LastMBase;
Repeat
Case Data[1] of
'+' : Inc(Count);
'-' : Dec(Count);
End;
If Not GetBaseByNum(Count, TempBase) Then Exit;
If Session.User.Access(TempBase.ListACS) Then Begin
Session.User.ThisUser.LastMBase := Count;
MBase := TempBase;
Exit;
End;
Until False;
End;
Count := strS2I(Data);
If Count > 0 Then Begin
If GetBaseByNum (Count, TempBase) Then
If Session.User.Access(TempBase.ListACS) Then Begin
Session.User.ThisUser.LastMBase := Count;
MBase := TempBase;
End;
Exit;
End;
If Pos('NOLIST', strUpper(Data)) > 0 Then
Total := GetTotalBases(Config.MCompress)
Else
Total := ListAreas(Config.MCompress);
If Total = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(94));
Exit;
End;
Repeat
Session.io.OutFull (Session.GetPrompt(102));
Case Session.io.OneKeyRange(#13 + '?Q', 1, Total) of
#13,
'Q': Exit;
'?': Total := ListAreas(Config.MCompress);
Else
Break;
End;
Until False;
Count := Session.io.RangeValue;
If GetBaseCompressed(Count, TempBase) Then
If Session.User.Access(MBase.ListACS) Then Begin
MBase := TempBase;
Session.User.ThisUser.LastMBase := Count;
End;
End;
Procedure TMsgBase.ToggleNewScan (QWK: Boolean; Data: String);
Var
Total: LongInt;
Procedure List_Bases;
Begin
Session.io.PausePtr := 1;
Session.io.AllowPause := True;
If QWK Then
Session.io.OutFullLn (Session.GetPrompt(90))
Else
Session.io.OutFullLn (Session.GetPrompt(91));
Session.io.OutFullLn (Session.GetPrompt(92));
Total := 0;
Reset (MBaseFile);
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ListACS) Then Begin
Inc (Total);
Session.io.PromptInfo[1] := strI2S(Total);
Session.io.PromptInfo[2] := MBase.Name;
GetMessageScan;
If ((MScan.NewScan > 0) And Not QWK) or ((MScan.QwkScan > 0) And QWK) Then
Session.io.PromptInfo[3] := 'Yes'
Else
Session.io.PromptInfo[3] := 'No';
Session.io.OutFull (Session.GetPrompt(93));
If (Total MOD Config.MColumns = 0) And (Total > 0) Then Session.io.OutRawLn('');
End;
If EOF(MBaseFile) and (Total MOD Config.MColumns <> 0) Then Session.io.OutRawLn('');
If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then
Case Session.io.MorePrompt of
'N' : Break;
'C' : Session.io.AllowPause := False;
End;
End;
Session.io.OutFull (Session.GetPrompt(430));
End;
Procedure ToggleBase (A : Word);
Var
B : Word;
Begin
B := 0;
Reset (MBaseFile);
Repeat
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ListACS) Then Inc(B);
If A = B Then Break;
Until False;
GetMessageScan;
Session.io.PromptInfo[1] := MBase.Name;
If QWK Then Begin
Case MScan.QwkScan of
0 : Begin
MScan.QwkScan := 1;
Session.io.OutFullLn (Session.GetPrompt(97));
End;
1 : Begin
MScan.QwkScan := 0;
Session.io.OutFullLn (Session.GetPrompt(96));
End;
2 : Session.io.OutFullLn (Session.GetPrompt(302));
End;
End Else Begin
Case MScan.NewScan of
0 : Begin
MScan.NewScan := 1;
Session.io.OutFullLn (Session.GetPrompt(99));
End;
1 : Begin
MScan.NewScan := 0;
Session.io.OutFullLn (Session.GetPrompt(98));
End;
2 : Session.io.OutFullLn (Session.GetPrompt(302));
End;
End;
SetMessageScan;
End;
Var
Old : RecMessageBase;
Temp : String[11];
A : Word;
N1 : Word;
N2 : Word;
Begin
Old := MBase;
Session.User.IgnoreGroup := Pos('/ALLGROUP', strUpper(Data)) > 0;
List_Bases;
If Total = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(94));
MBase := Old;
Session.User.IgnoreGroup := False;
Exit;
End;
Repeat
Session.io.OutFull (Session.GetPrompt(95));
Temp := Session.io.GetInput(11, 11, 12, '');
If (Temp = '') or (Temp = 'Q') Then Break;
If Temp = '?' Then
List_Bases
Else Begin
If Pos('-', Temp) > 0 Then Begin
N1 := strS2I(Copy(Temp, 1, Pos('-', Temp) - 1));
N2 := strS2I(Copy(Temp, Pos('-', Temp) + 1, Length(Temp)));
End Else Begin
N1 := strS2I(Temp);
N2 := N1;
End;
For A := N1 to N2 Do
If (A > 0) and (A <= Total) Then ToggleBase(A);
End;
Until False;
Close (MBaseFile);
MBase := Old;
Session.User.IgnoreGroup := False;
End;
Procedure TMsgBase.MessageGroupChange (Ops : String; FirstBase, Intro : Boolean);
Var
Count : Word;
Total : Word;
tGroup : RecGroup;
tMBase : RecMessageBase;
tLast : Word;
Areas : Word;
Data : Word;
Begin
tGroup := Group;
If (Ops = '+') or (Ops = '-') Then Begin
Reset (GroupFile);
Count := Session.User.ThisUser.LastMGroup - 1;
Repeat
Case Ops[1] of
'+' : Inc(Count);
'-' : Dec(Count);
End;
{$I-}
Seek (GroupFile, Count);
Read (GroupFile, Group);
{$I+}
If IoResult <> 0 Then Break;
If Session.User.Access(Group.ACS) Then Begin
Session.User.ThisUser.LastMGroup := FilePos(GroupFile);
Close (GroupFile);
If Intro Then Session.io.OutFile ('group' + strI2S(Session.User.ThisUser.LastMGroup), True, 0);
If FirstBase Then Begin
Session.User.ThisUser.LastMBase := 0;
ChangeArea('+');
End;
Exit;
End;
Until False;
Close (GroupFile);
Group := tGroup;
Exit;
End;
Data := strS2I(Ops);
Reset (GroupFile);
If Data > 0 Then Begin
If Data > FileSize(GroupFile) Then Begin
Close (GroupFile);
Exit;
End;
Seek (GroupFile, Data - 1);
Read (GroupFile, Group);
If Session.User.Access(Group.ACS) Then Begin
Session.User.ThisUser.LastMGroup := FilePos(GroupFile);
If Intro Then
Session.io.OutFile ('group' + strI2S(Data), True, 0);
End Else
Group := tGroup;
Close (GroupFile);
If FirstBase Then Begin
Session.User.ThisUser.LastMBase := 1;
ChangeArea('+');
End;
Exit;
End;
Session.io.PausePtr := 1;
Session.io.AllowPause := True;
Session.io.OutFullLn (Session.GetPrompt(174)); { was after reset(groupfile) }
tLast := Session.User.ThisUser.LastMGroup;
Total := 0;
While Not Eof(GroupFile) Do Begin
Read (GroupFile, Group);
If Not Group.Hidden And Session.User.Access(Group.ACS) Then Begin
Areas := 0;
Session.User.ThisUser.LastMGroup := FilePos(GroupFile);
If Config.MShowBases Then Begin
Reset (MBaseFile);
Read (MBaseFile, tMBase); { Skip EMAIL base }
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, tMBase);
If Session.User.Access(tMBase.ListACS) Then Inc(Areas);
End;
Close (MBaseFile);
End;
Inc (Total);
Session.io.PromptInfo[1] := strI2S(Total);
Session.io.PromptInfo[2] := Group.Name;
Session.io.PromptInfo[3] := strI2S(Areas);
Session.io.OutFullLn (Session.GetPrompt(175));
If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then
Case Session.io.MorePrompt of
'N' : Break;
'C' : Session.io.AllowPause := False;
End;
End;
End;
Session.User.ThisUser.LastMGroup := tLast;
If Total = 0 Then
Session.io.OutFullLn (Session.GetPrompt(176))
Else Begin
Session.io.OutFull (Session.GetPrompt(177));
Session.io.OneKeyRange(#13 + 'Q', 1, Total);
Count := Session.io.RangeValue;
If (Count > 0) and (Count <= Total) Then Begin
Total := 0;
Reset (GroupFile);
Repeat
Read (GroupFile, Group);
If Not Group.Hidden And Session.User.Access(Group.ACS) Then Inc(Total);
If Count = Total Then Break;
Until False;
Session.User.ThisUser.LastMGroup := FilePos(GroupFile);
If Intro Then Session.io.OutFile ('group' + strI2S(Session.User.ThisUser.LastMGroup), True, 0);
Session.User.ThisUser.LastMBase := 1;
ChangeArea('+');
End Else
Group := tGroup;
End;
Close (GroupFile);
End;
Function TMsgBase.ListAreas (Compress: Boolean) : Integer;
Var
Total : LongInt = 0;
Listed : LongInt = 0;
TempBase : RecMessageBase;
TempFile : File;
Begin
Result := 1;
Assign (TempFile, Config.DataPath + 'mbases.dat');
If Not ioReset(TempFile, SizeOf(RecMessageBase), fmRWDN) Then Exit;
Session.io.PausePtr := 1;
Session.io.AllowPause := True;
While Not Eof(TempFile) Do Begin
ioRead (TempFile, TempBase);
If Session.User.Access(TempBase.ListACS) Then Begin
Inc (Listed);
If Listed = 1 Then
Session.io.OutFullLn(Session.GetPrompt(100));
If Compress Then
Inc (Total)
Else
Total := FilePos(TempFile);
Session.io.PromptInfo[1] := strI2S(Total);
Session.io.PromptInfo[2] := TempBase.Name;
Session.io.PromptInfo[3] := strI2S(GetTotalMessages(TempBase));
Session.io.OutFull (Session.GetPrompt(101));
If (Listed MOD Config.MColumns = 0) and (Listed > 0) Then Session.io.OutRawLn('');
End;
If Eof(TempFile) and (Listed MOD Config.MColumns <> 0) Then Session.io.OutRawLn('');
If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then
Case Session.io.MorePrompt of
'N' : Begin
Total := FileSize(TempFile);
Break;
End;
'C' : Session.io.AllowPause := False;
End;
End;
Close (TempFile);
Result := Total;
End;
Procedure TMsgBase.ReplyMessage (Email: Boolean; ListMode: Byte; ReplyID: String);
Var
ToWho : String[30];
Subj : String[60];
Addr : RecEchomailAddr;
MsgNew : PMsgBaseABS;
TempStr : String;
Initials : String[4];
WrapData : String;
DoWrap : Boolean = True;
QuoteFile : Text;
Lines : SmallInt;
Begin
If Not Session.User.Access(MBase.PostACS) Then Begin
Session.io.OutFullLn (Session.GetPrompt(105));
Exit;
End;
Set_Node_Action (Session.GetPrompt(349));
Repeat
If ListMode = 0 Then
Session.io.OutFull (Session.GetPrompt(407))
Else
Session.io.OutFull (Session.GetPrompt(408));
ToWho := Session.io.GetInput(30, 30, 18, MsgBase^.GetFrom);
If ToWho = '' Then Exit;
If Not Email Then Break;
If Not Session.User.FindUser(ToWho, False) Then Begin
Session.io.PromptInfo[1] := ToWho;
Session.io.OutFullLn (Session.GetPrompt(161));
ToWho := MsgBase^.GetFrom;
End Else
Break;
Until False;
If MBase.NetType = 3 Then Begin
Session.io.OutFull (Session.GetPrompt(342));
MsgBase^.GetOrig(Addr);
TempStr := Session.io.GetInput(20, 20, 12, strAddr2Str(Addr));
If Not strStr2Addr (TempStr, Addr) Then Exit;
End;
Subj := MsgBase^.GetSubj;
If Pos ('Re:', Subj) = 0 Then Subj := 'Re: ' + Subj;
Session.io.OutFull (Session.GetPrompt(451));
Subj := Session.io.GetInput (60, 60, 11, Subj);
If Subj = '' Then Exit;
Assign (QuoteFile, Session.TempPath + 'msgtmp');
{$I-} ReWrite (QuoteFile); {$I+}
If IoResult = 0 Then Begin
Initials := strInitials(MsgBase^.GetFrom) + '> ';
TempStr := Session.GetPrompt(464);
TempStr := strReplace(TempStr, '|&1', MsgBase^.GetDate);
TempStr := strReplace(TempStr, '|&2', MsgBase^.GetFrom);
TempStr := strReplace(TempStr, '|&3', Initials);
WriteLn (QuoteFile, TempStr);
WriteLn (QuoteFile, ' ');
MsgBase^.MsgTxtStartUp;
WrapData := '';
While Not MsgBase^.EOM Do Begin
TempStr := MsgBase^.GetString(79);
If TempStr[1] = #1 Then Continue;
DoWrap := Not IsQuotedText(TempStr);
If DoWrap Then Begin
If WrapData <> '' Then Begin
If TempStr = '' Then Begin
WriteLn (QuoteFile, Initials + strStripB(WrapData, ' '));
WriteLn (QuoteFile, Initials);
WrapData := '';
Continue;
End;
TempStr := strStripB(WrapData, ' ') + ' ' + strStripL(TempStr, ' ');
End;
strWrap (TempStr, WrapData, 75);
WriteLn (QuoteFile, Initials + Copy(TempStr, 1, 75));
End Else
WriteLn (QuoteFile, Initials + Copy(TempStr, 1, 75));
End;
Close (QuoteFile);
End;
Lines := 0;
Session.io.PromptInfo[1] := ToWho;
If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, Subj) Then Begin
Session.io.OutFull (Session.GetPrompt(107));
If Not OpenCreateBase(MsgNew, MBase) Then Exit;
AssignMessageData(MsgNew);
Case MBase.NetType of
2 : MsgNew^.SetTo('All');
3 : Begin
MsgNew^.SetDest (Addr);
MsgNew^.SetCrash (Config.netCrash);
MsgNew^.SetHold (Config.netHold);
MsgNew^.SetKillSent (Config.netKillSent);
MsgNew^.SetTo (ToWho);
Addr := Config.NetAddress[MBase.NetAddr];
MsgNew^.SetOrig (Addr);
End;
Else
MsgNew^.SetTo (ToWho);
End;
MsgNew^.SetSubj (Subj);
MsgNew^.SetRefer (MsgBase^.GetMsgNum);
AppendMessageText (MsgNew, Lines, ReplyID);
MsgNew^.WriteMsg;
MsgNew^.CloseMsgBase;
If MsgBase^.GetSeeAlso = 0 Then Begin
MsgBase^.MsgStartUp;
MsgBase^.SetSeeAlso(MsgNew^.GetMsgNum);
MsgBase^.ReWriteHdr;
End;
If Email Then Begin
Session.SystemLog ('Sent Email to ' + MsgNew^.GetTo);
Inc (Session.User.ThisUser.Emails);
Inc (Session.HistoryEmails);
End Else Begin
Session.SystemLog ('Posted #' + strI2S(MsgNew^.GetMsgNum) + ': "' + Subj + '" to ' + strStripMCI(MBase.Name));
Inc (Session.User.ThisUser.Posts);
Inc (Session.HistoryPosts);
End;
Dispose (MsgNew, Done);
Session.io.OutFullLn (Session.GetPrompt(122));
End Else
Session.io.OutFullLn (Session.GetPrompt(109));
DirClean (Session.TempPath, '');
End;
Procedure TMsgBase.EditMessage;
Var
A : Integer;
Lines : Integer;
Temp1 : String;
DestAddr : RecEchoMailAddr;
Procedure ReadText;
Begin
MsgBase^.MsgTxtStartUp;
Lines := 0;
While Not MsgBase^.EOM and (Lines < mysMaxMsgLines) Do Begin
Inc (Lines);
MsgText[Lines] := MsgBase^.GetString(79);
End;
If Lines < mysMaxMsgLines Then Begin
Inc (Lines);
MsgText[Lines] := '';
End;
End;
Begin
ReadText;
Repeat
Session.io.PromptInfo[1] := MsgBase^.GetTo;
Session.io.PromptInfo[2] := MsgBase^.GetSubj;
If MBase.NetType = 3 Then Begin
MsgBase^.GetDest(DestAddr);
Session.io.PromptInfo[1] := Session.io.PromptInfo[1] + ' (' + strAddr2Str(DestAddr) + ')';
End;
Session.io.OutFull (Session.GetPrompt(296));
Case Session.io.OneKey('ABQ!', True) of
'A' : Begin
Session.io.OutFull (Session.GetPrompt(297));
If MBase.NetType = 3 Then Begin
Temp1 := Session.io.GetInput(30, 30, 11, MsgBase^.GetTo);
Session.io.OutFull (Session.GetPrompt(298));
If strStr2Addr(Session.io.GetInput(20, 20, 12, strAddr2Str(DestAddr)), DestAddr) Then Begin
MsgBase^.SetTo(Temp1);
MsgBase^.SetDest(DestAddr)
End;
End Else
If MBase.Flags And MBPrivate <> 0 Then Begin
Temp1 := Session.io.GetInput (30, 30, 11, MsgBase^.GetTo);
If Session.User.SearchUser(Temp1, MBase.Flags and MBRealNames <> 0) Then
MsgBase^.SetTo(Temp1);
End Else
MsgBase^.SetTo(Session.io.GetInput(30, 30, 11, MsgBase^.GetTo));
End;
'B' : Begin
Session.io.OutFull (Session.GetPrompt(299));
MsgBase^.SetSubj(Session.io.GetInput(50, 50, 11, MsgBase^.GetSubj));
End;
'!' : Begin
Temp1 := MsgBase^.GetSubj;
If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, Temp1) Then
MsgBase^.SetSubj(Temp1)
Else
ReadText;
End;
'Q' : Begin
If Session.io.GetYN(Session.GetPrompt(300), True) Then Begin
MsgBase^.EditMsgInit;
For A := 1 to Lines Do
MsgBase^.DoStringLn(MsgText[A]);
MsgBase^.EditMsgSave;
End;
Break;
End;
End;
Until False;
End;
Procedure TMsgBase.MessageUpload (Var CurLine: SmallInt);
Var
FN : String[100];
TF : Text;
T1 : String[30];
T2 : String[60];
OK : Boolean;
Begin
OK := False;
T1 := Session.io.PromptInfo[1];
T2 := Session.io.PromptInfo[2];
Session.io.OutFull (Session.GetPrompt(352));
If Session.LocalMode Then Begin
FN := Session.io.GetInput(70, 70, 11, '');
If FN = '' Then Exit;
OK := FileExist(FN);
End Else Begin
FN := Session.TempPath + Session.io.GetInput(70, 70, 11, '');
If Session.FileBase.SelectProtocol(True, False) = 'Q' Then Exit;
Session.FileBase.ExecuteProtocol(1, FN);
OK := Session.FileBase.dszSearch(JustFile(FN));
End;
If OK Then Begin
Assign (TF, FN);
Reset (TF);
While Not Eof(TF) and (CurLine < mysMaxMsgLines) Do Begin
ReadLn (TF, MsgText[CurLine]);
Inc (CurLine);
End;
Close (TF);
End;
If Not Session.LocalMode Then FileErase(FN);
DirClean (Session.TempPath, 'msgtmp');
Session.io.PromptInfo[1] := T1;
Session.io.PromptInfo[2] := T2;
End;
Function TMsgBase.ReadMessages (Mode : Char; SearchStr : String) : Boolean;
Var
ReadRes : Boolean;
ScanMode : Byte;
ValidKeys : String;
HelpFile : String[8];
LastRead : LongInt;
ListMode : Byte;
ReplyID : String[31];
TempStr : String;
Procedure Set_Message_Security;
Begin
If Mode = 'E' Then Begin
ValidKeys := 'ADJLNPQRX?'#13;
HelpFile := 'emailhlp';
End Else
If Session.User.Access(MBase.SysopACS) or Session.User.IsThisUser(MsgBase^.GetFrom) Then Begin
ValidKeys := 'ADEFGHIJLMNPQRTX[]?'#13;
HelpFile := 'readshlp';
End Else Begin
ValidKeys := 'AGHIJLNPQRTX[]?'#13;
HelpFile := 'readhlp';
End;
End;
Function MoveMessage (IsCopy: Boolean) : Boolean;
Var
Total : LongInt;
TempBase : RecMessageBase;
MsgNew : PMsgBaseABS;
Str : String;
Addr : RecEchoMailAddr;
Begin
Result := False;
Session.User.IgnoreGroup := True;
Repeat
Total := ListAreas(Config.MCompress);
If IsCopy Then
Session.io.OutFull (Session.GetPrompt(492))
Else
Session.io.OutFull (Session.GetPrompt(282));
Case Session.io.OneKeyRange('Q?', 1, Total) of
#00: If GetBaseCompressed(Session.io.RangeValue, TempBase) Then Begin
If Not Session.User.Access(TempBase.PostACS) Then Begin
Session.io.OutFullLn (Session.GetPrompt(105));
Break;
End;
Session.io.PromptInfo[1] := TempBase.Name;
Session.io.OutFullLn (Session.GetPrompt(318));
If Not OpenCreateBase(MsgNew, TempBase) Then Break;
MsgNew^.StartNewMsg;
MsgNew^.SetFrom (MsgBase^.GetFrom);
MsgNew^.SetLocal (True);
Case TempBase.NetType of
0 : MsgNew^.SetMailType(mmtNormal);
3 : MsgNew^.SetMailType(mmtNetMail);
Else
MsgNew^.SetMailType(mmtEchoMail);
End;
MsgBase^.GetOrig (Addr);
MsgNew^.SetOrig (Addr);
MsgNew^.SetPriv (MsgBase^.IsPriv);
MsgNew^.SetDate (MsgBase^.GetDate);
MsgNew^.SetTime (MsgBase^.GetTime);
MsgNew^.SetTo (MsgBase^.GetTo);
MsgNew^.SetSubj (MsgBase^.GetSubj);
MsgBase^.MsgTxtStartUp;
While Not MsgBase^.EOM Do Begin
Str := MsgBase^.GetString(79);
MsgNew^.DoStringLn(Str);
End;
MsgNew^.WriteMsg;
MsgNew^.CloseMsgBase;
Dispose (MsgNew, Done);
If IsCopy Then
Session.SystemLog('Forward msg to ' + strStripMCI(TempBase.Name))
Else Begin
Session.SystemLog('Moved msg to ' + strStripMCI(TempBase.Name));
MsgBase^.DeleteMsg;
End;
Result := True;
Break;
End;
#13,
'Q': Break;
End;
Until False;
Session.User.IgnoreGroup := False;
End;
Procedure Export_Message;
Var
FN : String;
Temp : String;
TF : Text;
Begin
If Session.LocalMode Then Begin
If ListMode = 0 Then
Session.io.OutFull (Session.GetPrompt(363))
Else
Session.io.OutFull (Session.GetPrompt(415));
FN := Session.io.GetInput(70, 70, 11, '');
End Else Begin
If ListMode = 0 Then
Session.io.OutFull (Session.GetPrompt(326))
Else
Session.io.OutFull (Session.GetPrompt(414));
FN := Session.TempPath + Session.io.GetInput(70, 70, 11, '');
End;
If FN = '' Then Exit;
Session.io.PromptInfo[1] := JustFile(FN);
Assign (TF, FN);
{$I-} ReWrite (TF); {$I+}
If IoResult = 0 Then Begin
WriteLn (TF, 'From: ' + MsgBase^.GetFrom);
WriteLn (TF, ' To: ' + MsgBase^.GetTo);
WriteLn (TF, 'Subj: ' + MsgBase^.GetSubj);
WriteLn (TF, 'Date: ' + MsgBase^.GetDate + ' ' + MsgBase^.GetTime);
WriteLn (TF, 'Base: ' + MBase.Name);
WriteLn (TF, '');
MsgBase^.MsgTxtStartUp;
While Not MsgBase^.EOM Do Begin
Temp := MsgBase^.GetString(79);
If Temp[1] <> #1 Then WriteLn (TF, Temp);
End;
Close (TF);
Session.io.OutFullLn (Session.GetPrompt(327));
If Not Session.LocalMode Then Begin
Session.FileBase.SendFile(FN);
FileErase(FN);
End;
End;
End;
Function SeekNextMsg (First, Back: Boolean): Boolean;
Var
Res : Boolean;
Str : String;
Begin
Res := False;
If (ScanMode = 3) and First Then Begin
If Mode = 'S' Then Session.io.OutRawLn('');
Session.io.OutFull (Session.GetPrompt(130));
Session.io.BufFlush;
End;
If Not First Then
If Back Then
MsgBase^.SeekPrior
Else
MsgBase^.SeekNext;
While Not Res And MsgBase^.SeekFound Do Begin
MsgBase^.MsgStartUp;
Case ScanMode of
0 : Res := True;
1 : Res := Session.User.IsThisUser(MsgBase^.GetTo);
2 : Res := Session.User.IsThisUser(MsgBase^.GetTo) or Session.User.IsThisUser(MsgBase^.GetFrom);
3 : Begin
Res := (Pos(SearchStr, strUpper(MsgBase^.GetTo)) > 0) or (Pos(SearchStr, strUpper(MsgBase^.GetFrom)) > 0) or
(Pos(SearchStr, strUpper(MsgBase^.GetSubj)) > 0);
If Not Res Then Begin
MsgBase^.MsgTxtStartUp;
While Not Res And Not MsgBase^.EOM Do Begin
Str := strUpper(MsgBase^.GetString(79));
Res := Pos(SearchStr, Str) > 0;
End;
End;
End;
4 : Res := Session.User.IsThisUser(MsgBase^.GetFrom);
End;
If Not Res Then
If Back Then
MsgBase^.SeekPrior
Else
MsgBase^.SeekNext;
End;
If (ScanMode = 3) And First Then
Session.io.OutBS (Screen.CursorX, True);
If Not WereMsgs Then WereMsgs := Res;
SeekNextMsg := Res;
End;
Procedure Assign_Header_Info;
Var
NetAddr : RecEchoMailAddr;
Begin
Session.io.PromptInfo[1] := MsgBase^.GetFrom;
If MBase.NetType = 3 Then Begin
MsgBase^.GetOrig(NetAddr);
Session.io.PromptInfo[1] := Session.io.PromptInfo[1] + ' (' + strAddr2Str(NetAddr) + ')';
End;
Session.io.PromptInfo[2] := MsgBase^.GetTo;
If MBase.NetType = 3 Then Begin
MsgBase^.GetDest(NetAddr);
Session.io.PromptInfo[2] := Session.io.PromptInfo[2] + ' (' + strAddr2Str(NetAddr) + ')';
End;
Session.io.PromptInfo[3] := MsgBase^.GetSubj;
Session.io.PromptInfo[4] := DateDos2Str(DateStr2Dos(MsgBase^.GetDate), Session.User.ThisUser.DateType);
Session.io.PromptInfo[10] := MsgBase^.GetTime;
Session.io.PromptInfo[5] := strI2S(MsgBase^.GetMsgNum);
Session.io.PromptInfo[6] := strI2S(MsgBase^.GetHighMsgNum);
Session.io.PromptInfo[7] := strI2S(MsgBase^.GetRefer);
Session.io.PromptInfo[8] := strI2S(MsgBase^.GetSeeAlso);
TempStr := Session.GetPrompt(490);
If MsgBase^.IsLocal Then Session.io.PromptInfo[9] := strWordGet(1, TempStr, ' ') Else Session.io.PromptInfo[9] := strWordGet(2, TempStr, ' ');
If MsgBase^.IsPriv Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' ' + strWordGet(3, TempStr, ' ');
If MsgBase^.IsSent Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' ' + strWordGet(4, TempStr, ' ');
If MsgBase^.IsDeleted Then Session.io.PromptInfo[9] := Session.io.PromptInfo[9] + ' ' + strWordGet(5, TempStr, ' ');
End;
Procedure Send_Msg_Text (Str : String);
Begin
If IsQuotedText(Str) Then Begin
Session.io.AnsiColor(MBase.ColQuote);
Session.io.OutPipe (Str);
Session.io.AnsiColor(MBase.ColText);
End Else
If Copy(Str, 1, 4) = '--- ' Then Begin
Session.io.AnsiColor(MBase.ColTear);
Session.io.OutPipe (Str);
Session.io.AnsiColor(MBase.ColText);
End Else
If Copy(Str, 1, 2) = ' *' Then Begin
Session.io.AnsiColor(MBase.ColOrigin);
Session.io.OutPipe (Str);
Session.io.AnsiColor(MBase.ColText);
End Else
Session.io.OutPipe (Str);
If ListMode = 1 Then
Session.io.AnsiClrEOL;
Session.io.OutRawLn('');
End;
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
Function Ansi_View_Message : Boolean;
Var
Lines : SmallInt;
PageSize : SmallInt;
PageStart : SmallInt;
PageEnd : SmallInt;
Procedure Draw_Msg_Text;
Var
A : SmallInt;
Temp : String;
Begin
PageEnd := PageStart;
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y);
Session.io.AnsiColor (MBase.ColText);
For A := 1 to PageSize Do
If PageEnd <= Lines Then Begin
Send_Msg_Text(MsgText[PageEnd]);
Inc (PageEnd);
End Else Begin
Session.io.AnsiClrEOL;
Session.io.OutRawLn ('');
End;
Temp := Session.io.DrawPercent(Session.Theme.MsgBar, PageEnd - 1, Lines, A);
If Session.io.ScreenInfo[4].Y <> 0 Then Begin
Session.io.AnsiGotoXY (Session.io.ScreenInfo[4].X, Session.io.ScreenInfo[4].Y);
Session.io.AnsiColor (Session.io.ScreenInfo[4].A);
Session.io.OutRaw (strPadL(strI2S(A), 3, ' '));
End;
If Session.io.ScreenInfo[5].Y <> 0 Then Begin
Session.io.AnsiGotoXY (Session.io.ScreenInfo[5].X, Session.io.ScreenInfo[5].Y);
Session.io.OutFull (Temp);
End;
End;
Var
Ch : Char;
A : LongInt;
CurMsg : LongInt;
Begin
Ansi_View_Message := False;
Repeat
Set_Node_Action (Session.GetPrompt(348));
Set_Message_Security;
If MsgBase^.GetMsgNum > LastRead Then LastRead := MsgBase^.GetMsgNum;
CurMsg := MsgBase^.GetMsgNum;
Lines := 0;
PageStart := 1;
Session.io.AllowArrow := True;
MsgBase^.MsgTxtStartUp;
While Not MsgBase^.EOM And (Lines < mysMaxMsgLines) Do Begin
Inc (Lines);
MsgText[Lines] := MsgBase^.GetString(79);
If MsgText[Lines][1] = #1 Then Begin
If Copy(MsgText[Lines], 1, 6) = #1 + 'MSGID' Then
ReplyID := Copy(MsgText[Lines], 9, Length(MsgText[Lines]));
Dec (Lines);
End;
End;
Assign_Header_Info;
Session.io.ScreenInfo[4].Y := 0;
Session.io.ScreenInfo[5].Y := 0;
Session.io.OutFile (MBase.RTemplate, True, 0);
PageSize := Session.io.ScreenInfo[2].Y - Session.io.ScreenInfo[1].Y + 1;
Draw_Msg_Text;
Repeat
Session.io.PurgeInputBuffer;
Repeat
Ch := UpCase(Session.io.GetKey);
Until (Pos(Ch, #27 + ValidKeys) > 0) or Session.io.IsArrow;
If Session.io.IsArrow Then Begin
Case Ch of
#71 : If PageStart > 1 Then Begin
PageStart := 1;
Draw_Msg_Text;
End;
#72 : If PageStart > 1 Then Begin
Dec (PageStart);
Draw_Msg_Text;
End;
#73 : If PageStart > 1 Then Begin
If PageStart - PageSize > 0 Then
Dec (PageStart, PageSize)
Else
PageStart := 1;
Draw_Msg_Text;
End;
#75 : If SeekNextMsg(False, True) Then
Break
Else Begin
MsgBase^.SeekFirst(CurMsg);
SeekNextMsg(True, False);
End;
#77 : If SeekNextMsg(False, False) Then
Break
Else Begin
MsgBase^.SeekFirst(CurMsg);
SeekNextMsg(True, False);
End;
#79 : Begin
PageStart := Lines - PageSize + 1;
If PageStart < 1 Then PageStart := 1;
Draw_Msg_Text;
End;
#80 : If PageEnd <= Lines Then Begin
Inc (PageStart);
Draw_Msg_Text;
End;
#81 : If (Lines > PageSize) and (PageEnd <= Lines) Then Begin
If PageStart + PageSize <= Lines - PageSize Then
Inc (PageStart, PageSize)
Else
PageStart := Lines - PageSize + 1;
Draw_Msg_Text;
End;
End;
End Else
Case Ch of
'A' : Break;
'D' : Begin
If Session.io.GetYN(Session.GetPrompt(402), True) Then Begin
MsgBase^.DeleteMsg;
If Not SeekNextMsg(False, False) Then Begin
Ansi_View_Message := True;
Exit;
End;
End Else
MsgBase^.SeekFirst(CurMsg);
Break;
End;
'E' : Begin
EditMessage;
Break;
End;
'F' : Begin
MoveMessage(True);
Break;
End;
'G' : Begin
Ansi_View_Message := True;
Exit;
End;
'H' : Begin
LastRead := CurMsg - 1;
End;
'I' : Begin
LastRead := MsgBase^.GetHighMsgNum;
Ansi_View_Message := True;
Exit;
End;
'J' : Begin
Session.io.PromptInfo[1] := strI2S(CurMsg);
Session.io.PromptInfo[2] := strI2S(MsgBase^.GetHighMsgNum);
Session.io.OutFull (Session.GetPrompt(403));
A := strS2I(Session.io.GetInput(9, 9, 12, ''));
If (A > 0) and (A <= MsgBase^.GetHighMsgNum) Then Begin
MsgBase^.SeekFirst(A);
If Not SeekNextMsg(True, False) Then Begin
MsgBase^.SeekFirst(CurMsg);
SeekNextMsg(True, False);
End;
End;
Break;
End;
'L' : Exit;
'M' : Begin
If MoveMessage(False) Then
If Not SeekNextMsg(False, False) Then Begin
Ansi_View_Message := True;
Exit;
End;
Break;
End;
#13 : If (Lines > PageSize) and (PageEnd <= Lines) Then Begin
If PageStart + PageSize <= Lines - PageSize Then
Inc (PageStart, PageSize)
Else
PageStart := Lines - PageSize + 1;
Draw_Msg_Text;
End Else Begin
If SeekNextMsg(False, False) Then
Break
Else Begin
Ansi_View_Message := True;
Exit;
End;
End;
'N' : If SeekNextMsg(False, False) Then
Break
Else Begin
Ansi_View_Message := True;
Exit;
End;
'P' : If SeekNextMsg(False, True) Then
Break
Else Begin
MsgBase^.SeekFirst(CurMsg);
SeekNextMsg(True, False);
End;
#27,
'Q' : Begin
GetMessageScan;
If MScan.NewScan = 2 Then
Session.io.OutFullLn(Session.GetPrompt(406))
Else Begin
ReadRes := False;
Ansi_View_Message := True;
Exit;
End;
End;
'R' : Begin
ReplyMessage (Mode = 'E', ListMode, ReplyID);
Break;
End;
'T' : Begin
Session.io.PromptInfo[1] := MBase.Name;
GetMessageScan;
Case MScan.NewScan of
0 : Begin
MScan.NewScan := 1;
Session.io.OutFull (Session.GetPrompt(405));
End;
1 : Begin
MScan.NewScan := 0;
Session.io.OutFull (Session.GetPrompt(404));
End;
2 : Session.io.OutFull (Session.GetPrompt(406));
End;
SetMessageScan;
Break;
End;
'X' : Begin
Export_Message;
Break;
End;
'[' : If MsgBase^.GetRefer > 0 Then Begin
MsgBase^.SeekFirst(MsgBase^.GetRefer);
MsgBase^.MsgStartUp;
Break;
End;
']' : If MsgBase^.GetSeeAlso > 0 Then Begin
MsgBase^.SeekFirst(MsgBase^.GetSeeAlso);
MsgBase^.MsgStartUp;
Break;
End;
'?' : Begin
Session.io.OutFile ('amsghlp2', True, 0);
Break;
End;
End;
Until False;
Until False;
End;
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
Procedure Ansi_Read_Messages;
Type
MsgInfoRec = Record
Num : LongInt;
MsgFrom : String[30];
MsgTo : String[30];
Subj : String[60];
NewMsgs : Boolean;
End;
Var
PageSize : SmallInt;
PagePos : SmallInt;
PageTotal : SmallInt;
CurPage : Word;
MsgInfo : Array[1..24] of MsgInfoRec;
FirstPage : Boolean;
Procedure DrawPage;
Var
A : SmallInt;
Begin
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y);
For A := 1 to PageSize Do
If A <= PageTotal Then Begin
With MsgInfo[A] Do Begin
Session.io.PromptInfo[1] := strI2S(Num);
Session.io.PromptInfo[2] := Subj;
Session.io.PromptInfo[3] := MsgFrom;
Session.io.PromptInfo[4] := MsgTo;
If NewMsgs Then
Session.io.PromptInfo[5] := Session.Theme.NewMsgChar
Else
Session.io.PromptInfo[5] := ' ';
End;
Session.io.OutFull (Session.GetPrompt(399));
Session.io.AnsiClrEOL;
Session.io.OutRawLn('');
End Else Begin
Session.io.AnsiClrEOL;
Session.io.OutRawLn('');
End;
End;
Procedure FullReDraw;
Begin
Session.io.OutFile (MBase.ITemplate, True, 0);
PageSize := Session.io.ScreenInfo[2].Y - Session.io.ScreenInfo[1].Y + 1;
End;
Function Read_Page (First, Back, NoDraw : Boolean) : Boolean;
Var
A : SmallInt;
B : SmallInt;
Temp : MsgInfoRec;
Begin
Read_Page := False;
FirstPage := False;
If SeekNextMsg(First, Back) Then Begin
If First Then Begin
FullReDraw;
CurPage := 0;
End;
// add scanning prompt here
//if (scanmode=3) then begin
// Session.io.AnsiGotoXY(32, 11);
// Session.io.OutFull ('|08.---------------.');
// Session.io.AnsiGotoXY(32, 12);
// Session.io.OutFull ('| |07searching ... |08|');
// Session.io.AnsiGotoXY(32, 13);
// Session.io.OutFull ('`---------------''');
//end;
PageTotal := 0;
Read_Page := True;
Repeat
Inc (PageTotal);
MsgInfo[PageTotal].Num := MsgBase^.GetMsgNum;
MsgInfo[PageTotal].MsgFrom := MsgBase^.GetFrom;
MsgInfo[PageTotal].MsgTo := MsgBase^.GetTo;
MsgInfo[PageTotal].Subj := MsgBase^.GetSubj;
MsgInfo[PageTotal].NewMsgs := MsgBase^.GetMsgNum > LastRead;
Until (PageTotal = PageSize) or (Not SeekNextMsg(False, Back));
If Back Then Begin { reverse message order }
Dec (CurPage);
B := PageTotal;
For A := 1 to PageTotal DIV 2 Do Begin
Temp := MsgInfo[A];
MsgInfo[A] := MsgInfo[B];
MsgInfo[B] := Temp;
Dec (B);
End;
// if backwards and page is not filled, fill it going foward.
If PageTotal < PageSize Then Begin
FirstPage := True;
MsgBase.SeekFirst(MsgInfo[PageTotal].Num);
While SeekNextMsg(False, False) and (PageTotal < PageSize) Do Begin
Inc (PageTotal);
MsgInfo[PageTotal].Num := MsgBase^.GetMsgNum;
MsgInfo[PageTotal].MsgFrom := MsgBase^.GetFrom;
MsgInfo[PageTotal].MsgTo := MsgBase^.GetTo;
MsgInfo[PageTotal].Subj := MsgBase^.GetSubj;
MsgInfo[PageTotal].NewMsgs := MsgBase^.GetMsgNum > LastRead;
End;
Read_Page := False;
End;
End Else Begin
Inc (CurPage);
Read_Page := True;
End;
If Not NoDraw Then DrawPage;
End;
End;
Procedure UpdateBar (On : Boolean);
Begin
If PageTotal = 0 Then Exit;
Session.io.PromptInfo[1] := strI2S(MsgInfo[PagePos].Num);
Session.io.PromptInfo[2] := MsgInfo[PagePos].Subj;
Session.io.PromptInfo[3] := MsgInfo[PagePos].MsgFrom;
Session.io.PromptInfo[4] := MsgInfo[PagePos].MsgTo;
If MsgInfo[PagePos].NewMsgs Then
Session.io.PromptInfo[5] := Session.Theme.NewMsgChar
Else
Session.io.PromptInfo[5] := ' ';
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[1].Y + PagePos - 1);
If On Then
Session.io.OutFull (Session.GetPrompt(400))
Else
Session.io.OutFull (Session.GetPrompt(401));
End;
Procedure Ansi_Message_Index;
Var
Ch : Char;
SN : LongInt;
A : Byte;
Begin
If Read_Page (True, False, False) Then Begin
WereMsgs := True;
PagePos := 1;
Repeat
Session.io.AllowArrow := True;
UpdateBar(True);
Session.io.PurgeInputBuffer;
Ch := UpCase(Session.io.GetKey);
If Session.io.IsArrow Then Begin
Case Ch of
#71 : Begin
UpdateBar(False);
While Read_Page(False, True, True) Do;
PagePos := 1;
DrawPage;
End;
#72 : Begin
UpdateBar(False);
If PagePos > 1 Then
Dec (PagePos)
Else Begin
SN := MsgInfo[PagePos].Num;
MsgBase^.SeekFirst(MsgInfo[1].Num);
If Not Read_Page(False, True, False) Then
PagePos := 1
Else
If Not FirstPage Then
PagePos := PageTotal
Else Begin
For A := 1 to PageTotal Do
If MsgInfo[A].Num = SN Then Begin
PagePos := A - 1;
Break;
End;
If PagePos < 1 Then PagePos := 1;
End;
End;
End;
#73,
#75 : Begin
UpdateBar(False);
MsgBase^.SeekFirst(MsgInfo[1].Num);
If Not Read_Page(False, True, False) Then
PagePos := 1
Else
If PagePos > PageTotal Then PagePos := PageTotal;
End;
#80 : Begin
UpdateBar(False);
If PagePos < PageTotal Then
Inc (PagePos)
Else Begin
MsgBase^.SeekFirst(MsgInfo[PageTotal].Num);
If Read_Page(False, False, False) Then PagePos := 1;
End;
End;
#77,
#81 : Begin
MsgBase^.SeekFirst(MsgInfo[PageTotal].Num);
If Read_Page(False, False, False) Then Begin
If PagePos > PageTotal Then PagePos := PageTotal;
End Else Begin
UpdateBar(False);
PagePos := PageTotal;
End;
End;
#79 : Begin
UpdateBar(False);
While Read_Page(False, False, True) Do;
PagePos := PageTotal;
DrawPage;
End;
End;
End Else
Case Ch of
#13 : Begin
MsgBase^.SeekFirst(MsgInfo[PagePos].Num);
SeekNextMsg (True, False);
If Ansi_View_Message Then Break;
MsgBase^.SeekFirst(MsgInfo[1].Num);
If Not Read_Page(True, False, False) Then Begin
PageTotal := 0;
FullReDraw;
DrawPage;
End;
End;
'Q',
#27 : Begin
GetMessageScan;
If MScan.NewScan = 2 Then
Session.io.OutFullLn(Session.GetPrompt(406))
Else Begin
ReadRes := False;
Break;
End;
End;
'G' : Break;
'I' : Begin
LastRead := MsgBase^.GetHighMsgNum;
Break;
End;
'?' : Begin
Session.io.OutFile('amsghlp1', True, 0);
FullReDraw;
DrawPage;
End;
End;
Until False;
End;
Session.io.AllowArrow := False;
If WereMsgs Then Begin
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[3].Y);
Session.io.OutRawLn('');
End;
End;
Begin
If ((Mode = 'E') and Session.User.ThisUser.UseLBMIdx) or ((Mode <> 'E') and Session.User.ThisUser.UseLBIndex) Then
Ansi_Message_Index
Else Begin
If SeekNextMsg(True, False) Then
If Not Ansi_View_Message Then
Ansi_Message_Index;
End;
End;
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
Procedure Ascii_Read_Messages;
Procedure Display_Header;
Begin
Session.io.PausePtr := 1;
Session.io.OutFile (MBase.Header, True, 0);
If Session.io.NoFile Then Begin
Session.io.OutFullLn ('|CL|03From : |14|$R40|&1 |03Msg # : |14|&5 |03of |14|&6');
Session.io.OutFullLn ('|03To : |10|$R40|&2 |03Refer to : |10|&7');
Session.io.OutFullLn ('|03Subj : |12|$R40|&3 |03See Also : |12|&8');
Session.io.OutFullLn ('|03Date : |11|&4 |$R31|&0 |03Status : |13|&9');
Session.io.OutFullLn ('|03Base : |14|MB|CR');
End;
Session.io.AnsiColor (MBase.ColText);
End;
Var
Str : String;
A : LongInt;
B : LongInt;
Begin
If SeekNextMsg(True, False) Then
Repeat
// Set_Node_Action (Session.GetPrompt(348));
If MsgBase^.GetMsgNum > LastRead Then LastRead := MsgBase^.GetMsgNum;
Set_Message_Security;
Assign_Header_Info;
Display_Header;
MsgBase^.MsgTxtStartUp;
WereMsgs := True;
Session.io.AllowPause := True;
While Not MsgBase^.EOM Do Begin
Str := MsgBase^.GetString(79);
If Str[1] = #1 Then Begin
If Copy(Str, 1, 6) = #1 + 'MSGID' Then
ReplyID := Copy(Str, 9, Length(Str));
End Else
Send_Msg_Text (Str);
If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then Begin
Case Session.io.MorePrompt of
'N' : Break;
'C' : Session.io.AllowPause := False;
End;
If Config.MShowHeader Then Display_Header;
End;
End;
Session.io.AllowPause := False;
Repeat
Session.io.PromptInfo[1] := strI2S(MsgBase^.GetMsgNum);
Session.io.PromptInfo[2] := strI2S(MsgBase^.GetHighMsgNum);
If Mode = 'E' Then
Session.io.OutFull (Session.GetPrompt(115))
Else
If Session.User.Access(MBase.SysopACS) or Session.User.IsThisUser(MsgBase^.GetFrom) Then
Session.io.OutFull (Session.GetPrompt(213))
Else
Session.io.OutFull (Session.GetPrompt(116));
Str := Session.io.OneKeyRange(ValidKeys, 1, MsgBase^.GetHighMsgNum);
Case Str[1] of
#00 : Begin
B := MsgBase^.GetMsgNum;
MsgBase^.SeekFirst(Session.io.RangeValue);
If Not SeekNextMsg(True, False) Then Begin
MsgBase^.SeekFirst(B);
SeekNextMsg(True, False);
End;
Break;
End;
'A' : Break;
'D' : If Session.io.GetYN (Session.GetPrompt(117), True) Then Begin {Delete E-mail}
MsgBase^.DeleteMsg;
If Not SeekNextMsg(False, False) Then Exit;
Break;
End;
'E' : Begin
EditMessage;
Break;
End;
'F' : Begin
MoveMessage(True);
Break;
End;
'G' : Exit;
'H' : LastRead := MsgBase^.GetMsgNum - 1;
'I' : Begin
LastRead := MsgBase^.GetHighMsgNum;
Exit;
End;
'J' : Begin
B := MsgBase^.GetMsgNum;
Session.io.OutFull (Session.GetPrompt(334));
A := strS2I(Session.io.GetInput(9, 9, 12, ''));
If (A > 0) and (A <= MsgBase^.GetHighMsgNum) Then Begin
MsgBase^.SeekFirst(A);
If Not SeekNextMsg(True, False) Then Begin
MsgBase^.SeekFirst(B);
SeekNextMsg(True, False);
End;
End;
Break;
End;
'L' : Begin
Session.io.PausePtr := 1;
Session.io.AllowPause := True;
A := MsgBase^.GetMsgNum;
Session.io.OutFullLn(Session.GetPrompt(411));
While SeekNextMsg(False, False) Do Begin
Assign_Header_Info;
Session.io.OutFullLn (Session.GetPrompt(412));
If (Session.io.PausePtr = Session.User.ThisUser.ScreenSize) and (Session.io.AllowPause) Then
Case Session.io.MorePrompt of
'N' : Break;
'C' : Session.io.AllowPause := False;
End;
End;
Session.io.OutFull (Session.GetPrompt(413));
MsgBase^.SeekFirst(A);
MsgBase^.MsgStartup;
Session.io.PromptInfo[1] := strI2S(MsgBase^.GetMsgNum);
Session.io.PromptInfo[2] := strI2S(MsgBase^.GetHighMsgNum);
End;
'M' : Begin
If MoveMessage(False) Then
If Not SeekNextMsg(False, False) Then Exit;
Break;
End;
#13,
'N' : If SeekNextMsg(False, False) Then Break Else Exit;
'P' : Begin
If Not SeekNextMsg(False, True) Then Begin
MsgBase^.SeekFirst(MsgBase^.GetMsgNum);
SeekNextMsg(True, False);
End;
Break;
End;
'Q' : Begin
GetMessageScan;
If MScan.NewScan = 2 Then
Session.io.OutFullLn(Session.GetPrompt(302))
Else Begin
ReadRes := False;
Exit;
End;
End;
'R' : Begin
ReplyMessage (Mode = 'E', ListMode, ReplyID);
Break;
End;
'T' : Begin
Session.io.PromptInfo[1] := MBase.Name;
GetMessageScan;
Case MScan.NewScan of
0 : Begin
MScan.NewScan := 1;
Session.io.OutFull (Session.GetPrompt(99));
End;
1 : Begin
MScan.NewScan := 0;
Session.io.OutFull (Session.GetPrompt(98));
End;
2 : Session.io.OutFull (Session.GetPrompt(302));
End;
SetMessageScan;
End;
'X' : Export_Message;
'?' : Session.io.OutFile(HelpFile, True, 0);
'[' : If MsgBase^.GetRefer > 0 Then Begin
MsgBase^.SeekFirst(MsgBase^.GetRefer);
MsgBase^.MsgStartUp;
Break;
End Else
Session.io.OutFullLn (Session.GetPrompt(128));
']' : If MsgBase^.GetSeeAlso > 0 Then Begin
MsgBase^.SeekFirst(MsgBase^.GetSeeAlso);
MsgBase^.MsgStartUp;
Break;
End Else
Session.io.OutFullLn (Session.GetPrompt(199));
End;
Until False;
Until False;
End;
(**************************************************************************)
(**************************************************************************)
(**************************************************************************)
{ F = Forward S = Search E = Electronic Mail
N = New messages Y = Your messages G = Global scan
P = Global personal scan B = By You T = Global text search }
Var
MsgNum : LongInt;
Begin
ReadMessages := True;
ReadRes := True;
WereMsgs := False;
ReplyID := '';
If MBase.FileName = '' Then Begin
Session.io.OutFullLn (Session.GetPrompt(110));
Exit;
End;
If Not Session.User.Access(MBase.ReadACS) Then Begin
If Not (Mode in ['G', 'P', 'T']) Then Session.io.OutFullLn (Session.GetPrompt(111));
Exit;
End;
If Not (Mode in ['B', 'T', 'S', 'E', 'F', 'G', 'N', 'P', 'Y']) Then Begin
Session.io.OutFull (Session.GetPrompt(112));
Mode := Session.io.OneKey('BFNSYQ', True);
End;
Case Mode of
'Q' : Exit;
'S' : If SearchStr = '' Then Begin
Session.io.OutFull (Session.GetPrompt(396));
SearchStr := Session.io.GetInput(50, 50, 12, '');
If SearchStr = '' Then Exit;
End;
End;
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgbaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
MsgBase^.SetTempFile (Session.TempPath + 'msgbuf.');
If Not MsgBase^.OpenMsgBase Then Begin
If Mode = 'E' Then
Session.io.OutFullLn (Session.GetPrompt(124))
Else
If Not (Mode in ['G', 'P', 'T']) Then Session.io.OutFullLn (Session.GetPrompt(114));
Dispose (MsgBase, Done);
Exit;
End;
If Mode = 'E' Then
ScanMode := 1
Else
If (MBase.Flags and MBPrivate <> 0) or (Mode = 'Y') or (Mode = 'P') Then
ScanMode := 2
Else
If (Mode = 'S') or (Mode = 'T') Then
ScanMode := 3
Else
If Mode = 'B' Then
ScanMode := 4
Else
ScanMode := 0;
LastRead := MsgBase^.GetLastRead(Session.User.UserNum);
MsgNum := 1;
If Mode = 'F' Then Begin
Session.io.PromptInfo[1] := strI2S(MsgBase^.GetHighMsgNum);
If Session.io.PromptInfo[1] = '0' Then Begin
Session.io.OutFullLn(Session.GetPrompt(114));
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
Exit;
End;
Session.io.OutFull (Session.GetPrompt(338));
Session.io.OneKeyRange(#13, 1, MsgBase^.GetHighMsgNum);
MsgNum := Session.io.RangeValue;
End;
Set_Node_Action (Session.GetPrompt(348));
If Mode in ['B', 'S', 'T', 'Y', 'E', 'F'] Then
MsgBase^.SeekFirst(MsgNum)
Else
MsgBase^.SeekFirst(LastRead + 1);
Set_Message_Security;
Reading := True;
If (Session.User.ThisUser.MReadType = 1) and (Session.io.Graphics > 0) Then Begin
ListMode := 1;
Ansi_Read_Messages;
End Else Begin
ListMode := 0;
Ascii_Read_Messages;
End;
If Not (Mode in ['E', 'S', 'T']) Then MsgBase^.SetLastRead (Session.User.UserNum, LastRead);
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
Reading := False;
If WereMsgs Then Begin
If Not (Mode in ['B', 'E', 'P']) And ReadRes Then
If ListMode = 0 Then Begin
Session.io.OutFull('|CR');
If Session.io.GetYN(Session.GetPrompt(383), False) Then
PostMessage (False, '');
End Else
If Session.io.GetYN(Session.GetPrompt(438), False) Then
PostMessage (False, '');
End Else
Case Mode of
'S' : Session.io.OutFullLn (Session.GetPrompt(113));
'B',
'Y',
'N' : Session.io.OutFullLn ('|CR' + Session.GetPrompt(113));
End;
Result := ReadRes;
End;
Procedure TMsgBase.PostMessage (Email: Boolean; Data: String);
Var
MsgTo : String[30];
MsgSubj : String[60];
MsgAddr : String[20];
TempStr : String;
DestAddr : RecEchoMailAddr;
A : Integer;
Lines : Integer;
Forced : Boolean;
Old : RecMessageBase;
Begin
Old := MBase;
If Email Then Begin
Reset (MBaseFile);
Read (MBaseFile, MBase);
Close (MBaseFile);
End;
If MBase.FileName = '' Then Begin
Session.io.OutFullLn (Session.GetPrompt(110));
MBase := Old;
Exit;
End;
If Not Session.User.Access(MBase.PostACS) Then Begin
Session.io.OutFullLn (Session.GetPrompt(105));
MBase := Old;
Exit;
End;
Set_Node_Action (Session.GetPrompt(349));
MsgTo := '';
MsgSubj := '';
MsgAddr := '';
Forced := False;
For A := 1 to strWordCount(Data, ' ') Do Begin
TempStr := strWordGet(A, Data, ' ');
If Pos ('/F', strUpper(TempStr)) > 0 Then
Forced := True
Else
If Pos ('/TO:', strUpper(TempStr)) > 0 Then
MsgTo := strReplace(Copy(TempStr, Pos('/TO:', strUpper(TempStr)) + 4, Length(TempStr)), '_', ' ')
Else
If Pos ('/SUBJ:', strUpper(TempStr)) > 0 Then
MsgSubj := strReplace(Copy(TempStr, Pos('/SUBJ:', strUpper(TempStr)) + 6, Length(TempStr)), '_', ' ')
Else
If Pos('/ADDR:', strUpper(TempStr)) > 0 Then Begin
MsgAddr := strReplace(Copy(TempStr, Pos('/ADDR:', strUpper(TempStr)) + 6, Length(TempStr)), '_', ' ');
If Not strStr2Addr(MsgAddr, DestAddr) Then MsgAddr := '';
End;
End;
If MBase.NetType = 2 Then { UseNet Base: To = "All" }
MsgTo := 'All'
Else
If MBase.NetType = 3 Then Begin { NetMail Base: Get To *and* Address }
If MsgTo = '' Then Begin
Session.io.OutFull (Session.GetPrompt(119));
MsgTo := Session.io.GetInput (30, 30, 18, '');
End;
If MsgAddr = '' Then Begin
Session.io.OutFull (Session.GetPrompt(342));
MsgAddr := Session.io.GetInput (20, 20, 12, '');
If Not strStr2Addr(MsgAddr, DestAddr) Then MsgTo := '';
End;
End Else
If MBase.Flags and MBPrivate <> 0 Then Begin
If MsgTo = '' Then Begin
Session.io.OutFull (Session.GetPrompt(450));
MsgTo := Session.io.GetInput (30, 30, 18, '');
If Not Session.User.SearchUser(MsgTo, MBase.Flags and MBRealNames <> 0) Then MsgTo := '';
End Else
If strUpper(MsgTo) = 'SYSOP' Then MsgTo := Config.SysopName;
If Session.User.FindUser(MsgTo, False) Then Begin
Session.io.PromptInfo[1] := MsgTo;
Session.io.OutFullLn (Session.GetPrompt(108));
End Else
MsgTo := '';
End Else Begin
Session.io.OutFull (Session.GetPrompt(119));
MsgTo := Session.io.GetInput (30, 30, 18, 'All');
End;
If MsgTo = '' Then Begin
MBase := Old;
Exit;
End;
If MsgSubj = '' Then
Repeat
Session.io.OutFull (Session.GetPrompt(120));
MsgSubj := Session.io.GetInput (60, 60, 11, '');
If MsgSubj = '' Then
If Forced Then
Session.io.OutFull (Session.GetPrompt(307))
Else Begin
MBase := Old;
Exit;
End;
Until MsgSubj <> '';
Lines := 0;
Session.io.PromptInfo[1] := MsgTo;
// Session.io.PromptInfo[2] := MsgSubj;
If Editor(Lines, 78, mysMaxMsgLines, Forced, fn_tplMsgEdit, MsgSubj) Then Begin
Session.io.OutFull (Session.GetPrompt(107));
{ all of this below should be replaced with a SaveMessage function }
{ the same should be used for Replying and also for TextFile post }
{ and then the automated e-mails can be added where mystic will send }
{ notifications out to the sysop for various things (configurable) }
{ also could be used in mass email rewrite and qwk .REP rewrite }
If Not OpenCreateBase(MsgBase, MBase) Then Begin
MBase := Old;
Exit;
End;
AssignMessageData(MsgBase);
MsgBase^.SetTo (MsgTo);
MsgBase^.SetSubj (MsgSubj);
If MBase.NetType = 3 Then Begin
MsgBase^.SetDest (DestAddr);
MsgBase^.SetCrash (Config.netCrash);
MsgBase^.SetHold (Config.netHold);
MsgBase^.SetKillSent (Config.netKillSent);
DestAddr := Config.NetAddress[MBase.NetAddr];
MsgBase^.SetOrig (DestAddr);
End;
AppendMessageText (MsgBase, Lines, '');
MsgBase^.WriteMsg;
MsgBase^.CloseMsgBase;
If Email Then Begin
Session.SystemLog ('Sent Email to ' + MsgTo);
Inc (Session.User.ThisUser.Emails);
Inc (Session.HistoryEmails);
A := IsUserOnline(MsgTo);
If A <> 0 Then Begin
TempStr := Session.GetPrompt(465);
TempStr := strReplace(TempStr, '|&1', Session.User.ThisUser.Handle);
TempStr := strReplace(TempStr, '|&2', MsgSubj);
Send_Node_Message(2, strI2S(A) + ';' + TempStr, 0);
End;
End Else Begin
Session.SystemLog ('Posted #' + strI2S(MsgBase^.GetMsgNum) + ': "' + MsgSubj + '" to ' + strStripMCI(MBase.Name));
Inc (Session.User.ThisUser.Posts);
Inc (Session.HistoryPosts);
End;
Dispose (MsgBase, Done);
Session.io.OutFullLn (Session.GetPrompt(122));
End Else
Session.io.OutFullLn (Session.GetPrompt(109));
MBase := Old;
End;
Procedure TMsgBase.CheckEMail;
Var
Old : RecMessageBase;
Total : Integer;
Begin
Session.io.OutFull (Session.GetPrompt(123));
Session.io.BufFlush;
Old := MBase;
Reset (MBaseFile);
Read (MBaseFile, MBase);
Close (MBaseFile);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If Not MsgBase^.OpenMsgBase Then Begin
Session.io.OutFullLn (Session.GetPrompt(124));
Dispose (MsgBase, Done);
MBase := Old;
Exit;
End;
Total := 0;
MsgBase^.YoursFirst(Session.User.ThisUser.RealName, Session.User.ThisUser.Handle);
If MsgBase^.YoursFound Then Begin
Session.io.OutFullLn (Session.GetPrompt(125));
Total := 0;
While MsgBase^.YoursFound Do Begin
MsgBase^.MsgStartUp;
Inc (Total);
Session.io.PromptInfo[1] := strI2S(Total);
Session.io.PromptInfo[2] := MsgBase^.GetFrom;
Session.io.PromptInfo[3] := MsgBase^.GetSubj;
Session.io.PromptInfo[4] := MsgBase^.GetDate;
Session.io.OutFullLn (Session.GetPrompt(126));
MsgBase^.YoursNext;
End;
If Session.io.GetYN (Session.GetPrompt(127), True) Then Begin
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
ReadMessages('E', '');
Session.io.OutFullLn (Session.GetPrompt(118));
MBase := Old;
Exit;
End;
End Else
Session.io.OutFullLn (Session.GetPrompt(124));
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
MBase := Old;
End;
Procedure TMsgBase.SetMessagePointers;
Var
NewDate : LongInt;
Procedure UpdateBase;
Var
Found : Boolean;
Begin
Found := False;
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If MsgBase^.OpenMsgBase Then Begin
MsgBase^.SeekFirst(1);
While MsgBase^.SeekFound Do Begin
MsgBase^.MsgStartUp;
If DateStr2Dos(MsgBase^.GetDate) >= NewDate Then Begin
MsgBase^.SetLastRead(Session.User.UserNum, MsgBase^.GetMsgNum - 1);
Found := True;
Break;
End;
MsgBase^.SeekNext;
End;
If Not Found Then
MsgBase^.SetLastRead(Session.User.UserNum, MsgBase^.GetHighMsgNum);
End;
Dispose (MsgBase, Done);
End;
Var
Global : Boolean;
InDate : String[8];
Begin
Session.io.OutFull (Session.GetPrompt(458));
InDate := Session.io.GetInput(8, 8, 15, '');
If Not DateValid(InDate) Then Exit;
NewDate := DateStr2Dos(InDate);
Global := Session.io.GetYN(Session.GetPrompt(459), False);
Session.io.OutFullLn (Session.GetPrompt(460));
If Global Then Begin
ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN);
ioRead (MBaseFile, MBase);
While Not Eof(MBaseFile) Do Begin
ioRead (MBaseFile, MBase);
UpdateBase;
End;
End Else
UpdateBase;
End;
Procedure TMsgBase.MessageNewScan (Data: String);
{ menu data commands: }
{ /P : scan for personal mail in all bases }
{ /M : scan only mandatory bases }
{ /G : scan all bases in all groups }
Var
Old : RecMessageBase;
Mode : Char;
Mand : Boolean;
Begin
Old := MBase;
Mand := False;
Reset (MBaseFile);
If Pos ('/P', Data) > 0 Then Begin
Mode := 'P';
Session.SystemLog ('Scan for personal messages');
End Else Begin
Mand := Pos('/M', Data) > 0;
Mode := 'G';
Read (MBaseFile, MBase);
Session.SystemLog ('Scan for new messages');
End;
Session.User.IgnoreGroup := Pos('/G', Data) > 0;
WereMsgs := False;
Session.io.OutRawLn ('');
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ReadACS) Then Begin
GetMessageScan;
If ((Mand) and (MBase.DefNScan = 2)) or ((Not Mand) and (MScan.NewScan > 0)) Then Begin
Session.io.OutBS (Screen.CursorX, True);
Session.io.OutFull (Session.GetPrompt(130));
Session.io.BufFlush;
If Not ReadMessages(Mode, '') Then Begin
Session.io.OutRawLn('');
Break;
End;
If WereMsgs Then Session.io.OutRawLn('');
End;
End;
End;
If Not WereMsgs Then Session.io.OutFullLn('|CR');
Session.io.OutFull (Session.GetPrompt(131));
Close (MBaseFile);
Session.User.IgnoreGroup := False;
MBase := OLD;
End;
Procedure TMsgBase.GlobalMessageSearch (Mode : Char);
{ C = current area }
{ G = all areas in group }
{ A = all areas in all groups }
Var
SearchStr : String;
Old : RecMessageBase;
Begin
If Not (Mode in ['A', 'C', 'G']) Then Mode := 'G';
Session.io.OutFull (Session.GetPrompt(310));
SearchStr := Session.io.GetInput(50, 50, 12, '');
If SearchStr = '' Then Exit;
OLD := MBase;
WereMsgs := False;
Session.User.IgnoreGroup := Mode = 'A';
If Mode = 'C' Then
ReadMessages('S', SearchStr)
Else Begin
Session.io.OutRawLn ('');
Reset (MBaseFile);
Read (MBaseFile, MBase); {skip email base}
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ReadACS) Then Begin
GetMessageScan;
If MScan.NewScan > 0 Then Begin
If Not ReadMessages('T', SearchStr) Then Begin
Session.io.OutRawLn('');
Break;
End;
If WereMsgs Then Session.io.OutRawLn('');
End;
End;
End;
Session.io.OutFull (Session.GetPrompt(311));
Close (MBaseFile);
End;
Session.User.IgnoreGroup := False;
MBase := OLD;
End;
Procedure TMsgBase.SendMassEmail;
Var
Mode : Char;
Names : Array[1..25] of String[35];
NamePos : SmallInt;
ACS : String[20];
Str : String[30];
A : SmallInt;
MsgFrom : String[30];
MsgTo : String[30];
MsgSubj : String[60];
Lines : Integer;
Old : RecMessageBase;
OldUser : RecUser;
Procedure Write_Mass_Msg;
Begin
Session.SystemLog ('Sending mass mail to ' + MsgTo);
AssignMessageData(MsgBase);
MsgBase^.SetFrom (MsgFrom);
MsgBase^.SetTo (MsgTo);
MsgBase^.SetSubj (MsgSubj);
AppendMessageText (MsgBase, Lines, '');
MsgBase^.WriteMsg;
End;
Begin
MsgFrom := Session.User.ThisUser.Handle;
Session.io.OutFull (Session.GetPrompt(387));
Mode := Session.io.OneKey('123Q', True);
Case Mode of
'1' : Begin
Session.io.OutFull (Session.GetPrompt(388));
ACS := Session.io.GetInput(20, 20, 11, '');
If ACS = '' Then Exit;
Session.io.OutFullLn (Session.GetPrompt(391));
OldUser := Session.User.ThisUser;
Reset (Session.User.UserFile);
While Not Eof(Session.User.UserFile) Do Begin
Read (Session.User.UserFile, Session.User.ThisUser);
If (Session.User.ThisUser.Flags AND UserDeleted = 0) and Session.User.Access(ACS) Then Begin
Session.io.PromptInfo[1] := Session.User.ThisUser.Handle;
Session.io.OutFullLn (Session.GetPrompt(392));
End;
End;
Close (Session.User.UserFile);
Session.User.ThisUser := OldUser;
If Not Session.io.GetYN(Session.GetPrompt(393), True) Then
Exit;
End;
'2' : Begin
NamePos := 0;
Session.io.OutFull (Session.GetPrompt(389));
While NamePos < 25 Do Begin
Session.io.PromptInfo[1] := strI2S(NamePos);
Session.io.OutFull (Session.GetPrompt(390));
Str := Session.io.GetInput (30, 30, 18, '');
If Str <> '' Then Begin
If Session.User.SearchUser(Str, MBase.Flags And MBRealNames <> 0) Then Begin
Inc (NamePos);
Names[NamePos] := Str;
End;
End Else
If NamePos = 0 Then
Exit
Else
Break;
End;
Session.io.OutFullLn (Session.GetPrompt(391));
For A := 1 to NamePos Do Begin
Session.io.PromptInfo[1] := Names[A];
Session.io.OutFullLn (Session.GetPrompt(392));
End;
If Not Session.io.GetYN(Session.GetPrompt(393), True) Then
Exit;
End;
'3' : Begin
Mode := '1';
ACS := '^';
End;
'Q' : Exit;
End;
Session.io.OutFull (Session.GetPrompt(416));
MsgSubj := Session.io.GetInput (60, 60, 11, '');
If MsgSubj = '' Then Exit;
Session.io.PromptInfo[1] := 'Mass Mail';
Session.io.PromptInfo[2] := MsgSubj;
Lines := 0;
If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, MsgSubj) Then Begin
Session.io.OutFullLn (Session.GetPrompt(394));
OLD := MBase;
Reset (MBaseFile);
Read (MBaseFile, MBase);
Close (MBaseFile);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If Not MsgBase^.OpenMsgBase Then
If Not MsgBase^.CreateMsgBase (MBase.MaxMsgs, MBase.MaxAge) Then Begin
Dispose (MsgBase, Done);
MBase := Old;
Exit;
End Else
If Not MsgBase^.OpenMsgBase Then Begin
Dispose (MsgBase, Done);
MBase := Old;
Exit;
End;
Case Mode of
'1' : Begin
OldUser := Session.User.ThisUser;
Reset (Session.User.UserFile);
While Not Eof(Session.User.UserFile) Do Begin
Read (Session.User.UserFile, Session.User.ThisUser);
If (Session.User.ThisUser.Flags AND UserDeleted = 0) and Session.User.Access(ACS) Then Begin
MsgTo := Session.User.ThisUser.Handle;
Session.User.ThisUser := OldUser;
Write_Mass_Msg;
{// appends wrong autosig so we add thisuser := olduser?}
// shitty kludge all of these var swaps should be
// rewritten.. probably do away with global MBAse records
End;
End;
Close (Session.User.UserFile);
Session.User.ThisUser := OldUser;
End;
'2' : For A := 1 to NamePos Do Begin
MsgTo := Names[A];
Write_Mass_Msg;
End;
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
End;
End;
Procedure TMsgBase.ViewSentEmail;
Var
Old : RecMessageBase;
Begin
Old := MBase;
Reset (MBaseFile);
Read (MBaseFile, MBase);
Close (MBaseFile);
ReadMessages('B', '');
MBase := Old;
End;
Procedure TMsgBase.MessageQuickScan (Data: String);
// defaults to ALL groups/bases
// /CURRENT = scan only current message base
// /GROUP = scan only current group bases
// options:
// /NOSCAN = do not show "scanning" prompt
// /NOFOOT = do not show "end of scan" prompt
// /NOHEAD = do not show "starting quickscan" prompt
// Only scans bases that they have selected in Newscan, of course
Const
Global_CurBase : LongInt = 1;
Global_TotalBases : LongInt = 1;
Global_TotalMsgs : LongInt = 0;
Global_NewMsgs : LongInt = 0;
Global_YourMsgs : LongInt = 0;
ShowIfNew : Boolean = False;
ShowIfYou : Boolean = False;
ShowScanPrompt : Boolean = True;
ShowHeadPrompt : Boolean = True;
ShowFootPrompt : Boolean = True;
Mode : Char = 'A';
Procedure ScanBase;
Var
NewMsgs : LongInt;
YourMsgs : LongInt;
TotalMsgs : LongInt;
Begin
Session.io.PromptInfo[1] := MBase.Name;
Session.io.PromptInfo[2] := strI2S(Global_CurBase);
Session.io.PromptInfo[3] := strI2S(Global_TotalBases);
NewMsgs := 0;
YourMsgs := 0;
TotalMsgs := 0;
If ShowScanPrompt Then Begin
Session.io.OutFull(Session.GetPrompt(487));
Session.io.BufFlush;
End;
GetMessageStats(MBase, TotalMsgs, NewMsgs, YourMsgs);
Inc (Global_TotalMsgs, TotalMsgs);
Inc (Global_NewMsgs, NewMsgs);
Inc (Global_YourMsgs, YourMsgs);
Session.io.PromptInfo[4] := strI2S(TotalMsgs);
Session.io.PromptInfo[5] := strI2S(NewMsgs);
Session.io.PromptInfo[6] := strI2S(YourMsgs);
Session.io.PromptInfo[7] := strI2S(Global_TotalMsgs);
Session.io.PromptInfo[8] := strI2S(Global_NewMsgs);
Session.io.PromptInfo[9] := strI2S(Global_YourMsgs);
If ShowScanPrompt Then
Session.io.OutBS(Screen.CursorX, True);
If (ShowIfNew And (NewMsgs > 0)) or (ShowIfYou And (YourMsgs > 0)) or (Not ShowIfNew And Not ShowIfYou) Then Begin
Session.io.OutFullLn(Session.GetPrompt(488));
Session.io.BufFlush;
End;
End;
Var
Old : RecMessageBase;
Begin
FillChar(Session.io.PromptInfo, SizeOf(Session.io.PromptInfo), 0);
If Pos('/GROUP', Data) > 0 Then Mode := 'G';
If Pos('/CURRENT', Data) > 0 Then Mode := 'C';
ShowScanPrompt := Pos('/NOSCAN', Data) = 0;
ShowHeadPrompt := Pos('/NOHEAD', Data) = 0;
ShowFootPrompt := Pos('/NOFOOT', Data) = 0;
Old := MBase;
Session.User.IgnoreGroup := Mode = 'A';
If ShowHeadPrompt Then
Session.io.OutFullLn (Session.GetPrompt(486));
If Mode = 'C' Then
ScanBase
Else Begin
Reset (MBaseFile);
Read (MBaseFile, MBase); {skip email base}
Global_TotalBases := FileSize(MBaseFile);
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
Global_CurBase := FilePos(MBaseFile);
If Session.User.Access(MBase.ReadACS) Then Begin
GetMessageScan;
If MScan.NewScan > 0 Then ScanBase;
End;
End;
Close (MBaseFile);
End;
If ShowFootPrompt Then
Session.io.OutFullLn(Session.GetPrompt(489));
Session.User.IgnoreGroup := False;
MBase := Old;
End;
Function TMsgBase.SaveMessage (mArea: RecMessageBase; mFrom, mTo, mSubj: String; mAddr: RecEchoMailAddr; mLines: Integer) : Boolean;
Var
SemFile : File;
Count : SmallInt;
Msg : PMsgBaseABS;
Begin
// things to do:
// 2) see if we can use assignmessagedata, etc
// 3) add autosig? if we cannot use the assignmsgdata things
Result := False;
If Not OpenCreateBase(Msg, mArea) Then Exit;
Msg^.StartNewMsg;
Msg^.SetLocal (True);
If mArea.NetType > 0 Then Begin
If mArea.NetType = 2 Then Begin
Msg^.SetMailType (mmtNetMail);
Msg^.SetCrash (Config.netCrash);
Msg^.SetHold (Config.netHold);
Msg^.SetKillSent (Config.netKillSent);
Msg^.SetDest (mAddr);
End Else
Msg^.SetMailType (mmtEchoMail);
Msg^.SetOrig(Config.NetAddress[mArea.NetAddr]);
Case mArea.NetType of
1 : Assign (SemFile, Config.SemaPath + fn_SemFileEcho);
2 : Assign (SemFile, Config.SemaPath + fn_SemFileNews);
3 : Assign (SemFile, Config.SemaPath + fn_SemFileNet);
End;
ReWrite (SemFile);
Close (SemFile);
End Else
Msg^.SetMailType (mmtNormal);
Msg^.SetPriv (mArea.Flags And MBPrivate <> 0);
Msg^.SetDate (DateDos2Str(CurDateDos, 1));
Msg^.SetTime (TimeDos2Str(CurDateDos, False));
Msg^.SetFrom (mFrom);
Msg^.SetTo (mTo);
Msg^.SetSubj (mSubj);
For Count := 1 to mLines Do
Msg^.DoStringLn(MsgText[Count]);
If mArea.NetType > 0 Then Begin
Msg^.DoStringLn (#13 + '--- ' + mysSoftwareID + ' BBS v' + mysVersion + ' (' + OSID + ')');
Msg^.DoStringLn (' * Origin: ' + ResolveOrigin(mArea) + ' (' + strAddr2Str(Config.NetAddress[mArea.NetAddr]) + ')');
End;
Msg^.WriteMsg;
Msg^.CloseMsgBase;
Dispose (Msg, Done);
Result := True;
End;
Procedure TMsgBase.PostTextFile (Data: String; AllowCodes: Boolean);
Const
MaxLines = 10000;
Var
MBaseFile : File;
mName : String;
mArea : Word;
mFrom : String;
mTo : String;
mSubj : String;
mAddr : RecEchoMailAddr;
mLines : Integer;
InFile : Text;
TextBuf : Array[1..2048] of Char;
Buffer : Array[1..MaxLines] of ^String;
Str : String[79];
Lines : Integer;
Pages : Integer;
Count : Integer;
Offset : Integer;
TempBase : RecMessageBase;
Begin
mName := strWordGet(1, Data, ';');
mArea := strS2I(strWordGet(2, Data, ';'));
mFrom := strWordGet(3, Data, ';');
mTo := strWordGet(4, Data, ';');
mSubj := strWordGet(5, Data, ';');
Str := strWordGet(6, Data, ';');
If (Str = '') Then Str := '0:0/0';
strStr2Addr (Str, mAddr);
If FileExist(Config.DataPath + mName) Then
mName := Config.DataPath + mName
Else
If Not FileExist(mName) Then Begin
Session.SystemLog('AutoPost: ' + mName + ' not found');
Exit;
End;
Assign (MBaseFile, Config.DataPath + 'mbases.dat');
ioReset (MBaseFile, SizeOf(RecMessageBase), fmReadWrite + fmDenyNone);
If Not ioSeek (MBaseFile, mArea) Then Begin
Close (MBaseFile);
Exit;
End;
If Not ioRead (MBaseFile, TempBase) Then Begin
Close (MBaseFile);
Exit;
End;
Close (MBaseFile);
Assign (InFile, mName);
SetTextBuf (InFile, TextBuf, SizeOf(TextBuf));
Reset (InFile);
Lines := 0;
While Not Eof(InFile) And (Lines < MaxLines) Do Begin
ReadLn (InFile, Str);
If AllowCodes Then Str := Session.io.StrMci(Str);
Inc (Lines);
New (Buffer[Lines]);
Buffer[Lines]^ := Str;
End;
Close (InFile);
Pages := Lines DIV mysMaxMsgLines + 1;
If (Lines MOD mysMaxMsgLines = 0) Then Dec(Pages);
For Count := 1 to Pages Do Begin
Offset := mysMaxMsgLines * Pred(Count);
mLines := 0;
While (Offset < Lines) and (mLines < mysMaxMsgLines) Do Begin
Inc (mLines);
Inc (Offset);
MsgText[mLines] := Buffer[Offset]^;
End;
If Pages > 1 Then
Str := mSubj + ' (' + strI2S(Count) + '/' + strI2S(Pages) + ')'
Else
Str := mSubj;
If Not SaveMessage (TempBase, mFrom, mTo, Str, mAddr, mLines) Then Break;
End;
While Lines > 0 Do Begin
Dispose (Buffer[Lines]);
Dec (Lines);
End;
End;
Function TMsgBase.ResolveOrigin (Var mArea: RecMessageBase) : String;
Var
Loc : Byte;
FN : String;
TF : Text;
Buf : Array[1..2048] of Char;
Str : String;
Count : LongInt;
Pick : LongInt;
Begin
Result := '';
Loc := Pos('@RANDOM=', mArea.Origin);
If Loc > 0 Then Begin
FN := strStripB(Copy(mArea.Origin, Loc + 8, 255), ' ');
If Pos(PathChar, FN) = 0 Then FN := Config.DataPath + FN;
FileMode := 66;
Assign (TF, FN);
SetTextBuf (TF, Buf, SizeOf(Buf));
Reset (TF);
If IoResult <> 0 Then Exit;
Count := 0;
While Not Eof(TF) Do Begin
ReadLn (TF, Str);
If strStripB(Str, ' ') = '' Then Continue;
Inc (Count);
End;
If Count = 0 Then Begin
Close (TF);
Exit;
End;
Pick := Random(Count) + 1;
Reset (TF);
Count := 0;
While Not Eof(TF) Do Begin
ReadLn (TF, Str);
If strStripB(Str, ' ') = '' Then Continue;
Inc (Count);
If Count = Pick Then Begin
Result := Str;
Break;
End;
End;
Close (TF);
End Else
Result := mArea.Origin;
End;
// ==========================================================================
// QWK/QWKE OPTIONS
// ==========================================================================
Procedure TMsgBase.WriteDOORID (Extended: Boolean);
Const
CRLF = #13#10;
Var
tFile : Text;
Begin
Assign (tFile, Session.TempPath + 'door.id');
ReWrite (tFile);
Write (tFile, 'DOOR = ' + mysSoftwareID + CRLF);
Write (tFile, 'VERSION = ' + mysVersion + CRLF);
Write (tFile, 'SYSTEM = ' + mysSoftwareID + ' ' + mysVersion + CRLF);
Write (tFile, 'CONTROLNAME = ' + qwkControlName + CRLF);
Write (tFile, 'CONTROLTYPE = ADD' + CRLF);
Write (tFile, 'CONTROLTYPE = DROP' + CRLF);
Close (tFile);
End;
Procedure TMsgBase.WriteTOREADEREXT;
Const
CRLF = #13#10;
Var
tFile : Text;
Begin
Assign (tFile, Session.TempPath + 'toreader.ext');
ReWrite (tFile);
Write (tFile, 'ALIAS ' + Session.User.ThisUser.Handle + CRLF);
Close (tFile);
End;
Procedure TMsgBase.WriteCONTROLDAT (Extended: Boolean);
Const
CRLF = #13#10; { for eventually having option for linux OR dos text files }
Var
tFile : Text;
Begin
Assign (tFile, Session.TempPath + 'control.dat');
ReWrite (tFile);
Write (tFile, Config.BBSName + CRLF);
Write (tFile, CRLF);
Write (tFile, CRLF);
Write (tFile, Config.SysopName + CRLF);
Write (tFile, '0,' + Config.qwkBBSID + CRLF);
Write (tFile, DateDos2Str(CurDateDos, 1), ',', TimeDos2Str(CurDateDos, False) + CRLF);
Write (tFile, strUpper(Session.User.ThisUser.Handle) + CRLF);
Write (tFile, CRLF);
Write (tFile, '0' + CRLF);
Write (tFile, TotalMsgs, CRLF); {TOTAL MSG IN PACKET}
Write (tFile, TotalConf - 1, CRLF); {TOTAL CONF - 1}
Reset (MBaseFile);
Read (MBaseFile, MBase); {SKIP EMAIL BASE}
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ReadACS) Then Begin
Write (tFile, MBase.Index, CRLF); {conf #}
If Extended Then
Write (tFile, strStripMCI(MBase.Name) + CRLF)
Else
Write (tFile, MBase.QwkName + CRLF);
End;
End;
Write (tFile, JustFile(Config.qwkWelcome) + CRLF);
Write (tFile, JustFile(Config.qwkNews) + CRLF);
Write (tFile, JustFile(Config.qwkGoodbye) + CRLF);
Close (tFile);
End;
{ converts TP real to Microsoft 4 bytes single }
{ what kind of stupid standard uses this var type!? }
Procedure Long2msb (Index : LongInt; Var MS : BSingle);
Var
Exp : Byte;
Begin
If Index <> 0 Then Begin
Exp := 0;
While Index And $800000 = 0 Do Begin
Inc (Exp);
Index := Index SHL 1
End;
Index := Index And $7FFFFF;
End Else
Exp := 152;
MS[0] := Index AND $FF;
MS[1] := (Index SHR 8) AND $FF;
MS[2] := (Index SHR 16) AND $FF;
MS[3] := 152 - Exp;
End;
Function TMsgBase.WriteMSGDAT (Extended: Boolean) : LongInt;
{ returns last message added to qwk packet }
Var
DataFile : File;
NdxFile : File of QwkNdxHdr;
NdxHdr : QwkNdxHdr;
QwkHdr : QwkDATHdr;
Temp : String;
MsgAdded : Integer; {# of message added in packet}
LastRead : LongInt;
BufStr : String[128];
Blocks : Word;
Index : LongInt;
TooBig : Boolean;
Procedure DoString (Str: String);
Var
Count : SmallInt;
Begin
For Count := 1 to Length(Temp) Do Begin
BufStr := BufStr + Temp[Count];
If BufStr[0] = #128 Then Begin
BlockWrite (DataFile, BufStr[1], 128);
BufStr := '';
End;
End;
End;
Begin
// Inc (TotalConf);
MsgAdded := 0;
If Not OpenCreateBase(MsgBase, MBase) Then Exit;
Session.io.OutFull (Session.GetPrompt(231));
Assign (DataFile, Session.TempPath + 'messages.dat');
Reset (DataFile, 1);
Seek (DataFile, FileSize(DataFile));
LastRead := MsgBase^.GetLastRead(Session.User.UserNum) + 1;
MsgBase^.SeekFirst(LastRead);
While MsgBase^.SeekFound Do Begin
If ((Config.qwkMaxBase > 0) and (MsgAdded = Config.qwkMaxBase)) or
((Config.qwkMaxPacket > 0) and (TotalMsgs = Config.qwkMaxPacket)) Then Break;
FillChar (QwkHdr, 128, ' ');
MsgBase^.MsgStartUp;
If MsgBase^.IsPriv Then
If Not ((MsgBase^.GetTo = Session.User.ThisUser.RealName) or (MsgBase^.GetTo = Session.User.ThisUser.Handle)) Then Begin
MsgBase^.SeekNext;
Continue;
End;
Inc (MsgAdded);
Inc (TotalMsgs);
LastRead := MsgBase^.GetMsgNum;
Temp := strPadR(strUpper(MsgBase^.GetFrom), 25, ' ');
Move (Temp[1], QwkHdr.UPFrom, 25);
Temp := strPadR(strUpper(MsgBase^.GetTo), 25, ' ');
Move (Temp[1], QwkHdr.UPTo, 25);
Temp := strPadR(MsgBase^.GetSubj, 25, ' ');
Move (Temp[1], QwkHdr.Subject, 25);
Temp := MsgBase^.GetDate;
Move (Temp[1], QwkHdr.Date, 8);
Temp := MsgBase^.GetTime;
Move (Temp[1], QwkHdr.Time, 5);
Temp := strPadR(strI2S(MsgBase^.GetMsgNum), 7, ' ');
Move (Temp[1], QwkHdr.MSGNum, 7);
Temp := strPadR(strI2S(MsgBase^.GetRefer), 8, ' ');
Move (Temp[1], QwkHdr.ReferNum, 8);
QwkHdr.Active := #225;
QwkHdr.ConfNum := MBase.Index;
QwkHdr.Status := ' ';
MsgBase^.MsgTxtStartUp;
Blocks := MsgBase^.GetTextLen DIV 128;
If MsgBase^.GetTextLen MOD 128 > 0 Then Inc(Blocks, 2) Else Inc(Blocks);
Temp := strPadR(strI2S(Blocks), 6, ' ');
Move (Temp[1], QwkHdr.NumChunk, 6);
If MsgAdded = 1 Then Begin
Assign (NdxFile, Session.TempPath + strPadL(strI2S(MBase.Index), 3, '0') + '.ndx');
ReWrite (NdxFile);
End;
Index := FileSize(DataFile) DIV 128 + 1;
long2msb (Index, NdxHdr.MsgPos);
Write (NdxFile, NdxHdr);
BlockWrite (DataFile, QwkHdr, 128);
BufStr := '';
TooBig := False;
If Extended Then Begin
If Length(MsgBase^.GetFrom) > 25 Then Begin
DoString('From: ' + MsgBase^.GetFrom + #227);
TooBig := True;
End;
If Length(MsgBase^.GetTo) > 25 Then Begin
DoString('To: ' + MsgBase^.GetTo + #227);
TooBig := True;
End;
If Length(MsgBase^.GetSubj) > 25 Then Begin
DoString('Subject: ' + MsgBase^.GetSubj + #227);
TooBig := True;
End;
If TooBig Then DoString(#227);
End;
While Not MsgBase^.EOM Do Begin
Temp := MsgBase^.GetString(79) + #227;
If Temp[1] = #1 Then Continue;
DoString(Temp);
End;
If BufStr <> '' Then Begin
BufStr := strPadR(BufStr, 128, ' ');
BlockWrite (DataFile, BufStr[1], 128);
End;
MsgBase^.SeekNext;
End;
Close (DataFile);
If MsgAdded > 0 Then Close (NdxFile);
Session.io.PromptInfo[1] := strI2S(MBase.Index);
Session.io.PromptInfo[2] := MBase.Name;
Session.io.PromptInfo[3] := MBase.QwkName;
Session.io.PromptInfo[4] := strI2S(MsgBase^.NumberOfMsgs);
Session.io.PromptInfo[5] := strI2S(MsgAdded);
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
Session.io.OutBS (Screen.CursorX, True);
Session.io.OutFullLn (Session.GetPrompt(232));
Result := LastRead;
End;
Procedure TMsgBase.DownloadQWK (Extended: Boolean; Data: String);
Type
QwkLRRec = Record
Base : Word;
Pos : LongInt;
End;
Var
Old : RecMessageBase;
DataFile : File;
Temp : String;
QwkLR : QwkLRRec;
QwkLRFile : File of QwkLRRec;
Begin
If Session.User.ThisUser.QwkFiles Then
Session.FileBase.ExportFileList(True, True);
Old := MBase;
Temp := strPadR('Produced By ' + mysSoftwareID + ' BBS v' + mysVersion + '. ' + CopyID, 128, ' ');
Assign (DataFile, Session.TempPath + 'messages.dat');
ReWrite (DataFile, 1);
BlockWrite (DataFile, Temp[1], 128);
Close (DataFile);
Assign (QwkLRFile, Session.TempPath + 'qlr.dat');
ReWrite (QwkLRFile);
Reset (MBaseFile);
Read (MBaseFile, MBase); {Skip Email base}
Session.io.OutFullLn (Session.GetPrompt(230));
TotalMsgs := 0;
TotalConf := 0;
Session.User.IgnoreGroup := Pos('/ALLGROUP', strUpper(Data)) > 0;
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If Session.User.Access(MBase.ReadACS) Then Begin
Inc (TotalConf);
GetMessageScan;
If MScan.QwkScan > 0 Then Begin
QwkLR.Base := FilePos(MBaseFile);
QwkLR.Pos := WriteMsgDAT(Extended);
Write (QwkLRFile, QwkLR);
End;
End;
End;
Close (QwkLRFile);
WriteControlDAT (Extended);
WriteDOORID (Extended);
If Extended Then WriteTOREADEREXT;
If TotalMsgs > 0 Then Begin
Session.io.PromptInfo[1] := strI2S(TotalMsgs);
Session.io.PromptInfo[2] := strI2S(TotalConf);
Session.io.OutFullLn (Session.GetPrompt(233));
Temp := Config.qwkBBSID + '.qwk';
Session.io.OutFullLn (Session.GetPrompt(234));
Session.io.PromptInfo[1] := Temp;
If FileExist(Config.QwkWelcome) Then FileCopy(Config.qwkWelcome, Session.TempPath + JustFile(Config.qwkWelcome));
If FileExist(Config.QwkNews) Then FileCopy(Config.qwkNews, Session.TempPath + JustFile(Config.qwkNews));
If FileExist(Config.QwkGoodbye) Then FileCopy(Config.qwkGoodbye, Session.TempPath + JustFile(Config.qwkGoodbye));
If Session.LocalMode Then Begin
Session.FileBase.ExecuteArchive (Config.QWKPath + Temp, Session.User.ThisUser.Archive, Session.TempPath + '*', 1);
Session.io.OutFullLn (Session.GetPrompt(235));
End Else Begin
Session.FileBase.ExecuteArchive (Session.TempPath + Temp, Session.User.ThisUser.Archive, Session.TempPath + '*', 1);
Session.FileBase.SendFile (Session.TempPath + Temp);
End;
If Session.io.GetYN (Session.GetPrompt(236), True) Then Begin
Reset (MBaseFile);
Reset (QwkLRFile);
While Not Eof(QwkLRFile) Do Begin
Read (QwkLRFile, QwkLR);
Seek (MBaseFile, QwkLR.Base - 1);
Read (MBaseFile, MBase);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If MsgBase^.OpenMsgBase Then Begin
MsgBase^.SetLastRead (Session.User.UserNum, QwkLR.Pos);
MsgBase^.CloseMsgBase;
End;
Dispose(MsgBase, Done);
End;
Close (QwkLRFile);
End;
End Else
Session.io.OutFullLn (Session.GetPrompt(228));
Session.User.IgnoreGroup := False;
Close (MBaseFile);
MBase := Old;
DirClean (Session.TempPath, '');
End;
Procedure TMsgBase.UploadREP;
Var
DataFile : File;
TempBase : RecMessageBase;
OldBase : RecMessageBase;
QwkHeader : QwkDATHdr;
QwkBlock : String[128];
Line : String;
A : SmallInt;
B : SmallInt;
Chunks : SmallInt;
LineCount : SmallInt;
IsControl : Boolean;
GotControl : Boolean;
ExtFile : Text;
Procedure QwkControl (Idx: LongInt; Mode: Byte);
Begin
OldBase := MBase;
If GetBaseByIndex(Idx, MBase) Then Begin
GetMessageScan;
MScan.QwkScan := Mode;
SetMessageScan;
End;
MBase := OldBase;
End;
Begin
If Session.LocalMode Then
Session.FileBase.ExecuteArchive (Config.QWKPath + Config.qwkBBSID + '.rep', Session.User.ThisUser.Archive, '*', 2)
Else Begin
If Session.FileBase.SelectProtocol(True, False) = 'Q' Then Exit;
Session.FileBase.ExecuteProtocol(1, Session.TempPath + Config.qwkBBSID + '.rep');
If Not Session.FileBase.DszSearch(Config.qwkBBSID + '.rep') Then Begin
Session.io.PromptInfo[1] := Config.qwkBBSID + '.rep';
Session.io.OutFullLn (Session.GetPrompt(84));
Exit;
End;
Session.FileBase.ExecuteArchive (Session.TempPath + Config.qwkBBSID + '.rep', Session.User.ThisUser.Archive, '*', 2)
End;
Assign (DataFile, FileFind(Session.TempPath + Config.qwkBBSID + '.msg'));
{$I-} Reset (DataFile, 1); {$I+}
If IoResult <> 0 Then Begin
Session.io.OutFull (Session.GetPrompt(238));
DirClean (Session.TempPath, '');
Exit;
End;
BlockRead (DataFile, QwkBlock[1], 128);
QwkBlock[0] := #128;
If Pos(strUpper(Config.qwkBBSID), strUpper(QwkBlock)) = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(239));
Close (DataFile);
DirClean(Session.TempPath, '');
Exit;
End;
Session.io.OutFullLn (Session.GetPrompt(240));
While Not Eof(DataFile) Do Begin
BlockRead (DataFile, QwkHeader, SizeOf(QwkHeader));
Move (QwkHeader.MsgNum, QwkBlock[1], 7);
QwkBlock[0] := #7;
If GetBaseByIndex(strS2I(QwkBlock), TempBase) Then Begin
If OpenCreateBase(MsgBase, TempBase) Then Begin
AssignMessageData(MsgBase);
QwkBlock[0] := #25;
Move (QwkHeader.UpTo, QwkBlock[1], 25);
MsgBase^.SetTo(strStripR(QwkBlock, ' '));
Move (QwkHeader.Subject, QwkBlock[1], 25);
MsgBase^.SetSubj(strStripR(QwkBlock, ' '));
Move (QwkHeader.ReferNum, QwkBlock[1], 6);
QwkBlock[0] := #6;
MsgBase^.SetRefer(strS2I(strStripR(QwkBlock, ' ')));
Move(QwkHeader.NumChunk, QwkBlock[1], 6);
Chunks := strS2I(QwkBlock) - 1;
Line := '';
LineCount := 0;
IsControl := MsgBase^.GetTo = qwkControlName;
GotControl := False;
If IsControl And ((MsgBase^.GetSubj = 'ADD') or (MsgBase^.GetSubj = 'DROP')) Then
QwkControl (TempBase.Index, Ord(MsgBase^.GetSubj = 'ADD'));
For A := 1 to Chunks Do Begin
BlockRead (DataFile, QwkBlock[1], 128);
QwkBlock[0] := #128;
QwkBlock := strStripR(QwkBlock, ' ');
For B := 1 to Length(QwkBlock) Do Begin
If QwkBlock[B] = #227 Then Begin
Inc (LineCount);
If (LineCount < 4) and (Copy(Line, 1, 5) = 'From:') Then
GotControl := True
// Mystic uses the username of the person who uploaded the
// reply package, based on the alias/realname setting of the
// base itself. This prevents people from spoofing "From"
// fields.
Else
If (LineCount < 4) and (Copy(Line, 1, 3) = 'To:') Then Begin
MsgBase^.SetTo(strStripB(Copy(Line, 4, Length(Line)), ' '));
GotControl := True;
End Else
If (LineCount < 4) and (Copy(Line, 1, 8) = 'Subject:') Then Begin
MsgBase^.SetSubj(strStripB(Copy(Line, 9, Length(Line)), ' '));
GotControl := True;
End Else
If GotControl And (Line = '') Then
GotControl := False
Else
MsgBase^.DoStringLn(Line);
Line := '';
End Else
Line := Line + QwkBlock[B];
End;
End;
If Line <> '' Then MsgBase^.DoStringLn(Line);
If TempBase.NetType > 0 Then Begin
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
MsgBase^.DoStringLn (' * Origin: ' + ResolveOrigin(TempBase) + ' (' + strAddr2Str(Config.NetAddress[TempBase.NetAddr]) + ')');
End;
If Not IsControl Then MsgBase^.WriteMsg;
MsgBase^.CloseMsgBase;
If Not IsControl Then Begin
Inc (Session.User.ThisUser.Posts);
Inc (Session.HistoryPosts);
End;
Dispose (MsgBase, Done);
End;
End;
End;
Close (DataFile);
Assign (ExtFile, FileFind(Session.TempPath + 'todoor.ext'));
{$I-} Reset (ExtFile); {$I+}
If IoResult = 0 Then Begin
While Not Eof(ExtFile) Do Begin
ReadLn (ExtFile, Line);
If strWordGet(1, Line, ' ') = 'AREA' Then Begin
QwkBlock := strWordGet(3, Line, ' ');
If Pos('a', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 1);
If Pos('D', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 0);
End;
End;
Close (ExtFile);
End;
DirClean (Session.TempPath, '');
End;
End.
Reference in New Issue View Git Blame Copy Permalink