Contributor: MARTIN WOODS
{
WK> I was wondering if anyone has either the layout for a *.MSG
WK> packet or knows of a unit to generate and process *.MSG packets.
}
unit fidomsg; { See 2 demo programs attached below !! }
Interface
uses dos;
const
MsgSize = 32768;
type
AddressType = record
Zone : Byte;
Net : Word;
Node : Word;
Point : Word;
Domain: String[15];
end;
TxtPtrType = ^TxtRecType;
TxtRecType = array[1..MsgSize] of char;
String36 = string[36];
String72 = string[72];
String20 = string[20];
FMsgType = record
FromUserName : String36;
ToUserName : String36;
Subject : String72;
DateTime : String20;
Origin : AddressType;
Destination : AddressType;
NextReply : word;
MsgTxtPtr : TxtPtrType;
end;
procedure LoadMsg(var Msg: FMsgType; MsgFilePath : PathStr; var Result: byte);
procedure GetMsgHeap (var Msg: FMsgType);
procedure DisposeMsgHeap(var Msg: FMsgType);
Implementation
procedure GetMsgHeap(var Msg: FMsgType);
begin
New(Msg.MsgTxtPtr);
end;
procedure DisposeMsgHeap(var Msg: FMsgType);
begin
Dispose(Msg.MsgTxtPtr);
end;
procedure LoadMsg(var Msg: FMsgType; MsgFilePath : PathStr; var Result: byte);
type
MsgHeaderType = record
HFromUserName : array[1..36] of char;
HToUserName : array[1..36] of char;
HSubject : array[1..72] of char;
HDateTime : array[1..20] of char;
HTimesRead : word;
HDestNode : word;
HOrigNode : word;
HCost : word;
HOrigNet : word;
HDestNet : word;
HFiller : array[1..8] of char;
HReplyto : word;
HAttribute : word;
HNextReply : word;
end;
var
i : word;
ReadResult : word;
MsgFile : file;
MsgHead : MsgHeaderType;
begin
assign(MsgFile,MsgFilePath);
{$I-}
reset(MsgFile,1);
{$I+}
Result := IoResult;
if result>0 then exit;
fillchar(MsgHead,SizeOf(MsgHead),#00);
fillchar(Msg.MsgTxtPtr^,MsgSize,#00);
BlockRead(MsgFile,MsgHead,Sizeof(MsgHead)); {Read Header Info}
BlockRead(MsgFile,Msg.MsgTxtPtr^,MsgSize,ReadResult); {Read Msg Text}
If ReadResult = MsgSize then
begin
result := 255; {Msg> MsgSize}
exit;
end;
with Msg, MsgHead do
begin
for i := 1 to 36 do
begin
if HFromUserName[i] = #00 then
begin;
FromUserName[0] := chr(i-1);
i := 36;
end;
FromUserName[i] := HFromUserName[i];
end;
for i := 1 to 36 do
begin
if HToUserName[i] = #00 then
begin
ToUserName[0] := chr(i-1);
i := 36;
end;
ToUserName[i] := HToUserName[i];
end;
for i := 1 to 72 do
begin
if HSubject[i] = #00 then
begin
Subject[0] := chr(i-1);
i := 72;
end;
Subject[i] := HSubject[i];
end;
for i := 1 to 20 do
begin
if HDateTime[i] = #00 then
begin
DateTime[0] := chr(i-1);
i := 20;
end;
DateTime[i] := HDateTime[i];
end;
Destination.Zone := 1;
Destination.Node := HDestNode;
Destination.Net := HDestNet;
Destination.Point := 0;
Origin.Zone := 1;
Origin.Node := HOrigNode;
Origin.Net := HOrigNet;
Origin.Point := 0;
NextReply := HNextReply;
end;
close(MsgFile);
end;
end.
{ -------------------- DEMO PROGRAM --------------------- }
program DELMSGBY; { A program to kill all FIDOnet messages by a
certain person }
{$M 16384,0,65536}
uses dos,fidomsg;
var foo :byte;
nametodel:string;
msg :FMsgType;
s :searchrec;
function upstr(st:string):string; { string processor that }
var a:string; { makes all uppercase and }
begin { removes spaces }
a:='';
for foo:=1 to length(st) do
begin
If st[foo]#32 then a:=a+upcase(st[foo]);
end;
upstr:=a;
end;
begin
if paramcount<1 then { If they don't know how to use this, then } begin writeln; writeln(' Usage: DELMSGBY [firstname] [lastname]'); { Tell them } writeln; end else { Otherwise, they DO know how to use this, so } begin nametodel:=''; for foo:=1 to paramcount do { Get the name they don't like} nametodel:=nametodel+' '+paramstr(foo); findfirst('*.MSG',Anyfile,s); { And search all .MSG files for it} while (DosError=0) do { If a file is found then} begin GetMsgHeap(msg); { Make space on the heap for it} loadmsg(msg,fexpand(s.name),foo); { Load it } If (upstr(msg.FromUserName)=upstr(nametodel)) then begin { If the message if from the bad guy} swapvectors; { then delete it. I used EXEC so} exec(getenv('COMSPEC'),' /C '+'Del '+fexpand(s.name)); { you can} swapvectors; { easily move, or rename it.} writeln('Deleting '+fexpand(s.name)+'. It''s Contaminated!'); end; DisposeMsgHeap(msg); { Done w/ that message, so take back} findnext(s); { the heap space. Then find another} end; { Message to check. } end; end. { --------------------------- DEMO PROGRAM ----------------------------} {this is a stand alone *.msg reader} uses dos,crt; Type FidoHeader=record {structure of the Message Header} WhoTheMessageIsFrom, WhoTheMessageItTo : Array[1..36] of Char; {ASCIIZ Strings} MessageSubject : Array[1..72] of Char; MessageDate : Array[1..20] of Char; {The Message Date is an ASCIIZ string following this format: DD MMM YY HH:MM:SS-20 Characters Total
Example: 01 Jun 94 20:00:00 is June 1st 1994 at 8:00PM
But SeaDog uses a slightly different version and you
might want to account for that, unfortunately I can't
remember the exact format, also SLMAIL for SearchLight
BBS only puts one space between the year and the hour
even though it's supposed to be 2, I'm surprised this
hasn't thrown mailers of other BBS programs}
TimesTheMessageWasRead,
DestinationNode,
OriginalNode,
CostofTheMessage,
OriginalNet,
DestinationNet : Integer;
{Note: TimesTheMessageWasRead & CostofTheMessage are
usually ignored when being exported from the BBS and can
be ignored when importing into a BBS}
DateWritten,
DateArrived : LongInt;
{I'm not sure how the dates are stored in here, but
they're usually ignored}
MessageToWhichThisRepliesTo: Integer;{Irrevelant over a network}
Arrtibutes : Word;
{Bit Field:
Bit 0 Private Message
1 Crashmail
2 Message Was Read
3 Message Was Sent
4 File Attatched, Filename in subject
5 Forwarded Message
6 Orphan Message ???
7 Kill After Its Sent (I think)
8 Message Originated Here (local)
9 Hold
10 Reserved
11 File Request, Filenames in Subject
12 Return Receipt Requested
13 This message is a Return Receipt
14 Audit Trail Requested
15 Update Request }
UnReply : Integer; {I have No Idea}
End;
Type FidoMsg=record
msgchar : char;
end;
{The Message Text follows terminated by either a Null (#0) or to Cr's #13#13.
Also all paragraphs are supposed to end with a Hard CR (#141) and you can
ignoreany #13 and reformat the text for your own program, also any lines
starting with^A (#1) should not be imported into the BBS, they are control
lines... thecontents of these lines varies so you'll have to find out that on
your own }
var
header : fidoheader;
headerf: file of fidoheader;
MsgTxt : FidoMsg;
MsgTxtf: file of FidoMsg;
DirInfo: SearchRec;
ch,cx : char;
cr,count : shortint;
i:byte;
l : string;
s : string;
howlong : byte;
begin
FindFirst('*.MSG', Archive, DirInfo);
while DosError = 0 do
begin
window(1,1,80,25);
clrscr;
textcolor(lightgreen);
WriteLn(DirInfo.Name);
textcolor(green);
assign(headerf,DirInfo.Name);
reset(headerf);
read(headerf,header);
with header do
begin
Writeln('From: ',WhoTheMessageIsFrom);
Writeln('To : ',WhoTheMessageItTo);
Writeln('Subj: ',MessageSubject);
Writeln('Date: ',MessageDate);
end;
textcolor(white);
Writeln('ヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘヘ
ヘ ヘヘヘヘヘヘ'); window(1,wherey,80,25);
textcolor(cyan);
close(headerf);
assign(MsgTxtF,DirInfo.Name);
reset(MsgTxtF);
seek(MsgTxtF,sizeof(header));
cr := 0;
count := 0;
l := '';
repeat
read(MsgTxtF,MsgTxt);
ch := MsgTxt.msgchar;
if not (ch in [#10,#13]) then
begin
l := l + ch;
howlong := length(l);
end;
if keypressed then
begin
cx := readkey;
if cx = #27 then halt;
end;
if length(l)> 78 then
begin
count := length(l);
while (count> 60) and (l[count] ' ') do dec(count);
writeln(l,copy(l,1,count));
delete(l,count,length(l));
end;
if ch = #13 then
begin
writeln(l);
l := '';
howlong := 0;
end;
if pos('these things?',l)> 0 then
begin
write
end;
if wherey> 15 then
begin
textcolor(12);
writeln;
write('Press enter: ');
readln;
clrscr;
textcolor(cyan);
end;
until eof(MsgTxtF) or (ioresult> 0);
if l> '' then
begin
writeln(l);
l := '';
end;
textcolor(11);
write('End of Msg: ');
textcolor(7);
cx := readkey;
if cx = #27 then halt;
clrscr;
FindNext(DirInfo);
end;
textcolor(7);
end.
end.