DECLARE SUB GetSubHeaders (nextline$, secondline$)
DECLARE FUNCTION GetAddress$ (in$)
DECLARE FUNCTION StripCR$ (aline$)
DECLARE SUB MessageHeader (contents$)
DECLARE FUNCTION CheckLine% (linetocheck$)
DECLARE SUB CheckCommandLine ()
DECLARE SUB ShowStartup ()
DECLARE FUNCTION SkipBlankLine$ (thisline$)


CONST ver$ = "2.70"
CONST verdate$ = "25-6-2006"

DIM SHARED sep$(7)

' List of seperators to use.

sep$(1) = STRING$(30, "-")
sep$(2) = STRING$(70, "-")
sep$(3) = STRING$(70, "=")
sep$(4) = "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D="
sep$(5) = "=3D"
sep$(6) = "--__--__--"
sep$(7) = STRING$(70, "_")


DIM SHARED from$, fromline$, listto$, filename$, outname$
DIM SHARED quiet AS INTEGER, messages AS INTEGER, exactmatch AS INTEGER
DIM SHARED yahoo AS INTEGER

CheckCommandLine
ShowStartup

OPEN filename$ FOR INPUT AS #1
OPEN outname$ FOR OUTPUT AS #2

   ' Search until end of headers (blank row) to grab message info.
   ' checking for subject, from, and to lines along the way.
   DO
      LINE INPUT #1, line1$

      colonpos = INSTR(line1$, ":")
      IF colonpos > 0 THEN

         SELECT CASE LCASE$(LEFT$(line1$, colonpos - 1))
            CASE "from"
               from$ = LTRIM$(MID$(line1$, 6))
            CASE "subject"
               subject$ = LTRIM$(MID$(line1$, 9))
               line1$ = "Subject: Converted " + subject$
            CASE "content-type"
               line1$ = "X-Comments: " + line1$
            CASE "to"
               listto$ = LTRIM$(MID$(line1$, 4))
            CASE "list-id"
               REM Added to check for Yahoo groups type digests
               IF INSTR(LCASE$(line1$), "yahoogroups") > 0 THEN yahoo = 1

         END SELECT
      END IF

      IF RTRIM$(line1$) <> "" THEN PRINT #2, line1$
   LOOP UNTIL RTRIM$(line1$) = ""

   PRINT #2, "MIME-Version: 1.0"
   PRINT #2, "Content-type: Multipart/Digest; boundary=Message-Boundary-5383"

   PRINT #2, ""
   

   MessageHeader subject$

   PRINT #2, ""
   ' ^^^ Blank line to signify end of headers and start of message.
  
   PRINT #2, "This digest file has been Multi-Part MIME'd"
   PRINT #2, "using DIGESTER v " + ver$ + " by Stephen Knight <info@dragon-it.co.uk>"
   PRINT #2, "http://www.dragon-it.co.uk/"
   PRINT #2, ""
  
   DO
      LINE INPUT #1, aline$

      SELECT CASE CheckLine(aline$)
   
         CASE 1   ' Seperator

            IF NOT EOF(1) THEN LINE INPUT #1, bline$
            IF NOT EOF(1) THEN LINE INPUT #1, cline$
           
            IF CheckLine(cline$) = 1 THEN
               nextline$ = SkipBlankLine$("")
               GetSubHeaders nextline$, ""
            ELSE
               IF CheckLine(bline$) = 1 THEN
                  nextline$ = SkipBlankLine$(cline$)
                  GetSubHeaders nextline$, ""
               END IF
               IF CheckLine(bline$) = 2 AND CheckLine(cline$) = 0 THEN
                 GetSubHeaders cline$, ""
               END IF
               IF CheckLine(bline$) = 0 AND CheckLine(cline$) = 0 THEN
                  GetSubHeaders bline$, cline$
               END IF
               IF CheckLine(bline$) = 2 AND CheckLine(cline$) = 2 THEN
                  nextline$ = SkipBlankLine$(cline$)
                  GetSubHeaders nextline$, ""
               END IF
            END IF
        
         CASE 2   ' Blank
            PRINT #2, aline$

         CASE 0   ' Other
            PRINT #2, aline$

      END SELECT
   LOOP UNTIL EOF(1)

PRINT #2, ""
PRINT #2, "--Message-Boundary-5383--"
PRINT #2, ""
PRINT #2, "-- End --"
PRINT #2, ""

CLOSE #1, #2

IF quiet = 0 THEN PRINT "Found "; messages; " messages."

KILL filename$

SUB CheckCommandLine

