[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]