'===========================================================================
' Subject: ADVANCED QWK READER                Date: 04-15-96 (01:10)       
'  Author: The ABC Programmer                 Code: QB, QBasic, PDS        
'  Origin: Try SIMPLE QWK READER            Packet: MISC.ABC
'===========================================================================
'=====================[ More Complex QWK Reader ]=======================
'
' This QWK Reader let's you read the MESSAGES.DAT file contained in all
' .QWK Packets.  Also allows for easy dumping QWK --> ASCII TXT Format.
'
' Original PASCAL code by Swag Support Team (Gayle Davis)
' Converted and optimized to BASIC by William Yu (04-15-96)
'
' Advanced features for this QWK Reader include:
'   * Option of extracting single messages
'   * Full message scroll
'   * Ability to choose which message to read
'
' Basic colors (B&W) for monochrome support.
' Careful, comment out the PCOPY routine and uncomment the BSAVE/BLOAD
' routine in SUB MessageList if you do have a monochrome adapter.
'
' I've tried to implement as many features without adding too much
' extraneous code.
' This program leaves much to be desired, here are some suggestions:
'
'    - Unpack .QWK on the fly
'    - Option of sending the message to printer
'    - Option of changing the saved message file name
'    - Search option
'    - Use screen scroll routine
'----------------------------------------------------------------------

'$DYNAMIC
DEFINT A-Z
DECLARE SUB DumpHeader (QWK AS ANY)
DECLARE SUB ReadMessage (HDR AS ANY, RelNum&, Chunks)
DECLARE SUB ReadMsg (NumChunks)
DECLARE SUB ReadWriteHdr (QWK AS ANY)
DECLARE SUB DrawBox (X%, Y%, XX%, YY%, C%, BC%, Solid%, CharSet%)
DECLARE SUB MessageList (Messages&(), Max%, QWK AS ANY)
DECLARE SUB DisplayMessage (Messages&(), FPNum, QWK AS ANY, Max)

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
    UpFROM   AS STRING * 25
    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
DIM Messages&(10000)

WIDTH 80, Height
CLS

  OPEN QWKPacket$ FOR BINARY AS #1
  IF DumpQWKtoFile THEN OPEN DumpQWKFileName$ FOR OUTPUT AS #2
  Count& = 129  ' Skip Copyright information
  Num = 0
  WHILE Count& < LOF(1)
        Num = Num + 1
        ReadMessage QWK, Count&, Chunks
        A$ = INKEY$                          ' ESC Key quits/aborts
        IF DumpQWKtoFile THEN
          LOCATE 1, 1
          PRINT USING "Complete: ###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100
          PRINT #2,
        ELSE
          Messages&(Num) = Count&            ' Count number of messages
          LOCATE 1, 1: PRINT "Reading:"; Num
          PRINT USING "Complete: ###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100
        END IF
        IF A$ = CHR$(27) THEN CLOSE : END    ' ESC quits Viewing or Dumping
        Count& = Count& + (128 * Chunks)
  WEND
  CLS
  IF NOT DumpQWKtoFile THEN MessageList Messages&(), Num, QWK
  CLOSE
  END

REM $STATIC
SUB DisplayMessage (Messages&(), FPNum, QWK AS MSGDatHdr, Max)

BakFPNum = FPNum        ' So we don't get confused when we jump Next/Prev

BeginHere:
 
  DIM Buff AS STRING * 128  ' Read in 128 byte blocks
  DIM SetString AS STRING * 80
  DIM Text$(500)            ' Too lazy to implement file pointers :>
                            ' Messages usually don't exceed 500 lines anyways
  COLOR 7, 0: CLS
  LOCATE Height, 1: COLOR 0, 7: PRINT "  Up/Down/PgUp/PgDn/Home/End       E[";
  COLOR 15: PRINT "X"; : COLOR 0: PRINT "]tract   +/- [N]ext/[P]rev              ";
  COLOR 7, 0
  LOCATE 2, 1
    SEEK #1, Messages&(FPNum)
    ReadWriteHdr QWK
    Chunks = VAL(QWK.NumChunk)
    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$; ")"
    LOCATE 2, 66: PRINT USING "#### of ####"; FPNum; Max
    DrawBox 1, 1, 80, 6, 7, 0, 0, 1
 
  N = 1
  FOR J = 1 TO Chunks - 1
    GET #1, , Buff
    X = 1
    FOR I = 1 TO 128
      IF MID$(Buff, I, 1) = CHR$(227) THEN
        N = N + 1
      ELSE
        Text$(N) = Text$(N) + MID$(Buff, I, 1)
      END IF
    NEXT I
  NEXT J
  MaxNum = N
  LOCATE 5, 66: PRINT "# Lines:"; MaxNum
  LOCATE 7

FOR I = 1 TO Height - 7
  A = INSTR(Text$(I), ">")                        ' Quote
  IF A < 6 AND A > 0 THEN COLOR 15 ELSE COLOR 7   ' Color BrightWhite
  SetString = Text$(I)
  PRINT SetString;
  IF I = MaxNum THEN EXIT FOR