IF INSTR(COMMAND$, "/CHECK") > 0 THEN quiet = 1 ELSE quiet = 0
IF INSTR(COMMAND$, "/EXACT") > 0 THEN exactmatch = 1 ELSE exactmatch = 0

' remove anything after / on the command line

slashpos = INSTR(COMMAND$, "/")
IF slashpos > 0 THEN
   filename$ = LEFT$(COMMAND$, slashpos - 1)
ELSE
   filename$ = COMMAND$
END IF

' take the second filename if there is more than one ...

spacepos = INSTR(filename$, " ")
IF spacepos > 0 THEN
   outdir$ = LEFT$(filename$, spacepos - 1)
   filename$ = MID$(filename$, spacepos + 1)
ELSE
   outdir$ = ""
   CLS
   PRINT "DIGESTER Version " + ver$ + ", " + verdate$
   PRINT
   PRINT "Written by Stephen Knight <info@dragon-it.co.uk>"
   PRINT "http://www.dragon-it.co.uk/"
   PRINT
   PRINT "You have not specified a destination directory!"
   PRINT
   PRINT "You need to call this program with two arguments :"
   PRINT
   PRINT "eg DIGESTER c:\pmail\mail 32424232.tmp"
   PRINT
   PRINT "The first paramater is your new mail directory and should be added onto"
   PRINT "the command line of digester in your filter rules.  The second is the filename"
   PRINT "of the message to convert and is added automatically by Pegasus."
   PRINT
   PRINT "Version 1.2 cuts down no. of lines scanned for sub-headers so very"
   PRINT "short messages aren't joined with the next one / blank lines removed."
   PRINT "Also checks for :on from line to stop picking out normal text with a"
   PRINT "from at the beginning of a line and converting that too."
   PRINT ""
   PRINT "Version 2.0 now creates true MIME digests for use with Pegasus's"
   PRINT "built in MIME digest viewer."
   PRINT
   PRINT "Version 2.1 comments out existing Content-Type headers put in by some"
   PRINT "ISP's or list servers which get picked up instead of the Digest type. It"
   PRINT "also adds a second reply Mailto: line to reply to the originating list."
   PRINT
   PRINT "Version 2.2 now ignores more signatures / instances where a message"
   PRINT "contains a line of dashes which is the same as the message seperator."
   PRINT
   PRINT "Version 2.3 has further message seperators such as line of = signs."
   PRINT
   PRINT "Press any key to exit"
   SLEEP
   
   END
END IF

IF outdir$ <> "" AND RIGHT$(outdir$, 1) <> "\" THEN outdir$ = outdir$ + "\"

'split off filename

