'=========================================================================== ' Subject: SIMPLE QWK READER Date: 03-06-96 (17:43) ' Author: The ABC Programmer Code: QB, QBasic, PDS ' Origin: Try ADVANCED QWK READER Packet: MISC.ABC '=========================================================================== '===================[ Simple Little QWK Reader ]======================= ' ' This SIMPLE little ditty let's you read SWAG or QWK files which have ' EXACTLY the same format. Additions to dump to file implemented. ' Original PASCAL code by Swag Support Team (Gayle Davis) ' Converted and optimized to BASIC by William Yu (03-06-96) ' '---------------------------------------------------------------------- DECLARE SUB DumpHeader (QWK AS ANY) DECLARE SUB ReadMessage (HDR AS ANY, RelNum&, Chunks) DECLARE SUB ReadMsg (NumChunks) DECLARE SUB ReadWriteHdr (QWK AS ANY) CONST Height = 25 ' 25/43/50 CONST False = 0 ' False = 0 CONST True = NOT False ' True = -1 CONST DumpQWKtoFile = False ' Dump messages to file? ' True = Dump to file ' False = View from screen CONST DumpQWKFileName$ = "DUMP.MSG" ' Dump messages to this file name CONST QWKPacket$ = "MESSAGES.DAT" ' MESSAGES.DAT or *.SWG ' Specify the path if required TYPE MSGDatHdr ' MESSAGES.DAT File Structure Status AS STRING * 1 ' 128 bytes altogether MSGNum AS STRING * 7 Date AS STRING * 8 Time AS STRING * 5 UpTO AS STRING * 25 ' Always UpperCase UpFROM AS STRING * 25 ' Always UpperCase Subject AS STRING * 25 PassWord AS STRING * 12 ' Never/rarely used ReferNum AS STRING * 8 NumChunk AS STRING * 6 Alive AS STRING * 1 LeastSig AS STRING * 1 ' Conference # MostSig AS STRING * 1 ' Used for conf. # greater than 255 Reserved AS STRING * 3 END TYPE DIM QWK AS MSGDatHdr WIDTH 80, Height CLS OPEN QWKPacket$ FOR BINARY AS #1 IF DumpQWKtoFile THEN OPEN DumpQWKFileName$ FOR OUTPUT AS #2 SEEK #1, 129 ' Skip Copyright information Count& = 129 WHILE Count& < LOF(1) ReadMessage QWK, Count&, Chunks IF DumpQWKtoFile THEN LOCATE 1, 1: PRINT "Complete:"; PRINT USING "###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100 PRINT #2, A$ = INKEY$ ' ESC Key quits dumping ELSE PRINT PRINT "Press any key to continue .. (ESC Key quits)"; A$ = INPUT$(1) CLS END IF IF A$ = CHR$(27) THEN CLOSE : END ' ESC quits Viewing or Dumping Count& = Count& + (128 * Chunks) WEND CLOSE END SUB DumpHeader (QWK AS MSGDatHdr) PRINT #2, STRING$(80, "=") PRINT #2, " Date: "; QWK.Date; " ("; QWK.Time; ")"; PRINT #2, , , "Number: "; QWK.MSGNum PRINT #2, " From: "; QWK.UpFROM; PRINT #2, , "Refer#: "; QWK.ReferNum PRINT #2, " To: "; QWK.UpTO; PRINT #2, , " Recvd: "; InCase$ = "-`^#" IF INSTR(QWK.Status, InCase$) THEN PRINT #2, "YES" ELSE PRINT #2, "NO" END IF PRINT #2, "Subject: "; QWK.Subject; Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig))) PRINT #2, , " Conf: "; "("; Conference$; ")" PRINT #2, STRING$(80, "-") END SUB SUB ReadMessage (QWK AS MSGDatHdr, RelNum&, Chunks) SEEK #1, RelNum& ReadWriteHdr QWK Chunks = VAL(QWK.NumChunk) ReadMsg Chunks END SUB SUB ReadMsg (NumChunks) DIM Buff AS STRING * 128 FOR J = 1 TO NumChunks - 1 GET #1, , Buff FOR I = 1 TO 128 IF MID$(Buff, I, 1) = CHR$(227) THEN IF DumpQWKtoFile THEN PRINT #2, ELSE PRINT ELSE IF DumpQWKtoFile THEN PRINT #2, MID$(Buff, I, 1); ELSE PRINT MID$(Buff, I, 1); END IF END IF IF CSRLIN = Height - 1 THEN LOCATE Height, 1: PRINT "Hit Any Key for Next Page..."; A$ = INPUT$(1) LOCATE 6, 1: PRINT STRING$((Height - 7) * 80, " "); LOCATE 6, 1 END IF NEXT I NEXT J END SUB SUB ReadWriteHdr (QWK AS MSGDatHdr) GET #1, , QWK.Status GET #1, , QWK.MSGNum GET #1, , QWK.Date GET #1, , QWK.Time GET #1, , QWK.UpTO GET #1, , QWK.UpFROM GET #1, , QWK.Subject GET #1, , QWK.PassWord GET #1, , QWK.ReferNum GET #1, , QWK.NumChunk GET #1, , QWK.Alive GET #1, , QWK.LeastSig GET #1, , QWK.MostSig GET #1, , QWK.Reserved IF DumpQWKtoFile THEN DumpHeader QWK ELSE PRINT "Date: "; QWK.Date; " ("; QWK.Time; ")"; PRINT , , "Number: "; QWK.MSGNum PRINT "From: "; QWK.UpFROM; PRINT , "Refer#: "; QWK.ReferNum PRINT " To: "; QWK.UpTO; PRINT , " Recvd: "; InCase$ = "-`^#" IF INSTR(QWK.Status, InCase$) THEN PRINT "YES" ELSE PRINT "NO" END IF PRINT "Subj: "; QWK.Subject; Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig))) PRINT , " Conf: "; "("; Conference$; ")" PRINT STRING$(80, "-"); END IF END SUB