NEXT I
I = 1
COLOR 0, 7: LOCATE Height, 67: PRINT I; "..."; I + Height - 7;

  DO
    DO
      A$ = INKEY$
    LOOP UNTIL A$ <> ""
    IF LEN(A$) = 2 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)
    SELECT CASE Char
      CASE 43, 78, 110                  ' +/N Goto Next Message
        FPNum = FPNum + 1
        IF FPNum > Max THEN FPNum = 1
        ERASE Text$
        GOTO BeginHere
      CASE 45, 80, 112                  ' -/P Goto Previous Message
        FPNum = FPNum - 1
        IF FPNum = 0 THEN FPNum = Max
        ERASE Text$
        GOTO BeginHere
      CASE 88, 120                      ' X - Extract Message
        FileName$ = LTRIM$(STR$(FPNum)) + ".MSG"
        OPEN FileName$ FOR OUTPUT AS #2
        DumpHeader QWK
        FOR X = 1 TO MaxNum
           PRINT #2, Text$(X)
        NEXT X
        CLOSE #2
        LOCATE 3, 63: COLOR 15, 0: PRINT "Saved as "; FileName$
      CASE -72                          ' Up arrow key
        IF I > 1 THEN
          I = I - 1
          GOSUB ShowMessage
        END IF
      CASE -73                          ' PageUp
        I = I - Height + 7
        IF I < 1 THEN I = 1
        GOSUB ShowMessage
      CASE -80                          ' Down arrow key
        IF I < MaxNum THEN
          I = I + 1
          GOSUB ShowMessage
        END IF
      CASE -81                          ' PageDown
        I = I + Height - 7
        IF I > MaxNum - Height + 7 THEN I = MaxNum - Height + 7
        GOSUB ShowMessage
      CASE -79                          ' End
        I = MaxNum - Height + 7
        GOSUB ShowMessage
      CASE -71                          ' Home
        I = 1
        GOSUB ShowMessage
      CASE 27                           ' Escape key pressed
         GOTO BackToIndex
    END SELECT
  LOOP

ShowMessage:
  IF MaxNum < Height - 7 THEN RETURN
  LOCATE 7, 1
  FOR X = 1 TO Height - 7
    A = INSTR(Text$(I), ">")                            ' Quote
    IF A < 6 AND A > 0 THEN COLOR 15, 0 ELSE COLOR 7, 0 ' Color BrightWhite
    SetString = Text$(I)
    PRINT SetString;
    IF I >= MaxNum THEN EXIT FOR
    I = I + 1
  NEXT X
  I = I - Height + 7
  COLOR 0, 7: LOCATE Height, 67: PRINT I; "..."; I + Height - 7;
RETURN

BackToIndex:
  FPNum = BakFPNum

END SUB

SUB DrawBox (X%, Y%, XX%, YY%, C%, BC%, Solid%, CharSet%)

IF CharSet% = 1 THEN
  Char1$ = "Ú"
  CharHoz$ = "Ä"
  Char2$ = "¿"
  CharVert$ = "³"
  Char3$ = "À"
  Char4$ = "Ù"
END IF

IF CharSet% = 2 THEN
  Char1$ = "É"
  CharHoz$ = "Í"
  Char2$ = "»"
  CharVert$ = "º"
  Char3$ = "È"
  Char4$ = "¼"
END IF

COLOR C%, BC%
A = (XX% - X%) - 1
LOCATE Y%, X%: PRINT Char1$; STRING$(A, CharHoz$); Char2$;
FOR I = Y% + 1 TO YY% - 1
  LOCATE I, X%: PRINT CharVert$;
  IF Solid% = 1 THEN PRINT SPACE$(A);
  LOCATE I, XX%: PRINT CharVert$;
NEXT I
LOCATE YY%, X%: PRINT Char3$; STRING$(A, CharHoz$); Char4$;

END SUB

SUB DumpHeader (QWK AS MSGDatHdr)
   
    PRINT #2, STRING$(79, "=")
    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$(79, "-")

END SUB

SUB MessageList (Messages&(), Max, QWK AS MSGDatHdr)

