Contributor: GAYLE DAVIS
{$V-,S-,I-}
{$M 16384,0,355360} { leave some memory for PKZIP !!! }
{ By POPULAR Request .................
this SIMPLE program let's you read SWAG files and CONVERT them to QWK
format readable by many of the popular MAIL readers out there. I
tested it with OLX by MUSTANG. It should would with the others as well.
WARNING ... Many QWK mail readers are limited in the amount of text
that can be contained in one message. SEVERAL of the SWAG files exceed
what can be read !! Therefore, you will NOT be able to read all of these.
Your mail reader program will truncate them. This was an interesting
exercise anyway, and shows how QWK mail packets can be created.
Gayle Davis
November, 1993 }
USES
Dos, Crt;
CONST
ControlHdr : ARRAY [1..11] OF STRING [30] = (
{1} 'SOURCEWARE ARCHIVAL GROUP',
{2} 'Goshen',
{3} '875-8133',
{4} 'Gayle Davis',
{5} '99999,SWAG',
{6} '11-03-1993,04:41:37',
{7} 'SWAG Genius',
{8} '', { QMAIL Menu name ??? }
{9} '0', { allways ZERO ??? }
{10} '0', { total number of messages in package }
{11} '56'); { number of conferences-1 here }
{ next is 0 , then first conference }
TYPE
BlockArray = ARRAY [1..128] OF CHAR;
CharArray = ARRAY [1..6] OF CHAR; { to read in chunks }
ControlArray = ARRAY [1..200] OF STRING [20];
bsingle = array [0..4] of byte;
MSGDATHdr = RECORD { ALSO the format for SWAG files !!! }
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 : CharArray;
Alive : BYTE;
LeastSig : BYTE;
MostSig : BYTE;
Reserved : ARRAY [1..3] OF CHAR;
END;
CONST
PKZIP : PathStr = 'PKZIP.EXE';
VAR
SWAGF,
QWKF : FILE;
ControlF : TEXT;
SavePath,
SwagPath,
SWAGFn,
MsgFName : PATHSTR;
TR : SearchRec;
ConfNum,
Number : WORD;
MSGHdr : MSGDatHdr;
ch : CHAR;
count : INTEGER;
chunks : INTEGER;
ControlVal : ControlArray;
ControlIdx : BYTE;
WStr : STRING;
FUNCTION TrimL (InpStr : STRING) : STRING; ASSEMBLER;
ASM
PUSH DS
LDS SI, InpStr
XOR AX, AX
LODSB
XCHG AX, CX
LES DI, @Result
INC DI
JCXZ @@2
MOV BL, ' '
CLD
@@1 : LODSB
CMP AL, BL
LOOPE @@1
DEC SI
INC CX
REP MOVSB
@@2 : XCHG AX, DI
MOV DI, WORD PTR @Result
SUB AX, DI
DEC AX
STOSB
POP DS
END;
FUNCTION TrimR (InpStr : STRING) : STRING;
VAR i : INTEGER;
BEGIN
i := LENGTH (InpStr);
WHILE (i >= 1) AND (InpStr [i] = ' ') DO
i := i - 1;
TrimR := COPY (InpStr, 1, i)
END;
FUNCTION TrimB (InpStr : STRING) : STRING;
BEGIN
TrimB := TrimL (TrimR (InpStr) );
END;
FUNCTION IntStr (Num : LONGINT; Width : BYTE; Zeros : BOOLEAN) : STRING;
{ Return a string value (width 'w')for the input integer ('n') }
VAR
Stg : STRING;
BEGIN
STR (Num : Width, Stg);
IF Zeros THEN BEGIN
FOR Num := 1 TO Width DO IF Stg [Num] = #32 THEN Stg [Num] := '0';
END ELSE Stg := TrimL (Stg);
IntStr := Stg;
END;
FUNCTION NameOnly (FileName : PathStr) : PathStr;
{ Strip any path information from a file specification }
VAR
Dir : DirStr;
Name : NameStr;
Ext : ExtStr;
BEGIN
FSplit (FileName, Dir, Name, Ext);
NameOnly := Name;
END {NameOnly};
FUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;
VAR F : FILE;
BEGIN
EraseFile := FALSE;
ASSIGN (F, S);
RESET (F);
IF IORESULT <> 0 THEN EXIT;
CLOSE (F);
ERASE (F);
EraseFile := (IORESULT = 0);
END;
PROCEDURE FindSwagPath (VAR P : PathStr);
VAR
S : PathStr;
BEGIN
IF SwagPath <> '' THEN S := SwagPath + '\DRIVES.SWG' ELSE
S := 'DRIVES.SWG';
S := FSearch (S, GetEnv ('PATH') );
IF S = '' THEN
BEGIN
WriteLn(#7,'You GOTTA have the SWAG files somewhere on your PATH to do this !!');
WriteLn(#7,'OR, you can enter the path on the command line !!');
HALT(1);
END;
S := FExpand (S);
P := FExpand (COPY(S,1,POS('DRIVES',S)-1));
END;
PROCEDURE FindPKZip;
VAR
S : PathStr;
BEGIN
S := FSearch ('PKZIP.EXE', GetEnv ('PATH') );
IF S = '' THEN
BEGIN
WriteLn(#7,'You GOTTA have PKZIP somewhere on your PATH to do this !!');
HALT(1);
END;
PKZIP := FExpand (S);
END;
PROCEDURE CleanUp;
{ clean up after ourselves }
BEGIN
FINDFIRST ('*.NDX', $21, TR);
WHILE DosError = 0 DO
BEGIN
EraseFile(TR.NAME);
FINDNEXT (TR);
END;
EraseFile('MESSAGES.DAT');
EraseFile('CONTROL.DAT');
END;
PROCEDURE CreateControlDat;
VAR
I : BYTE;
BEGIN
ControlHdr [11] := IntStr (PRED (ConfNum), 3, FALSE);
ASSIGN (ControlF, 'CONTROL.DAT');
REWRITE (ControlF);
FOR I := 1 TO 11 DO
WRITELN (ControlF, ControlHdr [i]);
FOR I := 1 TO ControlIdx DO
WRITELN (ControlF, ControlVal [i]);
CLOSE (ControlF);
END;
PROCEDURE CreateMessageDat;
VAR
I : BYTE;
Buff : BlockArray;
BEGIN
FILLCHAR (ControlVal, SIZEOF (ControlVal), #0);
FILLCHAR (Buff, SIZEOF (Buff), #32);
FILLCHAR (MsgHdr, SIZEOF (MsgHdr), #32);
ConfNum := 0;
ControlIdx := 0;
Number := 0;
ASSIGN (QWKF, 'MESSAGES.DAT');
REWRITE (QWKF, SIZEOF (MsgHdr) );
WStr := 'SWAG TO QWK (c) 1993 GDSOFT';
FOR I := 1 TO LENGTH (WStr) DO Buff [i] := WSTR [i];
BLOCKWRITE (QwkF, Buff, 1);
END;
FUNCTION ArrayTOInteger (B : CharArray; Len : BYTE) : LONGINT;
VAR I : BYTE;
S : STRING;
E : INTEGER;
T : INTEGER;
BEGIN
S := '';
FOR I := 1 TO PRED (Len) DO IF B [i] <> #32 THEN S := S + B [i];
VAL (S, T, E);
IF E = 0 THEN ArrayToInteger := T;
END;
PROCEDURE ReadMessage (HDR : MSGDatHdr; RelNum : LONGINT; VAR Chunks : INTEGER);
VAR
Buff : BlockArray;
J : INTEGER;
I : BYTE;
NS : STRING;
BEGIN
{ read the header block }
SEEK (SwagF, RelNum - 1);
BLOCKREAD (SwagF, Hdr, 1);
{ Correct the record number }
INC(Number);
NS := IntStr(Number,7,FALSE);
WHILE Length(NS) < 7 DO NS := NS + #32;
MOVE (NS, Hdr.MsgNum, 7);
Hdr.LeastSig := ConfNum;
Hdr.MostSig := Number;
{ write the header to our QWK file }
BLOCKWRITE (QwkF, Hdr, 1);
{ process the rest of the blocks }
Chunks := ArrayToInteger (HDR.NumChunk, 6);
FOR J := 1 TO PRED (Chunks) DO
BEGIN
BLOCKREAD (SwagF, Buff, 1);
BLOCKWRITE (QwkF, Buff, 1);
END;
END;
PROCEDURE ProcessSwag (FN : PathStr);
VAR
ndxF : File;
b : bSingle;
r : REAL;
n : LONGINT;
{ converts TP real to Microsoft 4 bytes single .. GOOFY !!!! }
procedure real_to_msb (preal : real; var b : bsingle);
var
r : array [0 .. 5] of byte absolute preal;
begin
b [3] := r [0];
move (r [3], b [0], 3);
end; { procedure real_to_msb }
BEGIN
WriteLn('Process .. ',FN);
{ create the NDX file }
ASSIGN (ndxF,IntStr(ConfNum,3,TRUE)+'.NDX');
REWRITE (ndxF,1);
ASSIGN (SwagF, FN);
RESET (SwagF, SIZEOF (MsgHdr) );
Count := 2; { start at RECORD #2 }
WHILE (Count < FILESIZE (SwagF) ) DO
BEGIN
n := SUCC(FilePos(QwkF)); { ndx wants the RELATIVE position }
r := N; { make a REAL }
REAL_TO_MSB(r,b); { convert to MSB format }
BLOCKWRITE(ndxF,B,SizeOf(B)); { store it }
ReadMessage (MSGHdr, Count, Chunks);
INC (Count, Chunks);
END;
CLOSE (SwagF);
CLOSE (NdxF);
{ update the CONTROL file array }
INC (ControlIdx);
ControlVal [ControlIdx] := IntStr (ConfNum, 3, TRUE);
INC (ControlIdx);
ControlVal [ControlIdx] := NameOnly (FN);
INC (ConfNum);
END;
BEGIN
ClrScr;
IF ParamCount > 0 THEN SwagPath := FExpand(ParamStr(1));
EraseFile('SWAG.QWK'); { make sure we don't have one yet }
FindSwagPath (SwagPath);
FindPkZip;
CreateMessageDat;
IF SwagPath [LENGTH (SwagPath) ] <> '\' THEN SwagPath := SwagPath + '\';
FINDFIRST (SwagPath + '*.SWG', $21, TR);
WHILE DosError = 0 DO
BEGIN
ProcessSwag (SwagPath + TR.Name);
FINDNEXT (TR);
END;
CLOSE (QwkF);
CreateControlDat;
SwapVectors;
Exec(PKZIP,' -ex SWAG.QWK *.NDX MESSAGES.DAT CONTROL.DAT');
SwapVectors;
CleanUp;
END.