outname$ = RIGHT$(LEFT$(filename$, INSTR(filename$, ".") - 1), 8)
slashpos = INSTR(outname$, "\")
IF slashpos > 0 THEN outname$ = MID$(outname$, slashpos + 1)

' Change first letter of filename to ! to make file already read.
MID$(outname$, 1, 1) = "!"
outname$ = outdir$ + outname$ + ".cnm"

END SUB

FUNCTION CheckLine% (linetocheck$)


IF exactmatch = 0 THEN
   line2$ = LTRIM$(RTRIM$(LEFT$(linetocheck$, 70)))
ELSE
   line2$ = RTRIM$(linetocheck$)
END IF

SELECT CASE line2$

   CASE sep$(1), sep$(2), sep$(3), sep$(4), sep$(5), sep$(6), sep$(7)
      CheckLine% = 1
   CASE ""
      CheckLine% = 2
   CASE ELSE
      CheckLine% = 0

END SELECT


REM 0 is anything, 1 is seperator, 2 is blank line

REM 1 is seperator, 0 is not

END FUNCTION

FUNCTION GetAddress$ (in$)

leftbracket = INSTR(in$, "<")
IF leftbracket > 0 THEN
   rightbracket = INSTR(leftbracket + 1, in$, ">")
   IF rightbracket > 0 THEN
      GetAddress$ = MID$(in$, leftbracket + 1, rightbracket - leftbracket - 1)
   ELSE
      GetAddress$ = MID$(in$, leftbracket + 1)
   END IF
ELSE
   GetAddress$ = in$
END IF
    
END FUNCTION

SUB GetSubHeaders (nextline$, secondline$)


' has found blank line after dashed line == new message

subjectline$ = "(unknown)": fromline$ = "?": dateline$ = ""
title$ = ""

'scan through headers of sub-message and next few lines
' and pickup subject, from etc. to include in mime header.
             

MessageHeader ""

line1$ = nextline$
line2$ = secondline$
            
DO

headcheck$ = LTRIM$(line1$)
                
   SELECT CASE LCASE$(LEFT$(headcheck$, 5))

   CASE "*****"
      ' Normally occurs at end of Digest.
      title$ = ""
      subjectline$ = "(unknown)"
      dateline$ = ""
      fromline$ = "?"
      PRINT #2, "From: "; listto$
      PRINT #2, "Subject: "; prevline$
      PRINT #2, "Date : 31 Dec 2099 00:00:00 +0000"
      PRINT #2, ""
      PRINT #2, prevline$
      PRINT #2, line1$
                        
   CASE "subje":
      subjectline$ = LTRIM$(MID$(headcheck$, 9))
                        
   CASE "date:":
      dateline$ = LTRIM$(MID$(headcheck$, 6))
                        
   CASE "from:":
      fromline$ = LTRIM$(MID$(headcheck$, 6))
   REM Added to deal with Yahoo digests 18-6-06
   CASE "poste": ' "posted by:"
      fromline$ = LTRIM$(MID$(headcheck$, 11))
   CASE ""

   CASE ELSE
      IF subjectline$ = "(unknown)" THEN subjectline$ = LTRIM$(headcheck$)
      ' Deal with subjectline with artificial 1a. type threading for yahoo.
      IF VAL(LEFT$(subjectline$, 1)) > 0 THEN
         spacepos = INSTR(subjectline$, " ")
         IF spacepos > 0 THEN subjectline$ = MID$(subjectline$, spacepos + 1)
      END IF
                        
   END SELECT

IF line2$ <> "" THEN
   line1$ = line2$
   line2$ = ""
ELSE
   IF NOT EOF(1) THEN LINE INPUT #1, line1$
END IF

LOOP UNTIL EOF(1) OR line1$ = ""
            
' Add additional headers.  Date / Reply-To / Subject will carry over
' when Reply button is pressed
' Add reply buttons using mailto: link.
' Reply will reply to List, Reply + copy CC field will also go to sender.

IF dateline$ <> "" THEN PRINT #2, "Date: " + dateline$

IF subjectline$ <> "(unknown)" THEN PRINT #2, "Subject: " + subjectline$

IF fromline$ <> "?" THEN
   PRINT #2, "Reply-To: " + GetAddress$(listto$)
   PRINT #2, "From: " + fromline$
   PRINT #2, "CC: " + fromline$
   PRINT #2, "Content-type: text/plain; charset=us-ascii"
   PRINT #2, "Content-Transfer-Encoding: quoted-printable"

'  PRINT #2, ""
'  PRINT #2, "Reply to Sender: mailto:" + GetAddress$(fromline$)
'  PRINT #2, "Reply to List: mailto:" + GetAddress$(listto$)
END IF

PRINT #2, ""

IF quiet = 0 THEN PRINT "Message about "; subjectline$ + " from " + fromline$
messages = messages + 1

END SUB

SUB MessageHeader (contents$)

   PRINT #2, "--Message-Boundary-5383"
   PRINT #2, ""
IF contents$ <> "" THEN
      PRINT #2, "From: " + from$
      PRINT #2, "Subject: " + contents$
      PRINT #2, "Date: Mon, 01 Jan 1980 00:00 +0000"

   END IF
END SUB

SUB ShowStartup

CLS

PRINT "DIGESTER Version " + ver$ + ", " + verdate$
PRINT
PRINT "Converting digest from "; filename$; " to "; outname$
PRINT
PRINT "Written by Stephen Knight <info@dragon-it.co.uk>"
PRINT "http://www.dragon-it.co.uk/"
PRINT
PRINT "v2.4 adds support for Yahoo Groups messages using double underscore lines"
PRINT


END SUB

FUNCTION SkipBlankLine$ (thisline$)


thenextline$ = thisline$

DO

   IF RTRIM$(thenextline$) = "" AND NOT EOF(1) THEN LINE INPUT #1, thenextline$

LOOP UNTIL EOF(1) OR RTRIM$(thenextline$) <> ""

SkipBlankLine$ = thenextline$

END FUNCTION

FUNCTION StripCR$ (aline$)

   IF RIGHT$(aline$, 1) = CHR$(13) OR RIGHT$(aline$, 1) = CHR$(10) THEN
      stripped$ = LEFT$(aline$, LEN(aline$) - 1)
   ELSE
      stripped$ = aline$
   END IF

   IF LEFT$(stripped$, 1) = CHR$(10) THEN
      stripped$ = MID$(stripped$, 1)
      PRINT "strip chr(10)"
   END IF

   StripCR$ = stripped$
END FUNCTION