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.
|