home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / mail.swg / 0002_MSG-FIDO.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  8.1 KB  |  371 lines
  1. {
  2. >Could someone post the structures For a QWK mail packet, and could
  3. >someone, post how to make a BBS Fido-Net compatible, in other Words the
  4. >File structures..Thanks in advance..
  5. }
  6.  
  7. {$V-}
  8.  
  9. Program ReadQWKRepFile;
  10.  
  11. Uses
  12.   Crt;
  13.  
  14. Const
  15.   Seperator = '---------------------------------------------------------------------------';
  16.  
  17. Type
  18.   ConfType = ^Conference;
  19.   Conference = Record
  20.     Number : Byte;
  21.     Name   : Array [1..10] of Char;
  22.   end;
  23.   CONDATHdr = Record
  24.     BBSName  : Array [1..25] of Char;
  25.     Location : Array [1..25] of Char;
  26.     Number   : Array [1..12] of Char;
  27.     SysopName: Array [1..25] of Char;
  28.     SerialNum: Array [1..5] of Char;
  29.     BBSID    : Array [1..8] of Char;
  30.     Date     : Array [1..10] of Char;
  31.     Time     : Array [1..8] of Char;
  32.     UserName : Array [1..25] of Char;
  33.     NumConfs : Byte;
  34.     Confs    : Array [1..30] of ConfType;
  35.   end;
  36.   MSGDATHdr = Record
  37.     Status   : Char;
  38.     MSGNum   : Array [1..7] of Char;
  39.     Date     : Array [1..8] of Char;
  40.     Time     : Array [1..5] of Char;
  41.     UpTO     : Array [1..25] of Char;
  42.     UpFROM   : Array [1..25] of Char;
  43.     Subject  : Array [1..25] of Char;
  44.     PassWord : Array [1..12] of Char;
  45.     ReferNum : Array [1..8] of Char;
  46.     NumChunk : Array [1..6] of Char;
  47.     Alive    : Byte;
  48.     LeastSig : Byte;
  49.     MostSig  : Byte;
  50.     Reserved : Array [1..3] of Char;
  51.   end;
  52.   MSSingle = Array[0..3] of Byte;
  53.  
  54. Var
  55.   F           : File;
  56.   DefSaveFile : String;
  57.   ConfNum     : String [8];
  58.   Number      : Word;
  59.  
  60.  
  61.  
  62. Function Valu2 (S : String) : Word;
  63. Var
  64.   C  : Word;
  65.   E  : Integer;
  66. begin
  67.   Val (S, C, E);
  68.   If E = 0 then
  69.     Valu2 := C
  70.   else
  71.     Valu2 := 0;
  72. end;
  73.  
  74. Procedure ParseCommandLine;
  75. Var
  76.   I : Byte;
  77.   C : Char;
  78.   S : String;
  79. begin
  80.   For I := 1 to ParamCount do
  81.   begin
  82.     S := ParamStr (I);
  83.     If S [1] = '/' then
  84.     begin
  85.       C := UpCase (S [2]);
  86.       Delete (S, 1, 2);
  87.       Case C of
  88.         'C' : ConfNum := S;
  89.         'S' :
  90.               begin
  91.                 While Length (S) <> 3 do
  92.                   S := '0' + S;
  93.                 DefSaveFile := S;
  94.               end;
  95.  
  96.         'N' : Number := Valu2 (S);
  97.       end;
  98.     end;
  99.   end;
  100. end;
  101.  
  102.  
  103. Function MStoIEEE (MS : MSSingle) : Real;
  104. { Converts a 4 Byte Microsoft format single precision Real Variable as
  105.   used in earlier versions of QuickBASIC and GW-BASIC to IEEE 6 Byte Real }
  106. Var
  107.   r      : Real;
  108.   ieee   : Array[0..5] of Byte Absolute r;
  109. begin
  110.   FillChar(r,sizeof(r),0);
  111.   ieee[0] := MS[3];
  112.   ieee[3] := MS[0];
  113.   ieee[4] := MS[1];
  114.   ieee[5] := MS[2];
  115.   MStoIEEE  := r;
  116. end;  { MStoIEEE }
  117.  
  118. Function Valu (S : String) : LongInt;
  119. Var
  120.   C     : LongInt;
  121.   T, E  : Integer;
  122.   I     : Byte;
  123.   Place : LongInt;
  124. begin
  125.   Place := 1;
  126.   C := 0;
  127.   For I := 6 downto 1 do
  128.   begin
  129.     Val (S [I], T, E);
  130.     If T <> 0 then
  131.     begin
  132.       C := C + T * Place;
  133.       Place := Place * 10;
  134.     end;
  135.   end;
  136.   Valu := C - 1;
  137. end;
  138.  
  139. Procedure ReadMSG (NumChunks : LongInt);
  140. Var
  141.   Buff : Array [1..128] of Char;
  142.   J    : LongInt;
  143.   I    : Byte;
  144.  
  145. begin
  146.   For J := 1 to NumChunks do
  147.   begin
  148.     BlockRead (F, Buff, 128);
  149.     For I := 1 to 128 do
  150.       If Buff [I] = #$E3 then
  151.         Writeln
  152.       else
  153.         Write (Buff [I]);
  154.   end;
  155. end;
  156.  
  157. Procedure ReadWriteHdr (Var HDR : MSGDatHdr);
  158. begin
  159.   BlockRead (F, Hdr, SizeOf (Hdr));
  160.   With Hdr do
  161.   begin
  162.     Write ('Date: ', Date, ' (', Time, ')');
  163.     Writeln ('' : 23, 'Number: ', MSGNum);
  164.     Write ('From: ', UpFROM);
  165.     Writeln ('' : 14, 'Refer#: ', ReferNum);
  166.     Write ('  To: ', UpTO);
  167.     Write ('' : 15, 'Recvd: ');
  168.     If Status in ['-', '`', '^', '#'] then
  169.       Writeln ('YES')
  170.     else
  171.       Writeln ('NO');
  172.     Write ('Subj: ', Subject);
  173.     Writeln ('' : 16, 'Conf: ', '(', LeastSig, ')');
  174.     Writeln;
  175.   end;
  176. end;
  177.  
  178. Procedure ReadMessage (HDR : MSGDatHdr; REPorDAT : Boolean);
  179. begin
  180.   ReadWriteHdr (HDR);
  181.   ReadMsg (Valu (HDR.NumChunk));
  182. end;
  183.  
  184. Procedure ReadControlFile (Var Control : CONDatHdr);
  185. Var
  186.   CFile    : Text;
  187.  
  188.   Procedure ReadToEOLN (Var FNAME; Length : Byte; Down : Boolean);
  189.   Var
  190.     I : Byte;
  191.     C : Char;
  192.   begin
  193.     I := 0;
  194.     Repeat
  195.       Read (CFile, C);
  196.       Mem [Seg (FNAME) : Ofs (FNAME) + I] := Ord (C);
  197.       Inc (I);
  198.     Until EOLN (CFile) or (I > Length) or (Not Down and (C = ','));
  199.     If Not Down then
  200.       Dec (I);
  201.     For I := I to Length do
  202.       Mem [Seg (FNAME) : Ofs (FNAME) + I] :=32;
  203.     If Down then
  204.       Readln (CFile);
  205.   end;
  206.  
  207. Var
  208.   TempChar : Char;
  209.   S        : String;
  210.   I        : Byte;
  211. begin
  212.   Assign (CFile, 'CONTROL.DAT');
  213.   Reset (CFile);
  214.   With Control do
  215.   begin
  216.     ReadToEOLN (BBSName, 25, True);
  217.     ReadToEOLN (Location, 25, True);
  218.     ReadToEOLN (Number, 12, True);
  219.     ReadToEOLN (SysopName, 25, False);
  220.     Readln (CFile);
  221.     ReadToEOLN (SerialNum, 5, False);
  222.     ReadToEOLN (BBSID, 8, True);
  223.     ReadToEOLN (Date, 10, False);
  224.     ReadToEOLN (Time, 8, True);
  225.     ReadToEOLN (UserName, 25, True);
  226.     For I := 1 to 4 do
  227.       Readln (CFile, S);
  228.     NumConfs := Valu (S) + 1;
  229.     For I := 1 to NumConfs do
  230.     begin
  231.       New (Confs [I]);
  232.       Readln (CFile, S);
  233.       Confs [I]^.Number := Valu2 (S);
  234.       ReadToEOLN (Confs [I]^.Name, 10, True);
  235.     end;
  236.   end;
  237.   Close (CFile);
  238. end;
  239.  
  240. Function GetSaveFile : String;
  241. Var
  242.   S : String;
  243. begin
  244.   Writeln ('Enter the name of the File to save it in (GIVE A DIRECTORY!) or [Return] for');
  245.   Writeln ('C:\SLMR\SAVE.TXT');
  246.   Readln (S);
  247.   If S = '' then
  248.     S := 'C:\SLMR\SAVE.TXT';
  249.   GetSaveFile := S;
  250. end;
  251.  
  252. Function GetYN (S : String) : Boolean;
  253. Var
  254.   X  : Char;
  255. begin
  256.   Repeat
  257.     Write (S);
  258.     X := UpCase (ReadKey);
  259.     Writeln (X);
  260.   Until X in ['Y', 'N'];
  261.   GetYN := X = 'Y';
  262. end;
  263.  
  264. Procedure ScanMessages (REPorDAT : Boolean);
  265. Var
  266.     HDR : MSGDatHdr;
  267.     S  : String [3];
  268.     I  : Byte;
  269.     F2 : File;
  270.     MS : MSSingle;
  271.     YN  : Boolean;
  272. begin
  273.   ClrScr;
  274.   Repeat
  275.     If ConfNum = '' then
  276.     begin
  277.       Writeln;
  278.       Write ('Enter the name/number For the conference : ');
  279.       Readln (ConfNum);
  280.       Writeln;
  281.     end;
  282.     While (Length (ConfNum) < 3) do
  283.       ConfNum := '0' + ConfNum;
  284.     Writeln (ConfNum);
  285.     Assign (F2, ConfNum + '.NDX');
  286.     {$I-}
  287.     Reset (F2, 1);
  288.     {$I+}
  289.     If IOResult <> 0 then
  290.       RunError (2);
  291.  
  292.     Repeat
  293.       Repeat
  294.  
  295.         Writeln;
  296.         If Number = 0 then
  297.         begin
  298.           Writeln ('Enter the SLMR number ( ??? / XXX ) of the message to pull, or 0 to quit : ');
  299.           Readln (Number);
  300.         end;
  301.         If Number = 0 then
  302.         begin
  303.           Close (F2);
  304.           Close (F);
  305.           Halt;
  306.         end;
  307.  
  308.         Writeln;
  309.         Seek (F2, (Number - 1) * 5);
  310.         BlockRead (F2, MS, 4);
  311.  
  312.         Seek (F, Round (MStoIEEE (MS) - 1) * 128);
  313.         ReadWriteHdr (HDR);
  314.  
  315.         YN := GetYN ('Capture this message ? ');
  316.         Number := 0;
  317.  
  318.       Until YN;
  319.  
  320.       Seek (F, Round (MStoIEEE (MS) - 1) * 128);
  321.       Writeln;
  322.       Writeln;
  323.       If Not GetYN ('Extract to Screen ? [Y/N] (N sends to File): ') then
  324.         Assign (Output, GetSaveFile);
  325.       {$I-}
  326.       Reset (Output);
  327.       {$I+}
  328.       If IOResult <> 0 then
  329.         ReWrite (Output)
  330.       else
  331.         Append (Output);
  332.       Writeln;
  333.       Writeln (Seperator);
  334.       Writeln;
  335.       ReadMessage (Hdr, REPorDAT);
  336.       Writeln;
  337.       Writeln;
  338.       Close (Output);
  339.       Assign (Output, '');
  340.       ReWrite (Output);
  341.       YN := GetYN ('Extract more messages? [Y/N] ');
  342.     Until Not YN;
  343.  
  344.     Close (F2);
  345.     YN := GetYN ('Select another message base? [Y/N] ');
  346.   Until Not YN;
  347. end;
  348.  
  349.  
  350. Var
  351.   Control  : CONDatHdr;
  352.   MSGHdr   : MSGDatHdr;
  353.   REPorDAT : Boolean;
  354.  
  355. begin
  356.   DefSaveFile := '';
  357.   ConfNum := '';
  358.   Number := 0;
  359.   ParseCommandLine;
  360.   DirectVideo := False;
  361.   ReadControlFile (Control);
  362.   { Assign (F, Control.BBSID + '.MSG');}
  363.   Assign (F, 'MESSAGES.DAT');
  364.   Reset (F, 1);
  365.   BlockRead (F, MSGHdr, SizeOf (MSGHdr));
  366.   REPorDAT := (MSGHdr.Status + MSGHdr.MSGNum = Control.BBSID);
  367.   ScanMessages (REPorDAT);
  368.   { While Not EOF (F) do ReadMessage (MSGHdr, REPorDAT);}
  369.   Close (F);
  370. end.
  371.