[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]

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

[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]