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

    {
    >Could someone post the structures For a QWK mail packet, and could
    >someone, post how to make a BBS Fido-Net compatible, in other Words the
    >File structures..Thanks in advance..
    }

    {$V-}

    Program ReadQWKRepFile;

    Uses
      Crt;

    Const
      Seperator = '---------------------------------------------------------------------------';

    Type
      ConfType = ^Conference;
      Conference = Record
        Number : Byte;
        Name   : Array [1..10] of Char;
      end;
      CONDATHdr = Record
        BBSName  : Array [1..25] of Char;
        Location : Array [1..25] of Char;
        Number   : Array [1..12] of Char;
        SysopName: Array [1..25] of Char;
        SerialNum: Array [1..5] of Char;
        BBSID    : Array [1..8] of Char;
        Date     : Array [1..10] of Char;
        Time     : Array [1..8] of Char;
        UserName : Array [1..25] of Char;
        NumConfs : Byte;
        Confs    : Array [1..30] of ConfType;
      end;
      MSGDATHdr = Record
        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;
        Alive    : Byte;
        LeastSig : Byte;
        MostSig  : Byte;
        Reserved : Array [1..3] of Char;
      end;
      MSSingle = Array[0..3] of Byte;

    Var
      F           : File;
      DefSaveFile : String;
      ConfNum     : String [8];
      Number      : Word;

    Function Valu2 (S : String) : Word;
    Var
      C  : Word;
      E  : Integer;
    begin
      Val (S, C, E);
      If E = 0 then
        Valu2 := C
      else
        Valu2 := 0;
    end;

    Procedure ParseCommandLine;
    Var
      I : Byte;
      C : Char;
      S : String;
    begin
      For I := 1 to ParamCount do
      begin
        S := ParamStr (I);
        If S [1] = '/' then
        begin
          C := UpCase (S [2]);
          Delete (S, 1, 2);
          Case C of
            'C' : ConfNum := S;
            'S' :
                  begin
                    While Length (S) <> 3 do
                      S := '0' + S;
                    DefSaveFile := S;
                  end;

            'N' : Number := Valu2 (S);
          end;
        end;
      end;
    end;

    Function MStoIEEE (MS : MSSingle) : Real;
    { Converts a 4 Byte Microsoft format single precision Real Variable as
      used in earlier versions of QuickBASIC and GW-BASIC to IEEE 6 Byte Real }
    Var
      r      : Real;
      ieee   : Array[0..5] of Byte Absolute r;
    begin
      FillChar(r,sizeof(r),0);
      ieee[0] := MS[3];
      ieee[3] := MS[0];
      ieee[4] := MS[1];
      ieee[5] := MS[2];
      MStoIEEE  := r;
    end;  { MStoIEEE }

    Function Valu (S : String) : LongInt;
    Var
      C     : LongInt;
      T, E  : Integer;
      I     : Byte;
      Place : LongInt;
    begin
      Place := 1;
      C := 0;
      For I := 6 downto 1 do
      begin
        Val (S [I], T, E);
        If T <> 0 then
        begin
          C := C + T * Place;
          Place := Place * 10;
        end;
      end;
      Valu := C - 1;
    end;

    Procedure ReadMSG (NumChunks : LongInt);
    Var
      Buff : Array [1..128] of Char;
      J    : LongInt;
      I    : Byte;

    begin
      For J := 1 to NumChunks do
      begin
        BlockRead (F, Buff, 128);
        For I := 1 to 128 do
          If Buff [I] = #$E3 then
            Writeln
          else
            Write (Buff [I]);
      end;
    end;

    Procedure ReadWriteHdr (Var HDR : MSGDatHdr);
    begin
      BlockRead (F, Hdr, SizeOf (Hdr));
      With Hdr do
      begin
        Write ('Date: ', Date, ' (', Time, ')');
        Writeln ('' : 23, 'Number: ', MSGNum);
        Write ('From: ', UpFROM);
        Writeln ('' : 14, 'Refer#: ', ReferNum);
        Write ('  To: ', UpTO);
        Write ('' : 15, 'Recvd: ');
        If Status in ['-', '`', '^', '#'] then
          Writeln ('YES')
        else
          Writeln ('NO');
        Write ('Subj: ', Subject);
        Writeln ('' : 16, 'Conf: ', '(', LeastSig, ')');
        Writeln;
      end;
    end;

    Procedure ReadMessage (HDR : MSGDatHdr; REPorDAT : Boolean);
    begin
      ReadWriteHdr (HDR);
      ReadMsg (Valu (HDR.NumChunk));
    end;

    Procedure ReadControlFile (Var Control : CONDatHdr);
    Var
      CFile    : Text;

      Procedure ReadToEOLN (Var FNAME; Length : Byte; Down : Boolean);
      Var
        I : Byte;
        C : Char;
      begin
        I := 0;
        Repeat
          Read (CFile, C);
          Mem [Seg (FNAME) : Ofs (FNAME) + I] := Ord (C);
          Inc (I);
        Until EOLN (CFile) or (I > Length) or (Not Down and (C = ','));
        If Not Down then
          Dec (I);
        For I := I to Length do
          Mem [Seg (FNAME) : Ofs (FNAME) + I] :=32;
        If Down then
          Readln (CFile);
      end;

    Var
      TempChar : Char;
      S        : String;
      I        : Byte;
    begin
      Assign (CFile, 'CONTROL.DAT');
      Reset (CFile);
      With Control do
      begin
        ReadToEOLN (BBSName, 25, True);
        ReadToEOLN (Location, 25, True);
        ReadToEOLN (Number, 12, True);
        ReadToEOLN (SysopName, 25, False);
        Readln (CFile);
        ReadToEOLN (SerialNum, 5, False);
        ReadToEOLN (BBSID, 8, True);
        ReadToEOLN (Date, 10, False);
        ReadToEOLN (Time, 8, True);
        ReadToEOLN (UserName, 25, True);
        For I := 1 to 4 do
          Readln (CFile, S);
        NumConfs := Valu (S) + 1;
        For I := 1 to NumConfs do
        begin
          New (Confs [I]);
          Readln (CFile, S);
          Confs [I]^.Number := Valu2 (S);
          ReadToEOLN (Confs [I]^.Name, 10, True);
        end;
      end;
      Close (CFile);
    end;

    Function GetSaveFile : String;
    Var
      S : String;
    begin
      Writeln ('Enter the name of the File to save it in (GIVE A DIRECTORY!) or [Return] for');
      Writeln ('C:\SLMR\SAVE.TXT');
      Readln (S);
      If S = '' then
        S := 'C:\SLMR\SAVE.TXT';
      GetSaveFile := S;
    end;

    Function GetYN (S : String) : Boolean;
    Var
      X  : Char;
    begin
      Repeat
        Write (S);
        X := UpCase (ReadKey);
        Writeln (X);
      Until X in ['Y', 'N'];
      GetYN := X = 'Y';
    end;

    Procedure ScanMessages (REPorDAT : Boolean);
    Var
        HDR : MSGDatHdr;
        S  : String [3];
        I  : Byte;
        F2 : File;
        MS : MSSingle;
        YN  : Boolean;
    begin
      ClrScr;
      Repeat
        If ConfNum = '' then
        begin
          Writeln;
          Write ('Enter the name/number For the conference : ');
          Readln (ConfNum);
          Writeln;
        end;
        While (Length (ConfNum) < 3) do
          ConfNum := '0' + ConfNum;
        Writeln (ConfNum);
        Assign (F2, ConfNum + '.NDX');
        {$I-}
        Reset (F2, 1);
        {$I+}
        If IOResult <> 0 then
          RunError (2);

        Repeat
          Repeat

            Writeln;
            If Number = 0 then
            begin
              Writeln ('Enter the SLMR number ( ??? / XXX ) of the message to pull, or 0 to quit : ');
              Readln (Number);
            end;
            If Number = 0 then
            begin
              Close (F2);
              Close (F);
              Halt;
            end;

            Writeln;
            Seek (F2, (Number - 1) * 5);
            BlockRead (F2, MS, 4);

            Seek (F, Round (MStoIEEE (MS) - 1) * 128);
            ReadWriteHdr (HDR);

            YN := GetYN ('Capture this message ? ');
            Number := 0;

          Until YN;

          Seek (F, Round (MStoIEEE (MS) - 1) * 128);
          Writeln;
          Writeln;
          If Not GetYN ('Extract to Screen ? [Y/N] (N sends to File): ') then
            Assign (Output, GetSaveFile);
          {$I-}
          Reset (Output);
          {$I+}
          If IOResult <> 0 then
            ReWrite (Output)
          else
            Append (Output);
          Writeln;
          Writeln (Seperator);
          Writeln;
          ReadMessage (Hdr, REPorDAT);
          Writeln;
          Writeln;
          Close (Output);
          Assign (Output, '');
          ReWrite (Output);
          YN := GetYN ('Extract more messages? [Y/N] ');
        Until Not YN;

        Close (F2);
        YN := GetYN ('Select another message base? [Y/N] ');
      Until Not YN;
    end;

    Var
      Control  : CONDatHdr;
      MSGHdr   : MSGDatHdr;
      REPorDAT : Boolean;

    begin
      DefSaveFile := '';
      ConfNum := '';
      Number := 0;
      ParseCommandLine;
      DirectVideo := False;
      ReadControlFile (Control);
      { Assign (F, Control.BBSID + '.MSG');}
      Assign (F, 'MESSAGES.DAT');
      Reset (F, 1);
      BlockRead (F, MSGHdr, SizeOf (MSGHdr));
      REPorDAT := (MSGHdr.Status + MSGHdr.MSGNum = Control.BBSID);
      ScanMessages (REPorDAT);
      { While Not EOF (F) do ReadMessage (MSGHdr, REPorDAT);}
      Close (F);
    end.

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