' Scrolling up/down pages can be optimized by using a Screen Scroll routine
' requiring either a call to ABSOLUTE() Function for QBasic or interrupt
' routines via INTRPT.OBJ in QB.LIB
' Recommended ABC Packet: INTERRPT.ABC, DOS.ABC, and TEXT.ABC, ASMCODE.ABC

  DrawBox 1, 1, 80, 3, 7, 0, 0, 2
  DrawBox 1, Height - 1, 80, Height, 7, 0, 0, 1
 
  LOCATE 2, 3: PRINT "Number  From               To                 Subject                   Conf"
  FOR I = 1 TO Height - 5
    IF I > Max THEN EXIT FOR
    SEEK #1, Messages&(I)
    ReadWriteHdr QWK
    LOCATE I + 3, 3: PRINT USING "#####"; VAL(QWK.MSGNum);
    PRINT "   "; LEFT$(QWK.UpFROM, 19);
    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;
    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))
    PRINT " ("; Conference$; ")";
  NEXT I

  Index = 1
  Position = 4
  SEEK #1, Messages&(Index)
  ReadWriteHdr QWK
  COLOR 0, 7
  LOCATE Position, 2: PRINT USING " #####"; VAL(QWK.MSGNum);
  PRINT "   "; LEFT$(QWK.UpFROM, 19);
  PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;
  Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))
  PRINT " ("; Conference$; ")";
 
  DO
    DO
      A$ = INKEY$
    LOOP UNTIL A$ <> ""
    IF LEN(A$) = 2 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)
    SELECT CASE Char
      CASE 13                          ' ENTER Pressed
        PCOPY 0, 1
        'DEF SEG = &HB000              ' Uncomment these lines
        'BSAVE "LIST.TMP", 0, 4000     ' for monochrome support
        DisplayMessage Messages&(), Index, QWK, Max
        PCOPY 1, 0
        'BLOAD "LIST.TMP"
        'KILL "LIST.TMP"
      CASE -72                          ' Up arrow key
        IF Index > 1 THEN
          COLOR 7, 0: GOSUB SelectMsgNum
          Index = Index - 1
          Position = Position - 1
          COLOR 0, 7: GOSUB SelectMsgNum
        END IF
      CASE -73                          ' PageUp
       IF Max >= Height - 5 THEN
        IF Index <> 1 THEN
          Index = Index - Height + 5 - (Position - 4)
          IF Index <= 0 THEN Index = 1: Position = 4
          X = Position
          GOSUB PrevPage
          Position = X
          Index = Index + (Position - 4)
          COLOR 0, 7: GOSUB SelectMsgNum
        END IF
       END IF
      CASE -80                          ' Down arrow key
        IF Index <> Max THEN
          COLOR 7, 0: GOSUB SelectMsgNum
          Index = Index + 1
          Position = Position + 1
          COLOR 0, 7: GOSUB SelectMsgNum
        END IF
      CASE -81                          ' PageDown
       IF Max >= Height - 5 THEN
        IF Index + (2 * Height) - (Position - 4) - 6 >= Max THEN
          Index = Max
          Position = Height - 2
        ELSE
          Index = Index + (2 * Height) - 11 - (Position - 4)
        END IF
        X = Position
        GOSUB NextPage
        Position = X
        IF Index <> Max THEN
          Index = Index - Height + 6 + (Position - 4)
        ELSE
          Position = Height - 2
          Index = Max
        END IF
        COLOR 0, 7: GOSUB SelectMsgNum
       END IF
      CASE -79                          ' End
       IF Max >= Height - 5 THEN
        Index = Max: Position = Height - 2
        GOSUB NextPage
        GOSUB SelectMsgNum
       END IF
      CASE -71                          ' Home
       IF Max >= Height - 5 THEN
        Index = 1: Position = 4
        GOSUB PrevPage
        GOSUB SelectMsgNum
       END IF
      CASE 27                           ' Escape key pressed
        CLOSE : COLOR 7, 0: CLS : END
    END SELECT
  LOOP

SelectMsgNum:
  IF Position > Height - 2 THEN GOSUB NextPage
  IF Position = 3 THEN GOSUB PrevPage
  SEEK #1, Messages&(Index)
  ReadWriteHdr QWK
  LOCATE Position, 2: PRINT USING " #####"; VAL(QWK.MSGNum);
  PRINT "   "; LEFT$(QWK.UpFROM, 19);
  PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;
  Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))
  PRINT " ("; Conference$; ")";
RETURN

NextPage:
  Index = Index - Height + 5
  FOR I = 1 TO Height - 5
    Index = Index + 1
    IF Index >= Max THEN EXIT FOR
    SEEK #1, Messages&(Index)
    ReadWriteHdr QWK
    COLOR 7, 0
    LOCATE I + 3, 2: PRINT USING " #####"; VAL(QWK.MSGNum);
    PRINT "   "; LEFT$(QWK.UpFROM, 19);
    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;
    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))
    PRINT " ("; Conference$; ")"
  NEXT I
  Position = Height - 2
  COLOR 0, 7
RETURN

PrevPage:
  Index = Index - 1
  FOR I = 1 TO Height - 5
    Index = Index + 1
    IF Index >= Max THEN EXIT FOR
    SEEK #1, Messages&(Index)
    ReadWriteHdr QWK
    COLOR 7, 0
    LOCATE I + 3, 2: PRINT USING " #####"; VAL(QWK.MSGNum);
    PRINT "   "; LEFT$(QWK.UpFROM, 19);
    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;
    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))
    PRINT " ("; Conference$; ")";
  NEXT I
  Index = Index - (Height - 6)
  Position = 4: COLOR 0, 7
RETURN

END SUB

SUB ReadMessage (QWK AS MSGDatHdr, RelNum&, Chunks)
 
  SEEK #1, RelNum&
  ReadWriteHdr QWK
  Chunks = VAL(QWK.NumChunk)
  IF DumpQWKtoFile THEN 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
        PRINT #2,
      ELSE
        PRINT #2, MID$(Buff, I, 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
  END IF

END SUB