954 lines
28 KiB
Plaintext
954 lines
28 KiB
Plaintext
PROGRAM Renemail; {eatus echomailius}
|
||
|
||
{$A+,I-,E-,F+}
|
||
|
||
(* {A+,B-,D-,E-,F+,G+,N-,R-,S-,V-,I-} *)
|
||
|
||
uses crt, dos, timefunc;
|
||
|
||
{$I RECORDS.PAS}
|
||
|
||
type
|
||
fidorecord = record
|
||
FromUserName : string[35];
|
||
ToUserName : string[35];
|
||
Subject : string[71];
|
||
DateTime : string[19];
|
||
TimesRead : word;
|
||
DestNode : word;
|
||
OrigNode : word;
|
||
Cost : word;
|
||
OrigNet : word;
|
||
DestNet : word;
|
||
Filler : array[1..8] of char;
|
||
Replyto : word;
|
||
Attribute : word;
|
||
NextReply : word;
|
||
END;
|
||
|
||
VAR
|
||
LastError :integer;
|
||
header : fidorecord;
|
||
dt : datetime;
|
||
MsgTFile : file;
|
||
hiwaterf : file of integer;
|
||
statusf : file of generalrecordtype;
|
||
statusr : generalrecordtype;
|
||
boardf : file of MessageAreaRecordType;
|
||
BoardR : MessageAreaRecordType;
|
||
MsgHdrF : file of mheaderrec;
|
||
MsgHdr : mheaderrec;
|
||
MsgTxtF : file;
|
||
uf : file of userrecordtype;
|
||
user : userrecordtype;
|
||
sf : file of useridxrec;
|
||
toi, fromi, subjecti, datetime : string;
|
||
i, j, lines, MsgNumber, highest, lowest, Board, TextSize,
|
||
msglength, msgpointer : integer;
|
||
c : char;
|
||
attribute : word;
|
||
ispm : boolean;
|
||
dirinfo : searchrec;
|
||
s, StartDir, nos, datapath, MsgPath, netmailpath : string [81];
|
||
MsgTxt : string [255];
|
||
buffer : array [1..32767] of char;
|
||
fcb : array [1..37] of char;
|
||
{$IFDEF MSDOS}
|
||
Regs : registers;
|
||
{$ENDIF}
|
||
x : byte;
|
||
|
||
const
|
||
netmailonly : boolean = FALSE;
|
||
IsNetMail : boolean = FALSE;
|
||
fastpurge : boolean = TRUE;
|
||
process_netmail : boolean = TRUE;
|
||
purge_netmail : boolean = TRUE;
|
||
absolute_scan : boolean = FALSE;
|
||
ignore_1msg : boolean = TRUE;
|
||
|
||
FUNCTION Hex(i : longint; j:byte) : String;
|
||
const
|
||
hc : array[0..15] of Char = '0123456789ABCDEF';
|
||
VAR
|
||
one,two,three,four: Byte;
|
||
BEGIN
|
||
one := (i AND $000000FF);
|
||
two := (i AND $0000FF00) SHR 8;
|
||
three := (i AND $00FF0000) SHR 16;
|
||
four := (i AND $FF000000) SHR 24;
|
||
|
||
Hex[0] := chr(j); { Length of String = 4 or 8}
|
||
IF (j = 4) THEN
|
||
BEGIN
|
||
Hex[1] := hc[two SHR 4];
|
||
Hex[2] := hc[two AND $F];
|
||
Hex[3] := hc[one SHR 4];
|
||
Hex[4] := hc[one AND $F];
|
||
END
|
||
ELSE
|
||
BEGIN
|
||
Hex[8] := hc[one AND $F];
|
||
Hex[7] := hc[one SHR 4];
|
||
Hex[6] := hc[two AND $F];
|
||
Hex[5] := hc[two SHR 4];
|
||
hex[4] := hc[three AND $F];
|
||
hex[3] := hc[three SHR 4];
|
||
hex[2] := hc[four AND $F];
|
||
hex[1] := hc[four SHR 4];
|
||
END;
|
||
END {Hex} ;
|
||
|
||
FUNCTION Usename(b:byte; s:astr):string;
|
||
BEGIN
|
||
case b of
|
||
1,
|
||
2:s:='Anonymous';
|
||
3:s:='Abby';
|
||
4:s:='Problemed Person';
|
||
END;
|
||
Usename:=s;
|
||
END;
|
||
|
||
FUNCTION ExistDir(fn:string):boolean;
|
||
VAR dirinfo:searchrec;
|
||
BEGIN
|
||
WHILE (fn[Length(fn)] = '\') DO
|
||
Dec(fn[0]);
|
||
findfirst(fn,anyfile,dirinfo);
|
||
ExistDir:=(doserror=0) AND (dirinfo.attr AND $10=$10);
|
||
END;
|
||
|
||
FUNCTION StrPas(Str: String): String; assembler;
|
||
asm
|
||
PUSH DS
|
||
CLD
|
||
LES DI,Str
|
||
MOV CX,0FFFFH
|
||
XOR AL,AL
|
||
REPNE SCASB
|
||
NOT CX
|
||
Dec CX
|
||
LDS SI,Str
|
||
LES DI,@Result
|
||
MOV AL,CL
|
||
STOSB
|
||
REP MOVSB
|
||
POP DS
|
||
END;
|
||
|
||
|
||
FUNCTION StripName(s:astr):astr;
|
||
VAR
|
||
n:integer;
|
||
BEGIN
|
||
n := Length(s);
|
||
WHILE (n > 0) AND (POS(s[n],':\/') = 0) DO
|
||
Dec(n);
|
||
Delete(s,1,n);
|
||
StripName := s;
|
||
END;
|
||
|
||
FUNCTION AllCaps (const s : string) : string;
|
||
VAR
|
||
q : integer;
|
||
BEGIN
|
||
AllCaps [0] := s [0];
|
||
FOR q := 1 TO Length (s) DO
|
||
AllCaps [q] := upcase (s [q]);
|
||
END;
|
||
|
||
FUNCTION Caps (s : string) : string;
|
||
VAR
|
||
i : integer;
|
||
BEGIN
|
||
FOR i := 1 TO Length (s) DO
|
||
IF (s [i] in ['A'..'Z']) THEN
|
||
s [i] := chr (ord (s [i]) + 32);
|
||
|
||
FOR i := 1 TO Length (s) DO
|
||
IF (NOT (s [i] in ['A'..'Z', 'a'..'z', chr (39) ]) ) THEN
|
||
IF (s [i + 1] in ['a'..'z']) THEN
|
||
s [i + 1] := upcase (s [i + 1]);
|
||
s [1] := upcase (s [1]);
|
||
Caps := s;
|
||
END;
|
||
|
||
FUNCTION searchuser(Uname:string): word;
|
||
VAR
|
||
Current:integer;
|
||
Done:boolean;
|
||
IndexR:useridxrec;
|
||
BEGIN
|
||
|
||
Reset(sf);
|
||
IF (IOResult > 0) THEN Exit;
|
||
|
||
Uname := AllCaps(UName);
|
||
|
||
Current := 0;
|
||
Done := FALSE;
|
||
|
||
IF (FileSize(sf) > 0) THEN BEGIN
|
||
REPEAT
|
||
Seek(sf, Current);
|
||
Read(sf, IndexR);
|
||
IF (Uname < IndexR.Name) THEN BEGIN Current := IndexR.Left END
|
||
ELSE BEGIN
|
||
IF (Uname > IndexR.Name) THEN Current := IndexR.Right
|
||
ELSE Done := TRUE;
|
||
END;
|
||
UNTIL (Current = -1) or (Done);
|
||
END;
|
||
|
||
Close(sf);
|
||
|
||
IF (Done) AND NOT (IndexR.Deleted) THEN SearchUser := IndexR.Number
|
||
ELSE SearchUser := 0;
|
||
|
||
LastError := IOResult;
|
||
END;
|
||
|
||
FUNCTION StripColor (o : string) : string;
|
||
VAR i,j : byte;
|
||
s : string;
|
||
BEGIN
|
||
i := 0;
|
||
s := '';
|
||
WHILE (i < Length (o) ) DO BEGIN
|
||
Inc (i);
|
||
case o [i] of
|
||
#128..#255:IF (mafilter in BoardR.maflags) THEN
|
||
s := s + chr(ord(o[i]) AND 128)
|
||
ELSE
|
||
s := s + o[i];
|
||
'^' : IF o [i + 1] in [#0..#9, '0'..'9'] THEN
|
||
Inc (i) ELSE s := s + '^';
|
||
'|' : IF (mafilter in BoardR.maflags) AND (o[i + 1] in ['0'..'9']) THEN
|
||
BEGIN
|
||
j:=0;
|
||
WHILE (o [i + 1] in ['0'..'9']) AND (i <= Length (o) )
|
||
AND (j<=2) DO BEGIN
|
||
Inc (i);
|
||
Inc (j)
|
||
END
|
||
END
|
||
ELSE
|
||
s := s + '|'
|
||
ELSE s := s + o [i];
|
||
END;
|
||
END;
|
||
StripColor := s;
|
||
END;
|
||
|
||
procedure aborterror(const s:string);
|
||
BEGIN
|
||
WriteLn(s);
|
||
halt(255);
|
||
END;
|
||
|
||
FUNCTION Value (s : string) : longint;
|
||
VAR i : longint;
|
||
j : integer;
|
||
BEGIN
|
||
val (s, i, j);
|
||
IF (j <> 0) THEN BEGIN
|
||
s[0]:=chr(j-1);
|
||
val (s, i, j)
|
||
END;
|
||
Value := i;
|
||
IF (s = '') THEN Value := 0;
|
||
END;
|
||
|
||
FUNCTION CStr (i : longint) : string;
|
||
VAR c : string [16];
|
||
BEGIN
|
||
str (i, c);
|
||
CStr := c;
|
||
END;
|
||
|
||
procedure getmsglst (const dir : string);
|
||
VAR hiwater : integer;
|
||
BEGIN
|
||
hiwater := 1;
|
||
IF NOT IsNetMail THEN BEGIN
|
||
Assign (hiwaterf, dir + 'HI_WATER.MRK');
|
||
Reset (hiwaterf);
|
||
IF IOResult <> 0 THEN BEGIN
|
||
ReWrite (hiwaterf);
|
||
Write (hiwaterf, hiwater);
|
||
IF IOResult <> 0 THEN aborterror('error creating ' + dir + '\HI_WATER.MRK');
|
||
END
|
||
ELSE BEGIN
|
||
Read (hiwaterf, hiwater);
|
||
i := IOResult;
|
||
findfirst (dir + CStr (hiwater) + '.MSG', 0, dirinfo);
|
||
IF doserror <> 0 THEN hiwater := 1;
|
||
END;
|
||
Close (hiwaterf);
|
||
END;
|
||
findfirst (dir + '*.MSG', 0, dirinfo);
|
||
highest := 1;
|
||
lowest := 32767;
|
||
WHILE doserror = 0 DO BEGIN
|
||
i := Value (dirinfo.name);
|
||
IF i < lowest THEN lowest := i;
|
||
IF i > highest THEN highest := i;
|
||
findnext (dirinfo);
|
||
END;
|
||
|
||
IF hiwater <= highest THEN BEGIN
|
||
IF hiwater > 1 THEN lowest := hiwater + 1;
|
||
END;
|
||
|
||
IF (ignore_1msg) THEN BEGIN
|
||
IF (lowest = 1) AND (highest > 1) THEN lowest := 2;
|
||
END;
|
||
LastError := IOResult;
|
||
END;
|
||
|
||
procedure getpaths;
|
||
|
||
procedure badpath(const s:string);
|
||
BEGIN
|
||
WriteLn('The ',s,' path is bad. Please correct it.');
|
||
halt;
|
||
END;
|
||
|
||
BEGIN
|
||
s := fsearch ('RENEGADE.DAT', getenv ('PATH') );
|
||
Assign (statusf, s);
|
||
Reset (statusf);
|
||
IF (IOResult <> 0) or (s = '') THEN BEGIN
|
||
WriteLn ('RENEGADE.DAT must be in the current directory or the path.');
|
||
halt (1);
|
||
END;
|
||
Read (statusf, statusr);
|
||
datapath := statusr.datapath;
|
||
IF NOT (ExistDir(datapath)) THEN badpath('DATA');
|
||
netmailpath := statusr.netmailpath;
|
||
IF NOT (ExistDir(netmailpath)) THEN badpath('NETMAIL');
|
||
MsgPath := statusr.MsgPath;
|
||
IF NOT (ExistDir(MsgPath)) THEN badpath('MSGS');
|
||
Close (statusf);
|
||
IF IOResult <> 0 THEN
|
||
aborterror('error reading From RENEGADE.DAT');
|
||
END;
|
||
|
||
procedure updatehiwater (const dir:string; x:integer);
|
||
BEGIN
|
||
Assign (hiwaterf, dir + 'HI_WATER.MRK');
|
||
ReWrite (hiwaterf);
|
||
Write (hiwaterf, x);
|
||
Close (hiwaterf);
|
||
i := IOResult;
|
||
END;
|
||
|
||
procedure PurgeDir (const dir : string);
|
||
VAR purged : boolean;
|
||
BEGIN
|
||
{$IFDEF MSDOS}
|
||
IF fastpurge THEN BEGIN
|
||
ChDir (Copy (dir, 1, Length (dir) - 1) );
|
||
IF (IOResult <> 0) THEN Exit;
|
||
IF (dir[2] = ':') THEN fcb [1] := chr(ord(dir[1]) - 64)
|
||
ELSE fcb [1] := chr(ord(StartDir[1]) - 64);
|
||
Regs.ds := seg (fcb);
|
||
Regs.dx := ofs (fcb);
|
||
Regs.ax := $1300;
|
||
msdos (Regs);
|
||
purged := (lo (Regs.ax) = 0);
|
||
END;
|
||
{$ENDIF}
|
||
IF NOT fastpurge THEN BEGIN
|
||
purged := TRUE;
|
||
findfirst (dir + '*.MSG', 0, dirinfo);
|
||
IF doserror <> 0 THEN BEGIN purged := FALSE END
|
||
ELSE BEGIN
|
||
WHILE doserror = 0 DO BEGIN
|
||
Assign (hiwaterf, dir + dirinfo.name);
|
||
erase (hiwaterf);
|
||
i := IOResult;
|
||
findnext (dirinfo);
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
IF NOT purged THEN Write ('No messages')
|
||
ELSE Write ('Purged');
|
||
updatehiwater (dir, 1);
|
||
END;
|
||
|
||
FUNCTION readmsg (x:integer ; const dir:string) : boolean;
|
||
VAR
|
||
q : boolean;
|
||
BEGIN
|
||
Assign (MsgTFile, dir + CStr (x) + '.MSG');
|
||
Reset (MsgTFile, 1);
|
||
q := FALSE;
|
||
IF IOResult = 0 THEN BEGIN
|
||
|
||
IF FileSize (MsgTFile) >= sizeof(header) THEN BEGIN
|
||
|
||
BlockRead (MsgTFile, header, sizeof(header));
|
||
s := StrPas(Header.FromUserName);
|
||
|
||
IF ((header.attribute AND 16) = 16) THEN MsgHdr.fileattached := 1;
|
||
|
||
MsgHdr.From.a1s := s;
|
||
MsgHdr.From.real := s;
|
||
MsgHdr.From.name := s;
|
||
|
||
s := StrPas(Header.ToUserName);
|
||
|
||
MsgHdr.MTO.a1s := s;
|
||
MsgHdr.MTO.real := s;
|
||
MsgHdr.MTO.name := s;
|
||
|
||
MsgHdr.Subject := StrPas(Header.Subject);
|
||
|
||
MsgHdr.OriginDate := StrPas(Header.DateTime);
|
||
|
||
q := TRUE;
|
||
|
||
IF (Header.Attribute AND 1 = 1) THEN MsgHdr.status := [Sent, Prvt]
|
||
ELSE MsgHdr.status := [Sent];
|
||
|
||
IF IsNetMail THEN BEGIN
|
||
q:=FALSE;
|
||
MsgHdr.From.node := Header.OrigNode;
|
||
MsgHdr.From.net := Header.OrigNet;
|
||
MsgHdr.MTO.node := Header.DestNode;
|
||
MsgHdr.MTO.net := Header.DestNet;
|
||
MsgHdr.From.Point := 0;
|
||
MsgHdr.MTO.Point := 0;
|
||
MsgHdr.From.Zone := 0;
|
||
MsgHdr.MTO.Zone := 0;
|
||
IF (Header.Attribute AND 256 = 0) AND
|
||
(Header.Attribute AND 4 = 0) THEN BEGIN
|
||
{look here FOR the netmail bug}
|
||
FOR i := 0 TO 19 DO BEGIN {21 is the uucp}
|
||
IF (MsgHdr.MTO.node = statusr.aka[i].node) AND
|
||
(MsgHdr.MTO.net = statusr.aka[i].net) THEN BEGIN
|
||
MsgHdr.MTO.Zone := statusr.aka[i].Zone;
|
||
MsgHdr.From.Zone := statusr.aka[i].Zone;
|
||
q := TRUE;
|
||
END;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
IF q THEN BEGIN
|
||
IF (FileSize(MsgTFile) - 190) <= sizeof(buffer) THEN x := FileSize(MsgTFile) - 190
|
||
ELSE x := sizeof(buffer);
|
||
BlockRead (MsgTFile, buffer, x, msglength);
|
||
END;
|
||
END;
|
||
|
||
IF IsNetMail THEN
|
||
IF q AND purge_netmail THEN
|
||
BEGIN
|
||
Close (MsgTFile);
|
||
erase (MsgTFile)
|
||
END
|
||
ELSE IF q THEN
|
||
BEGIN
|
||
Header.Attribute := 260;
|
||
Seek (MsgTFile, 0);
|
||
BlockWrite (MsgTFile, header, sizeof(Header));
|
||
END;
|
||
IF NOT (IsNetMail AND q AND purge_netmail) THEN Close(MsgTFile);
|
||
END;
|
||
readmsg := q;
|
||
i := IOResult;
|
||
END;
|
||
|
||
procedure nextboard(Scanning:boolean);
|
||
VAR
|
||
GoodBoard:boolean;
|
||
BEGIN
|
||
IF Board = 0 THEN
|
||
BEGIN
|
||
i := IOResult;
|
||
Assign (boardf, datapath + 'MBASES.DAT');
|
||
Reset (boardf);
|
||
i := IOResult;
|
||
IF i <> 0 THEN
|
||
BEGIN
|
||
WriteLn (i,':Problem accessing ' + datapath + 'MBASES.DAT. Please fix.');
|
||
halt (1);
|
||
END;
|
||
END;
|
||
|
||
IF Board = FileSize (boardf) THEN
|
||
BEGIN
|
||
Board := 32767;
|
||
Exit;
|
||
END;
|
||
|
||
BoardR.matype := 0; BoardR.maflags := []; GoodBoard := FALSE;
|
||
WHILE NOT GoodBoard AND (Board < FileSize(boardf)) DO
|
||
BEGIN
|
||
Read (boardf, BoardR);
|
||
GoodBoard := (BoardR.matype = 1) AND
|
||
(NOT scanning or (absolute_scan or (mascanout in BoardR.maflags)));
|
||
Inc(Board);
|
||
END;
|
||
|
||
IF (NOT GoodBoard) THEN
|
||
Board := 32767
|
||
ELSE
|
||
IF scanning AND (mascanout in BoardR.maflags) THEN
|
||
BEGIN
|
||
Seek(boardf, Board - 1);
|
||
BoardR.maflags := BoardR.maflags - [mascanout];
|
||
Write(boardf, BoardR);
|
||
END;
|
||
END;
|
||
|
||
|
||
procedure toss;
|
||
VAR i,j:word;
|
||
z:string [20];
|
||
left, right, gap, oldgap : integer;
|
||
BEGIN
|
||
MsgHdr.From.anon := 0;
|
||
MsgHdr.From.usernum := 0;
|
||
MsgHdr.MTO.anon := 0;
|
||
MsgHdr.MTO.usernum := 0;
|
||
MsgHdr.replyto := 0;
|
||
MsgHdr.replies := 0;
|
||
MsgHdr.fileattached := 0;
|
||
|
||
getdayofweek (MsgHdr.dayofweek);
|
||
MsgHdr.date := getpackdatetime;
|
||
getmsglst (BoardR.MsgPath);
|
||
IF IsNetMail AND (highest > 1) THEN lowest := 1;
|
||
|
||
IF (lowest <= highest) AND ((highest > 1) or IsNetMail) THEN BEGIN
|
||
|
||
Assign (MsgHdrF, MsgPath + BoardR.FileName + '.HDR');
|
||
Reset (MsgHdrF);
|
||
IF (IOResult = 2) THEN ReWrite (MsgHdrF);
|
||
|
||
Assign (MsgTxtF, MsgPath + BoardR.FileName + '.DAT');
|
||
Reset (MsgTxtF, 1);
|
||
IF (IOResult = 2) THEN ReWrite (MsgTxtF, 1);
|
||
|
||
Seek (MsgHdrF, FileSize (MsgHdrF) );
|
||
Seek (MsgTxtF, FileSize (MsgTxtF) );
|
||
|
||
IF IOResult <> 0 THEN
|
||
aborterror('error accessing ' + MsgPath + BoardR.FileName + '.*');
|
||
|
||
FOR MsgNumber := lowest TO highest DO BEGIN
|
||
Write (MsgNumber : 4);
|
||
IF readmsg (MsgNumber, BoardR.MsgPath) THEN
|
||
with MsgHdr DO BEGIN
|
||
Inc (date);
|
||
pointer := FileSize (MsgTxtF) + 1;
|
||
TextSize := 0;
|
||
msgpointer := 0;
|
||
nos := '';
|
||
WHILE (msgpointer < msglength) DO BEGIN
|
||
MsgTxt := nos;
|
||
REPEAT
|
||
Inc (msgpointer);
|
||
c := buffer [msgpointer];
|
||
IF NOT (c in [#0, #10, #13, #141]) THEN
|
||
IF (Length(MsgTxt) < 255) THEN {MsgTxt := MsgTxt + c;}
|
||
BEGIN
|
||
Inc(MsgTxt[0]);
|
||
MsgTxt[Length(MsgTxt)] := c;
|
||
END;
|
||
UNTIL (
|
||
(nos = #13) or (c in [#13,#141])
|
||
or
|
||
((Length(MsgTxt) > 79) AND (POS(#27, MsgTxt) = 0))
|
||
or
|
||
(Length(MsgTxt) = 254)
|
||
or
|
||
(msgpointer >= msglength)
|
||
);
|
||
|
||
IF Length (MsgTxt) = 254 THEN
|
||
MsgTxt := MsgTxt + #29;
|
||
|
||
i := POS('INTL ', MsgTxt);
|
||
IF (i > 0) THEN
|
||
BEGIN
|
||
Inc(i, 6);
|
||
FOR j := 1 TO 8 DO
|
||
BEGIN
|
||
z := '';
|
||
WHILE (MsgTxt[i] in ['0'..'9']) AND (i <= Length(MsgTxt)) DO
|
||
BEGIN
|
||
z := z + MsgTxt[i];
|
||
Inc(i);
|
||
END;
|
||
case j of
|
||
1:MsgHdr.MTO.Zone := Value(z);
|
||
2:MsgHdr.MTO.net := Value(z);
|
||
3:MsgHdr.MTO.node := Value(z);
|
||
4:MsgHdr.MTO.Point := Value(z);
|
||
5:MsgHdr.From.Zone := Value(z);
|
||
6:MsgHdr.From.net := Value(z);
|
||
7:MsgHdr.From.node := Value(z);
|
||
8:MsgHdr.From.Point := Value(z);
|
||
END;
|
||
IF (j = 3) AND (MsgTxt[i] <> '.') THEN
|
||
Inc(j);
|
||
IF (j = 7) AND (MsgTxt[i] <> '.') THEN
|
||
break;
|
||
Inc(i);
|
||
END;
|
||
END;
|
||
|
||
IF (Length (MsgTxt) > 79) THEN
|
||
BEGIN
|
||
i := Length (MsgTxt);
|
||
WHILE (MsgTxt [i] = ' ') AND (i > 1) DO
|
||
Dec (i);
|
||
WHILE (i > 65) AND (MsgTxt [i] <> ' ') DO
|
||
Dec (i);
|
||
|
||
nos[0] := chr(Length(MsgTxt) - i);
|
||
Move(MsgTxt[i + 1], nos[1], Length(MsgTxt) - i);
|
||
MsgTxt[0] := chr(i - 1);
|
||
|
||
END
|
||
ELSE
|
||
nos := '';
|
||
|
||
IF ( (MsgTxt [1] = #1) AND (maskludge in BoardR.maflags) ) or
|
||
( (POS ('SEEN-BY', MsgTxt) > 0) AND (masseenby in BoardR.maflags) ) or
|
||
( (POS ('* Origin:', MsgTxt) > 0) AND (masorigin in BoardR.maflags) ) THEN
|
||
MsgTxt := ''
|
||
ELSE BEGIN
|
||
Inc (MsgHdr.TextSize, Length (MsgTxt) + 1);
|
||
BlockWrite (MsgTxtF, MsgTxt, Length (MsgTxt) + 1);
|
||
END;
|
||
END;
|
||
IF IsNetMail THEN BEGIN
|
||
MsgHdr.status := MsgHdr.status + [netmail];
|
||
MsgHdr.MTO.usernum := SearchUser(MsgHdr.MTO.a1s);
|
||
IF MsgHdr.MTO.usernum = 0 THEN
|
||
MsgHdr.MTO.usernum := 1;
|
||
Seek (uf, MsgHdr.MTO.usernum);
|
||
Read (uf, user);
|
||
Inc (user.waiting);
|
||
Seek (uf, MsgHdr.MTO.usernum);
|
||
Write (uf, user);
|
||
END;
|
||
Write (MsgHdrF, MsgHdr);
|
||
END;
|
||
IF MsgNumber < highest THEN Write (#8#8#8#8);
|
||
i := IOResult;
|
||
END;
|
||
Close (MsgHdrF);
|
||
Close (MsgTxtF);
|
||
IF NOT IsNetMail THEN updatehiwater (BoardR.MsgPath, highest);
|
||
END ELSE Write ('No messages');
|
||
LastError := IOResult;
|
||
END;
|
||
|
||
procedure scan;
|
||
VAR rgmsgnumber : integer;
|
||
highestwritten : integer;
|
||
AnsiOn,
|
||
scanned : boolean;
|
||
BEGIN
|
||
AnsiOn := FALSE;
|
||
scanned := FALSE;
|
||
getmsglst (BoardR.MsgPath);
|
||
MsgNumber := highest;
|
||
IF (NOT ExistDir(BoardR.MsgPath)) THEN
|
||
BEGIN
|
||
WriteLn('WARNING: Cannot access ', BoardR.MsgPath);
|
||
Exit;
|
||
END;
|
||
|
||
Assign (MsgHdrF, MsgPath + BoardR.FileName + '.HDR');
|
||
Reset (MsgHdrF);
|
||
IF IOResult <> 0 THEN Exit;
|
||
|
||
Assign (MsgTxtF, MsgPath + BoardR.FileName + '.DAT');
|
||
Reset (MsgTxtF, 1);
|
||
IF IOResult <> 0 THEN BEGIN Close (MsgHdrF); Exit; END;
|
||
|
||
FOR rgmsgnumber := 1 TO FileSize (MsgHdrF) DO BEGIN
|
||
Seek (MsgHdrF, rgmsgnumber - 1);
|
||
Read (MsgHdrF, MsgHdr);
|
||
IF NOT (Sent in MsgHdr.status) AND (IOResult = 0) AND
|
||
NOT (MDeleted in MsgHdr.status) AND
|
||
NOT (IsNetMail AND NOT (netmail in MsgHdr.status)) AND
|
||
NOT (unvalidated in MsgHdr.status) THEN BEGIN
|
||
scanned := TRUE;
|
||
Inc (MsgNumber);
|
||
Assign (MsgTFile, BoardR.MsgPath + CStr (MsgNumber) + '.MSG');
|
||
ReWrite (MsgTFile, 1);
|
||
Write (rgmsgnumber : 5);
|
||
|
||
MsgHdr.status := MsgHdr.status + [Sent];
|
||
|
||
IF IsNetMail THEN
|
||
MsgHdr.status := MsgHdr.status + [MDeleted];
|
||
|
||
Seek (MsgHdrF, rgmsgnumber - 1);
|
||
Write (MsgHdrF, MsgHdr);
|
||
|
||
IF (marealname in BoardR.maflags) THEN
|
||
s := Caps (MsgHdr.From.real)
|
||
ELSE
|
||
s := Caps (MsgHdr.From.a1s);
|
||
|
||
s := usename(MsgHdr.From.anon, s);
|
||
|
||
FillChar(Header,sizeof(Header),#0);
|
||
|
||
Move(s[1],Header.FromUserName[0],Length(s));
|
||
|
||
IF (marealname in BoardR.maflags) THEN
|
||
s := Caps (MsgHdr.MTO.real)
|
||
ELSE
|
||
s := Caps (MsgHdr.MTO.a1s);
|
||
|
||
s := usename(MsgHdr.MTO.anon, s);
|
||
|
||
Move(s[1],Header.ToUserName[0],Length(s));
|
||
|
||
MsgHdr.Subject := StripColor(MsgHdr.Subject);
|
||
|
||
IF (NOT IsNetMail) AND (MsgHdr.fileattached > 0) THEN
|
||
MsgHdr.Subject := StripName(MsgHdr.Subject);
|
||
|
||
Move(MsgHdr.Subject[1],Header.Subject[0],Length(MsgHdr.Subject));
|
||
|
||
packtodate (dt, MsgHdr.date);
|
||
with dt DO BEGIN
|
||
s := CStr (day);
|
||
IF Length (s) < 2 THEN s := '0' + s;
|
||
s := s + ' ' + Copy ('JanFebMarAprMayJunJulAugSepOctNovDec', (month - 1) * 3 + 1, 3) + ' ';
|
||
s := s + Copy (CStr (year), 3, 2) + ' ';
|
||
nos := CStr (hour);
|
||
IF Length (nos) < 2 THEN nos := '0' + nos;
|
||
s := s + nos + ':';
|
||
nos := CStr (min);
|
||
IF Length (nos) < 2 THEN nos := '0' + nos;
|
||
s := s + nos + ':';
|
||
nos := CStr (sec);
|
||
END;
|
||
IF Length (nos) < 2 THEN nos := '0' + nos;
|
||
s := s + nos;
|
||
|
||
Move(s[1],Header.DateTime[0],Length(s));
|
||
|
||
IF IsNetMail THEN BEGIN
|
||
Header.OrigNet := MsgHdr.From.net;
|
||
Header.OrigNode := MsgHdr.From.node;
|
||
Header.DestNet := MsgHdr.MTO.net;
|
||
Header.DestNode := MsgHdr.MTO.node;
|
||
END ELSE BEGIN
|
||
Header.OrigNet := statusr.aka [BoardR.aka].net;
|
||
Header.OrigNode := statusr.aka [BoardR.aka].node;
|
||
Header.DestNet := 0;
|
||
Header.DestNode := 0;
|
||
END;
|
||
|
||
IF IsNetMail THEN
|
||
Header.Attribute := word(MsgHdr.netattribute)
|
||
{word(statusr.netattribute)}
|
||
ELSE
|
||
IF (prvt in MsgHdr.status) THEN
|
||
Header.Attribute := 257
|
||
ELSE
|
||
Header.Attribute := 256;
|
||
|
||
IF (MsgHdr.fileattached > 0) THEN
|
||
Header.Attribute := Header.Attribute + 16;
|
||
|
||
BlockWrite (MsgTFile, header, sizeof(Header));
|
||
Seek (MsgTxtF, MsgHdr.pointer - 1);
|
||
|
||
IF IsNetMail THEN BEGIN
|
||
s := 'INTL ' + CStr (MsgHdr.MTO.Zone) + ':' + CStr (MsgHdr.MTO.net) + '/' + CStr (MsgHdr.MTO.node);
|
||
s := s + ' ' + CStr (MsgHdr.From.Zone) + ':' + CStr (MsgHdr.From.net) + '/' + CStr (MsgHdr.From.node);
|
||
s := s + #13;
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
IF MsgHdr.MTO.Point > 0 THEN
|
||
BEGIN
|
||
s := #1'TOPT ' + CStr(MsgHdr.MTO.Point);
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
END;
|
||
IF MsgHdr.From.Point > 0 THEN
|
||
BEGIN
|
||
s := #1'FMPT ' + CStr(MsgHdr.From.Point);
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
END;
|
||
|
||
s := ^A'MSGID: ' + CStr (MsgHdr.From.Zone) + ':' + CStr (MsgHdr.From.net) +
|
||
'/' + CStr (MsgHdr.From.node) + ' ' + Hex(Random($FFFF), 4) + Hex(Random($FFFF),4);
|
||
|
||
IF MsgHdr.From.Point > 0 THEN s := s + '.' + CStr (MsgHdr.From.Point);
|
||
s := s + {' '} #13; { *** }
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
{$IFDEF MSDOS}
|
||
s := #1'PID: Renemail ' + ver + #13;
|
||
{$ELSE}
|
||
s := #1'PID: Renemail/2 ' + ver + #13;
|
||
{$ENDIF}
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
END;
|
||
|
||
j := 0;
|
||
IF MsgHdr.TextSize > 0 THEN
|
||
REPEAT
|
||
BlockRead (MsgTxtF, s [0], 1);
|
||
BlockRead (MsgTxtF, s [1], ord (s [0]) );
|
||
Inc (j, Length (s) + 1);
|
||
WHILE POS(#0,s) > 0 DO
|
||
Delete(s,POS(#0,s),1);
|
||
IF s [Length (s) ] = #29 THEN
|
||
Dec(s[0])
|
||
ELSE
|
||
IF POS (#27, s) = 0 THEN
|
||
s := StripColor(s)
|
||
ELSE
|
||
AnsiOn := TRUE;
|
||
s := s + #13;
|
||
BlockWrite (MsgTFile, s [1], Length (s) );
|
||
UNTIL (j >= MsgHdr.TextSize);
|
||
Close (MsgTFile);
|
||
Write (#8#8#8#8#8);
|
||
END;
|
||
highestwritten := MsgNumber;
|
||
END;
|
||
i := IOResult;
|
||
IF NOT IsNetMail THEN updatehiwater (BoardR.MsgPath, highestwritten);
|
||
Close (MsgHdrF);
|
||
Close (MsgTxtF);
|
||
IF NOT scanned THEN Write ('No messages');
|
||
LastError := IOResult;
|
||
END;
|
||
|
||
BEGIN
|
||
Randomize;
|
||
GetDir (0, StartDir);
|
||
FOR x := 1 TO 37 DO
|
||
fcb [x] := ' ';
|
||
fcb [1] := chr (ord (StartDir [1]) - 64);
|
||
fcb [2] := '*';
|
||
fcb [10] := 'M';
|
||
fcb [11] := 'S';
|
||
fcb [12] := 'G';
|
||
FileMode := 66;
|
||
MsgHdr.From.Zone := 0;
|
||
MsgHdr.From.Point := 0;
|
||
ClrScr;
|
||
TextColor (3);
|
||
{$IFDEF MSDOS}
|
||
WriteLn ('Renegade Echomail Interface DOS v' + ver);
|
||
{$ELSE}
|
||
WriteLn ('Renegade Echomail Interface OS/2 v' + ver);
|
||
{$ENDIF}
|
||
WriteLn ('Copyright 2004-2006');
|
||
WriteLn;
|
||
TextColor (10);
|
||
|
||
IF ParamStr (1) = '' THEN
|
||
BEGIN
|
||
WriteLn (' Commands: -T Toss incoming messages');
|
||
WriteLn (' -S Scan outbound messages');
|
||
WriteLn (' -P Purge echomail dirs');
|
||
WriteLn (' Options: -A Absolute scan');
|
||
{$IFDEF MSDOS}
|
||
WriteLn (' -F No fast purge');
|
||
{$ENDIF}
|
||
WriteLn (' -N No Netmail');
|
||
WriteLn (' -D Do not delete Netmail');
|
||
{$IFDEF MSDOS}
|
||
WriteLn (' -B Bios video output');
|
||
{$ENDIF}
|
||
WriteLn (' -O Only Netmail');
|
||
WriteLn (' -I Import 1.MSG');
|
||
WriteLn;
|
||
halt;
|
||
END;
|
||
FOR i := 1 TO paramcount DO
|
||
IF POS ('-N', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
process_netmail := FALSE
|
||
ELSE
|
||
IF POS ('-F', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
fastpurge := FALSE
|
||
ELSE
|
||
IF POS ('-D', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
purge_netmail := FALSE
|
||
ELSE
|
||
{$IFDEF MSDOS}
|
||
IF POS ('-B', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
directvideo := FALSE
|
||
ELSE
|
||
{$ENDIF}
|
||
IF POS ('-O', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
netmailonly := TRUE
|
||
ELSE
|
||
IF POS ('-A', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
absolute_scan := TRUE
|
||
ELSE
|
||
IF POS ('-I', AllCaps (ParamStr (i) ) ) > 0 THEN
|
||
ignore_1msg := FALSE;
|
||
(* 09-16-96 Changed to allow processing of 1.msg
|
||
*)
|
||
Board := 0;
|
||
getpaths;
|
||
|
||
IF process_netmail THEN
|
||
BEGIN
|
||
BoardR.MsgPath := netmailpath;
|
||
BoardR.FileName := 'EMAIL';
|
||
BoardR.maflags := [maskludge];
|
||
Assign (uf, datapath + 'users.dat');
|
||
Reset (uf);
|
||
IF IOResult <> 0 THEN
|
||
aborterror('Cannot find users.dat in your DATA directory');
|
||
Assign (sf, datapath + 'users.idx');
|
||
Reset (sf);
|
||
IF IOResult <> 0 THEN
|
||
aborterror('Cannot find users.idx in your DATA directory');
|
||
|
||
IsNetMail := TRUE;
|
||
TextColor (3);
|
||
Write ('Processing: ');
|
||
TextColor (14);
|
||
Write (' NETMAIL - ');
|
||
TextColor (11);
|
||
IF POS ('-T', AllCaps (ParamStr (1) ) ) > 0 THEN
|
||
toss;
|
||
IF POS ('-S', AllCaps (ParamStr (1) ) ) > 0 THEN
|
||
scan;
|
||
Close (uf);
|
||
Close (sf);
|
||
LastError := IOResult;
|
||
WriteLn;
|
||
IsNetMail := FALSE;
|
||
END;
|
||
|
||
IF netmailonly THEN halt;
|
||
|
||
WHILE Board <> 32767 DO BEGIN
|
||
nextboard(POS('-S', AllCaps(ParamStr(1))) > 0);
|
||
IF Board <> 32767 THEN BEGIN
|
||
TextColor (3);
|
||
Write ('Processing: ');
|
||
TextColor (14);
|
||
Write (BoardR.FileName : 8, ' - ');
|
||
TextColor (11);
|
||
IF POS ('-P', AllCaps (ParamStr (1) ) ) > 0 THEN PurgeDir (BoardR.MsgPath)
|
||
ELSE IF POS ('-T', AllCaps (ParamStr (1) ) ) > 0 THEN toss
|
||
ELSE IF POS ('-S', AllCaps (ParamStr (1) ) ) > 0 THEN scan;
|
||
WriteLn;
|
||
END ELSE Close (boardf)
|
||
END;
|
||
ChDir (StartDir);
|
||
END.
|