.net 1999 December/netCD65.iso/pc/Software/VirtualA/16bit/vaper16.exe/%MYDIR%/Hmibase.ebs

Text File | 1999-10-06 | 26.8 KB | 875 lines

'T:HMIBASE.EBS for CompuServe
' VA 4.01 release

Declare Function ParseString(args As String, delim As String) As String
Declare Function FileName$(fullpath As String)
Declare Function FileUrl(fn As String) As String
Declare Function MakeDateString(s As HMITIMESTAMP) As String
Declare Sub AddToMsgFile(SourceFileName as String)
Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean
Declare Sub LoadAddonLibraries
Declare Function MyDate$
Declare Function StartMessageDownload(id As String, forum As String, sections As String) As Integer
Declare Sub SearchMessages(searchtype As Integer, searchstring As String, bodies As Boolean, rootsonly As Boolean)
Declare Sub ReportSuccess(msg As String)
Declare Function ForumName(ByVal forum As String) As String
Declare Function FullErrorMessage() As String
Declare Sub FetchMail(id As String)
Declare Sub SetupOptions(id As String)
Declare Sub RecordBulletins(forum As String, getnews As Boolean, _
                            getothers As Boolean, getuserlog As Boolean)
Declare Function HMIGotoForum(ByVal forum As String) As Boolean
Declare Sub RecordSectionInformation(forum As String)

'T:iFlags for CompuServe (constant)
Const IM_SPECIAL = 128        ' My special msg format
Const IM_DELETE = 2048        ' Delete scratchpad file afterwards?

Const fRECEIPT = 1            'CIS mail receipt
Const fPRIVATE = 2            'CIS private forum message
Const fNOFORMAT = 4            'CIS unformatted message

Const DAP_DC_HAVE_MAIL% = &H0001          ' mail waiting
Const DAP_DC_ACCOUNT_ATTENTION% = &H0004  ' account needs attention

Const FAP_DELETABLE% = &H1
Const FAP_OWNER% = &H2
Const FAP_MSG_IS_PRIVATE% = &H4
Const FAP_READ_BY_RECIPIENT% = &H8
Const FAP_MSG_HELD% = &H10
Const FAP_MSG_FORWARDED% = &H20
Const FAP_HAS_BEEN_DELETED% = &H80

Const FAP_FILE_DELETABLE% = &H1
Const FAP_FILE_NON_PUBLIC% = &H2
Const FAP_FILE_MARKED_FOR_DELETION% = &H4
Const FAP_FILE_HAS_FEE% = &H8

Const HMI_STATE_FIRST% = 0
Const HMI_STATE_NEXT% = HMI_STATE_FIRST + 1

Public DownloadDir As String    'where downloads go
Public WorkingPath As String    'added to speed up Fetch stuff online
Public WhereAmI As String        'name of last forum/page etc
Public Sysop As Boolean            'are we a sysop?
Public InAscii As Boolean

Public currentCAP As Integer
Public SectionMsgIds(32) As Integer, SectionLibIds(32) As Integer
Public szMsgSection() As FAPSECTIONENTRY, szLibSection() As FAPSECTIONENTRY
Public nummessages As Integer
Public CurrentForum As String
Public MailName As String      'My name for mail purposes
Public PersonalAddress As String      'My PA

Dim LastDownMessages As String
Dim capturefilename As String
Dim messagefilename As String
Dim sectionvector As Long
Dim sct As FAPSECTIONS
Dim DAPconfig As DAPCONFIG

Const Months$ = "JanFebMarAprMayJunJulAugSepOctNovDec"

Dim captureStack As Integer
Dim captureForum As String

Function rj(i As Integer) As String
    rj = Right$(Str$(i + 100), 2)
End Function

Function MakeDateString(s As HMITIMESTAMP) As String
    On Error Resume Next
    If s.cMonth > 0 Then
        MakeDateString = rj(s.cDay) + "-" + Mid$(Months$,3 * (s.cMonth-1) + 1, 3) _
                         + "-" + LTrim$(Str$(1970 + s.cYear)) + " " + _
                         rj(s.cHour) + ":" + rj(s.cMinutes) + ":" + _
                         rj(s.cSeconds)
    Else
        MakeDateString = ""
    End If
End Function

Function GetFileType(i As Integer) As String
    Select Case i
        Case 0
            GetFileType = "Unknown"
        Case 1
            GetFileType = "Text"
        Case 2
            GetFileType = "Binary"
        Case 3
            GetFileType = "Image"
        Case 4
            GetFileType = "RLE"
        Case 5
            GetFileType = "NAPLPS"
        Case 6
            GetFileType = "GIF"
        Case 7
            GetFileType = "JPEG"
        Case 8
            GetFileType = "ETO"
        Case 9
            GetFileType = "HTML"
        Case 10
            GetFileType = "PNG"
    End Select
End Function

Function CompareTimes(d1 As HMITIMESTAMP, d2 As HMITIMESTAMP) As Integer
    If d1.cYear < d2.cYear Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cYear > d2.cYear Then
        CompareTimes = 1
        Exit Function
    End If
    If d1.cMonth < d2.cMonth Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cMonth > d2.cMonth Then
        CompareTimes = 1
        Exit Function
    End If
    If d1.cDay < d2.cDay Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cDay > d2.cDay Then
        CompareTimes = 1
        Exit Function
    End If
    If d1.cHour < d2.cHour Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cHour > d2.cHour Then
        CompareTimes = 1
        Exit Function
    End If
    If d1.cMinutes < d2.cMinutes Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cMinutes > d2.cMinutes Then
        CompareTimes = 1
        Exit Function
    End If
    If d1.cSeconds < d2.cSeconds Then
        CompareTimes = -1
        Exit Function
    End If
    If d1.cSeconds > d2.cSeconds Then
        CompareTimes = 1
        Exit Function
    End If
    CompareTimes = 0
End Function

Function CompareDates(d1 As HMIDATE, d2 As HMIDATE) As Integer
    If d1.cYear < d2.cYear Then
        CompareDates = -1
        Exit Function
    End If
    If d1.cYear > d2.cYear Then
        CompareDates = 1
        Exit Function
    End If
    If d1.cMonth < d2.cMonth Then
        CompareDates = -1
        Exit Function
    End If
    If d1.cMonth > d2.cMonth Then
        CompareDates = 1
        Exit Function
    End If
    If d1.cDay < d2.cDay Then
        CompareDates = -1
        Exit Function
    End If
    If d1.cDay > d2.cDay Then
        CompareDates = 1
        Exit Function
    End If
    CompareDates = 0
End Function

Sub CaptureLine(textline As String)
    CaptureText textline + Basic.Eoln$
End Sub

Sub CaptureLines(textline As String)
    Dim p As Integer, q As Integer, e As Integer

    p = 1
    Do
        q = Instr(p, textline, Chr$(10))
        If q = 0 Then
            e = Len(textline) + 1
            CaptureText Mid$(textline, p, e - p)
        Else
            e = q
            If q > p Then
                If Mid$(textline, q - 1, 1) = Chr$(13) Then
                    e = e - 1
                End If
            End If
            CaptureLine Mid$(textline, p, e - p)
        End If
        p = q + 1
    Loop While q > 0
End Sub

Sub StartCapturing(pseudoforum As String, title As String, formatted As Boolean)
    captureStack = captureStack + 1
    If captureStack <= 1 Then
        captureStack = 1
        capturefilename = UniqueFilename$()
        Capture CAPTURE_ON, capturefilename
        captureForum = pseudoforum
    Else
        CaptureText Basic.Eoln$ + "!end" + Basic.Eoln$
    End If
    If formatted Then
        CaptureText Basic.Eoln$+"#pragma ciscontrol=yes"+Basic.Eoln$
    Else
        CaptureText Basic.Eoln$+"#pragma ciscontrol=no"+Basic.Eoln$
    End If
    CaptureText Basic.Eoln$ + "!start " + captureForum + " " + title + Basic.Eoln$
End Sub

Sub FinishCapturing
    Dim i As Integer

    captureStack = captureStack - 1
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    If captureStack <= 0 Then
        captureStack = 0
        Capture CAPTURE_OFF
        ' Add to import queue
        i = QueueFile(Session.Service, capturefilename, IM_SPECIAL Or IM_DELETE)
    End If
End Sub

Function CheckCache(pagetype As String, npage As String, pversion As Long) _
        As String
    Dim newpage As String
    Dim tmp As String

    tmp = ReadIni$(pagetype, npage, Session.ServicePath+"cache.ini")
    newpage = ParseString(tmp, " Version# ")
    If newpage > "" And pversion = Val(tmp) Then
        CheckCache = newpage
    Else
        CheckCache = ""
    End If
End Function

Sub UpdateCache(pagetype As String, npage As String, pversion As Long, _
        newpage As String)
    WriteIni pagetype, npage, newpage & " Version# " & pversion, _
            Session.ServicePath+"cache.ini"
End Sub

Sub RecordTerminalOutput()
    On Error Goto RecordTerminal_error

    HMIResume

    Exit Sub

RecordTerminal_error:
    CaptureLine "Error:" & FullErrorMessage
End Sub

Sub CaptureTerminalOutput(page As String)
    StartCapturing "Actions/Information", "Terminal output when going to " + page, False
    page = ""
    RecordTerminalOutput
    FinishCapturing
End Sub

Sub CaptureMenuOptions(page As String)
    Dim menupage As DAPMENUPAGE
    Dim selections() As DAPSELECTION
    Dim p As Integer

    On Error Resume Next
    StartCapturing "Actions/Information CompuServe", Basic.Eoln$+"Menu found when going to " + page, False
    page = ""
    HMIGetMenu menupage, selections

    If menupage.cOptions And DAP_MP_BLOB_MENU Then
        CaptureLines selections(0).lpItem
    Else
        For p = 0 To Ubound(selections)
            CaptureLine selections(p).lpItem + " " + Str(selections(p).nSvcClass)
        Next
    End If
    FinishCapturing
End Sub

Function DoHMIGotoPage(ByVal forum As String, ByVal menuoption As Integer, ByVal expectedCAP As Integer)
    Dim reqforum As String

    reqforum = forum
    SetHighMessageNumber
    ResetForum
    InAscii = False

    While forum > ""
        currentCAP = HMIGoToPage(forum, menuoption)
        If currentCAP = expectedCAP Then
            DoHMIGotoPage = True
            Exit Function
        End If
        Select Case currentCAP
            Case DAP_ERROR
                LogResult "Go:"+forum+":HMI error"
                forum = ""
            Case DAP_TERMINAL
                CaptureTerminalOutput forum
                forum = ""
            Case DAP_MENU
                CaptureMenuOptions forum
            Case DAP_ARTICLE
                CaptureArticleText forum
            Case DAP_ALERT
                CaptureAlert reqforum, forum
            Case DAP_FILE
                LogResult "Go:"+forum+":this page is a file for download"
                forum = ""
            Case CAP_EMAIL
                LogResult "Go:"+forum+":this page is an Electronic Mail page"
                forum = ""
            Case CAP_FORUM
                LogResult "Go:"+forum+":this page is a Forum"
                forum = ""
            Case CAP_ENS
                LogResult "Go:"+forum+":this page is an Electronic News page"
                forum = ""
            Case Else
                LogResult "Go:"+forum+":this page is an unexpected type (" + Trim$(Str$(currentCAP)) + ")"
                forum = ""
        End Select
    Wend
    DoHMIGotoPage = False
End Function

Function DoHMIFollowMenus(ByVal forum As String, optionlist As String, ByVal expectedDAP As Integer)
    Dim p As Integer
    Dim i As Integer
    Dim newDAP As Integer
    Dim menupage As DAPMENUPAGE
    Dim selections() As DAPSELECTION

    DoHMIFollowMenus = False
    newDAP = DAP_MENU
    While optionlist > ""
        i = Val(ParseString(optionlist, ";"))
        If i <= 0 Then i = -1
        If optionlist = "" Then newDAP = expectedDAP
        If Not DoHMIGotoPage(forum, i, newDAP) Then Exit Function
        If currentCAP = DAP_MENU Then
            HMIGetMenu menupage, selections
            forum = menupage.lpName
        End If
    Wend
    DoHMIFollowMenus = True
End Function


'T:Main - CIS (subroutine) (CompuServe) (CompuServe)
'Entry point. Does a complete blink
Sub HMIMain
    Dim redials As Integer, ok As Integer, i As Boolean

    Comms.AutoDownload = PROT_QUICKB

    MailName = ReadIni$("Service "+Session.Service, "Mail Name", Session.IniFilename)
    PersonalAddress = ReadIni$("Service "+Session.Service, "Personal Address", Session.IniFilename)
    If MailName = "" Then MailName = "Not known"

    ' Dial
    If Comms.Dial("")=0 Then
        LogResult "Error whilst attempting to dial modem"
        Exit Sub
    End If

    ' Display connection info
    HMIGetDAPConfig DAPconfig
    Terminal.Print "Connected to node: "+DAPconfig.lpNodeID+Basic.Eoln$

    ' Check account attention flag
    If (DAPconfig.wAlerts And DAP_DC_ACCOUNT_ATTENTION%)<>0 Then
        Terminal.Print Basic.Eoln$+"Your account needs attention.  Please contact CompuServe"+Basic.Eoln$
        LogResult "Your account needs attention.  Please contact CompuServe"
        Comms.Bitmask = True ' CIS messes up if we don't do this
        On Error Resume Next
        i = DoHMIGoToPage("admhmi", -1, CAP_DISPLAY)
        On Error Goto 0
    End If

    ' Check to see if we need to set options
    If ReadIni$("Service "+Session.Service, "Set Options", Session.IniFilename)<>"YES" Then
        SetupOptions ""
        Script
        SetHighMessageNumber
        Comms.HangUp
        Exit Sub
    End If

    If Instr(Command$, "manual") Then
        On Error Resume Next
        ManualTerminal
    Else
        Terminal.Status "Logged in successfully"

        ' Uncomment following section if needed for VA 4.00
        'If ReadIni$("Service "+Session.Service, "Fetchmail", Session.IniFilename)<>"NO" Then
        '    Fetchmail "0"
        'End If
        Terminal.Status ""

        ' Do the REPLY.EBS script
        Script

        ' Added this to process fetch file at end
        QueFetches

        ' Set hmn on exit
        SetHighMessageNumber
        If Session.StayOnline Then
            Comms.Send "go cis:top\r"
            On Error Resume Next
            ManualTerminal
        End If
    End If

    Comms.Hangup
End Sub

Function ReverseInStr(search As String, find As String) As Integer
    Dim i As Integer, lasti As Integer

    i = 0
    Do
        lasti = i
        i = InStr(lasti+1, search, find)
        If i>0 Then tmp = Mid$(search, i+1)
    Loop Until i=0

    ReverseInStr = lasti
End Function

' Is it a special gateway address that allows space?
Function GatewayAddress(pto As String) As Boolean
    Dim i As Integer, j As Integer

    i = InStr(pto, ":")
    j = InStr(pto, " ")
    If i=0 Or j=0 Then
        GatewayAddress = False
    ElseIf i<j Then
        GatewayAddress = True
    Else
        GatewayAddress = False
    End If
End Function

' Parse the To: line and extract the realname and the email address
Sub AnalyseName(pto As String, realname As String, email As String)
    Dim buf As String, p As Integer

    ' NOTE: Must be able to split the following types of addresses.
    ' "Peter Clapham 100142,2244"
    ' "Peter Clapham [100142,2244]"
    ' "Peter Clapham [petec]"
    ' "Peter Clapham [ASHMOUNT] 100142,2244"
    ' "Peter Clapham [ASHMOUNT] [petec]"
    ' "Peter Clapham [ASHMOUNT] [100142,2244]"
    ' "[100142,2244]"
    ' "100142,2244"
    ' "petec"
    ' "Matthias Daum [CCMAIL:Wibble Wibble]"
    ' "CCMAIL:Wibble Wibble"

    ' Init vars
    buf = Trim$(pto)
    realname = ""
    email = ""

    ' If last char is a ']' then the start of the email address is the
    ' preceeding '['
    If Right$(buf,1)="]" Then
        p = ReverseInStr(buf, "[")
    Else
        If GatewayAddress(buf) Then
            p = 1
        Else
            p = ReverseInStr(buf, " ")
        End If
    End If
    If p>0 Then
        email = Mid$(buf, p+1)
        If p>0 Then
            realname = Left$(buf, p-1)
        Else
            realname = ""
        End If
    Else
        email = buf
    End If
    ReplaceAllInString email, "[", ""
    ReplaceAllInString email, "]", ""

    ' Trim off whitespace and quotes on the realname
    realname = Trim$(realname)
    If Left$(realname,1)=Chr$(34) Then realname = Mid$(realname, 2, Len(realname)-2)
    email = Trim$(email)

    ' Remove any 'internet:' or 'mime:' prefix
    If UCase$(Left$(email, 9))="INTERNET:" Then email = Mid$(email, 10)
    If UCase$(Left$(email, 5))="MIME:" Then email = Mid$(email, 6)

    ' Trim off unneeded '@compuserve.com' and convert . -> ,
    p = InStr(email, "@compuserve.com", 1)
    If p>0 Then
        email = Left$(email, p-1)
        ReplaceAllInString email, ".", ","
    End If

    ' @web.compuserve.com -> CSINET:
    If InStr(email, "@web.compuserve.com", 1)>0 And _
       UCase$(Left$(email, 7))<>"CSINET:" Then
        email = "CSINET:"+email
    End If

    ' Check to see if it's a gateway, if it isn't and contains a '@' then
    ' then it must be an internet address
    If InStr(email, ":")=0 And InStr(email, " ")=0 And _
       InStr(email, "@")<>0 Then
        email = "internet:"+email
    End If
End Sub

'Read an entire message from a file into a string
'If noformat = 0, add @b where appropriate
'If noformat = 1, add @l to say "send as shown" instead
'If noformat = 2, don't change the data at all
Function ReadMessageFile(filename As String, noformat As Integer) As String
    Dim inpline As String, body As String, badded As Boolean
    Dim quoted As Boolean

    ' Collect message text ready to send to CIS
    On Error Goto ReadMessageFile_error
    Open filename For Input Access Read Shared As #1
    If noformat = 1 Then body = "@l" + Chr$(10)
    While Not Eof(1)
        Line Input #1, inpline
        If noformat < 2 Then ReplaceAllInString inpline, "@", "@@"
        If noformat = 0 Then
            inpline = RTrim$(inpline)
            If Left$(inpline,1)=">" Then
                If body<>"" Then body = body + "@b" + Chr$(10)
                quoted = True
            ElseIf quoted Then
                body = body + "@b" + Chr$(10)
                quoted = False
            ElseIf inpline="" Or inpline<=" ~" Then
                If Not badded Then
                    body = body + "@b" + Chr$(10)
                    badded = True
                End If
            Else
                If Right$(body, 1)>" " Then
                    body = body + " "
                End If
            End If
            If inpline > "" Then badded = False
        End If
        If body="" Or body="@l"+Chr$(10) Then
            body = body + inpline
        Else
            If noformat = 0 And inpline<>"" Then
                body = body + inpline
            Else
                body = body + Chr$(10) + inpline
            End If
        End If
    Wend
ReadMessageFile_error:
    On Error Goto 0
    Close #1
    ReadMessageFile = body + Chr$(10)
End Function

'T:GetForumList (subroutine) (CompuServe)
Sub GetForumList(id As String, filename As String)
    Dim s As String, page As String, i As Integer, count As Long
    Dim filepage As DAPFILEPAGE

    If Not DoHMIFollowMenus("cis:index", "2", DAP_FILE) Then
        LogResult "Unable to refresh forum list."
        Exit Sub
    End If

    Terminal.Print "Collecting forum list.  Please wait..." + Basic.Eoln$
    page = "CIS:IND-41"

    HMIGetFile filepage

    ' Open forum list file to write to
    On Error Goto GetForumList_error
    DeleteFile filename
    Open filename For Binary Access Write Shared As #1

    count = 0
    Terminal.TransferStatus False, "Forum list", count, filepage.dwSize
    s = DAPReceiveFile(HMI_STATE_FIRST%, page, i)
    Do While i>0 And s<>""
        Put #1, , s
        count = count + i
        Terminal.TransferStatus False, "Forum list", count, filepage.dwSize
        s = DAPReceiveFile(HMI_STATE_NEXT%, page, i)
    Loop
    Close #1
    Terminal.TransferStatus

    ReportSuccess id & " : Collected new forum list"
    Exit Sub

GetForumList_error:
    Close #1
    Terminal.TransferStatus
    LogResult "Error : " + FullErrorMessage()
    LogResult id & " : Failed to collect forum list"
    Exit Sub
End Sub

'T:Announcements (subroutine) (CompuServe)
Sub Announcements(id As String, forum As String)
    If Not HMIGotoForum(forum) Then
        LogResult id + " : Failed : Unable to collect announcements from "+forum
        Exit Sub
    End If

    Terminal.Print "Collecting forum Announcements"+Basic.Eoln$
    RecordBulletins forum, False, True, False
    RecordSectionInformation forum

    If id<>"" Then ReportSuccess id & " : Announcements collected from " & forum & " "
End Sub

'T:Newsflash (subroutine) (CompuServe)
Sub Newsflash(id As String, forum As String)
    If Not HMIGotoForum(forum) Then
        LogResult id + " : Failed : Unable to collect newsflash from "+forum
        Exit Sub
    End If

    Terminal.Print "Collecting forum Newsflash"+Basic.Eoln$
    RecordBulletins forum, True, False, False
    If id<>"" Then ReportSuccess id & " : Newsflash collected from " & forum & " "
End Sub

Function ParseSectionList(ByVal sect As String, ByVal validsects As Long, _
                          ByRef count As Integer) As Long
    Dim s As String, l As Integer, h As Integer, sl As Long, xsl As Long

    count = 0
    sect = LTrim(sect)
    ReplaceAllInString sect, ",", " "    ' handle comma as separator
    If sect = "*" Or StrComp(sect, "ALL", 1)=0 Then
        ParseSectionList = validsects
        For l = 0 To 24
            sl = 2^l
            If (validsects And sl)=sl Then count = count + 1
        Next
        Exit Function
    End If
    s = ParseString(sect, " ")      'Numbers are separated by spaces
    While s > ""
        l = Instr(s, "-")           'Allowed to use range - e.g. 3-6
        If l > 0 Then               'We have a range
            h = Val(Mid$(s, l + 1)) 'High value of range
            For l = Val(s) To h     'From low to high value
                sl = sl Or (2 ^ l)  'Set appropriate bits
            Next
        Else
            If UCase$(s)<>"Y" Then
                l = Val(s)              'Value
                sl = sl Or (2 ^ l)      'Set appropriate bit
            End If
        End If
        s = ParseString(sect, " ")  'Numbers are separated by spaces
    Wend
    xsl = sl And validsects
    ParseSectionList = xsl
    For l = 0 To 24
        If (xsl And 2^l)=2^l Then count = count + 1
    Next
End Function

Sub SaveMessage(hdr As FAPMSGHEADER, body As String)
    Dim section As String, n As String, l As Integer, tail As String
    Dim f As String

    ' Valid message?
    If hdr.lpOriginatorId="" And hdr.lpRecipientName="" Then Exit Sub

    ' Check to see if it's a fake reply
    If Mid$(hdr.lpSubject, 1, 1)="#" And hdr.dwParentMsg=0 Then
        tail = ""
        For l = 1 To Len(hdr.lpSubject)
            If InStr("1234567890", Mid$(hdr.lpSubject, l, 1)) Then
                tail = tail + Mid$(hdr.lpSubject, l, 1)
            End If
            If Mid$(hdr.lpSubject, l, 1)="-"  And tail<>"" Then
                hdr.dwParentMsg = Val(tail)
                hdr.lpSubject = Mid$(hdr.lpSubject, l+1, Len(hdr.lpSubject)-l)
                l = Len(hdr.lpSubject)
            End If
        Next
        tail = ""
    End If

    ' Flags
    f = ""
    If (hdr.cFlags And FAP_MSG_IS_PRIVATE%)<>0 Then
        f = "-- PRIVATE MESSAGE --" & Chr$(10)
    End If
    If (hdr.cFlags And FAP_MSG_HELD%)<>0 Then
        f = "-- HOLD MESSAGE --" & Chr$(10)
    End If
    If (hdr.cFlags And FAP_READ_BY_RECIPIENT%)<>0 Then
        f = f + "Read-By-Recipient: Yes" & Chr$(10)
    Else
        f = f + "Read-By-Recipient: No" & Chr$(10)
    End If

    l = Len(hdr.lpSubject) + Len(f) + Len(hdr.lpOriginatorName) + _
        Len(hdr.lpOriginatorId) + Len(hdr.lpRecipientName) + _
        Len(hdr.lpRecipientId) + 24 + Len(body)
    If hdr.wNumReplies = 1 Then
        tail = "There is 1 Reply" & Chr$(10)
        Else If hdr.wNumReplies > 1 Then
            tail = "There are " & hdr.wNumReplies & " Replies" & Chr$(10)
        End If
    End If
    l = l - ItemCount(body, Chr$(13)) ' Don't count both CR+LF
    If tail > "" Then
        l = l + Len(tail)
    End If
    CaptureLine ""
    If SectionMsgIds(hdr.cSectionId) >= 0 Then
        section = szMsgSection(SectionMsgIds(hdr.cSectionId)).lpTitle
    Else
        section = "Unknown"
    End If
    If body="*** Header Only ***" & Chr$(10) Then
        n = "*header*"
        body = body + Chr$(10) + "[Double-click here to mark the message for collection]"
        l = l + 55
    Else
        n = hdr.lpOriginatorName
        ReplaceAllInString n, " ", "_"
    End If
    ReplaceAllInString hdr.lpOriginatorName, ";", " "
    ReplaceAllInString hdr.lpRecipientName, ";", " "
    nummessages = nummessages + 1
    Terminal.CaptureStatus nummessages
    CaptureLine "=========="
    CaptureText CurrentForum & "/S" & hdr.cSectionId & "_" & section & " #"
    CaptureText hdr.dwMsgNo & ", from " & n
    CaptureLine ", " & l & " chars, " & MakeDateString(hdr.tsDate)
    If hdr.dwParentMsg Then CaptureLine "Comment to " & hdr.dwParentMsg & "."
    CaptureLine "----------"
    CaptureLine "Subject: " & hdr.lpSubject
    If f<>"" Then CaptureText f
    CaptureLine "Fm: " & hdr.lpOriginatorName & " " & hdr.lpOriginatorId
    CaptureLine "To: " & hdr.lpRecipientName & " " & hdr.lpRecipientId
    CaptureLine ""
    CaptureText body
    CaptureLine ""
    If tail > "" Then
        CaptureLine tail
    End If
End Sub

Sub WriteLibraryMessage(forum As String, filedesc As FAPFILEDESCRIPTION, downloaded As String)
    Dim l As Long, sectname As String, from As String, hdr As String
    Dim d0 As String, d1 As String, d2 As String, flags As String
    Dim fn As String, sectno As Integer

    from = filedesc.lpUserName
    fn = filedesc.lpFilename
    ReplaceAllInString from, " ", "_"
    ReplaceAllInString fn, " ", "_"
    d0 = MakeDateString(filedesc.tsSubmitted)
    d1 = MakeDateString(filedesc.tsLastAccess)
    d2 = MakeDateString(filedesc.tsReleaseDate)
    If d0="" Then d0 = MyDate$

    ' RFC 822 type header
    hdr = "Subject: " & filedesc.lpTitle & Chr$(10) & _
          "From: " & filedesc.lpUserName & " " & filedesc.lpUserID & Chr$(10) & _
          "Date-Submitted: " & d0 & Chr$(10)
    If d1<>"" Then hdr = hdr & "Date-Last-Access: " & d1 & Chr$(10)
    If d2<>"" Then hdr = hdr & "Date-Released: " & d2 & Chr$(10)
    hdr = hdr & "Filename: " & filedesc.lpFilename & Chr$(10) & _
          "File-Type: " & GetFileType(filedesc.nFileType) & Chr$(10) & _
          "File-Size: " & filedesc.dwFileSize & Chr$(10) & _
          "Access-Count: " & filedesc.dwAccessCount & Chr$(10) & _
          "Catalog-No: " & filedesc.dwCatalogNo & Chr$(10) & _
          "Keywords: " & filedesc.lpKeys & Chr$(10)
    If filedesc.lpSysOpComment <> "" Then
        hdr = hdr & "SysOp-Comment: " & filedesc.lpSysOpComment & Chr$(10)
    End If

    sectno = filedesc.cLibSectionNo
    If SectionLibIds(sectno) >= 0 Then
        sectname = szLibSection(SectionLibIds(sectno)).lpTitle
    Else
        sectname = "Unknown"
    End If

    ' For new uploads
    If filedesc.cOptions And FAP_FILE_DELETABLE Then flags = flags + ",Deletable"
    If filedesc.cOptions And FAP_FILE_NON_PUBLIC Then flags = flags + ",Not public"
    If filedesc.cOptions And FAP_FILE_MARKED_FOR_DELETION Then flags = flags + ",Marked for deletion"
    If filedesc.cOptions And FAP_FILE_HAS_FEE Then flags = flags + ",Chargeable"
    If flags > "" Then hdr = hdr & "Flags: " & Mid$(flags, 2) & Chr$(10)
    If filedesc.cOptions And FAP_FILE_MARKED_FOR_DELETION Then
        hdr = hdr & Chr$(10) & "*New Erase*" & Chr$(10)
        sectname = sectname + "_[Sysop]"
    ElseIf filedesc.cOptions And FAP_FILE_NON_PUBLIC Then
        hdr = hdr & Chr$(10) & "*New Upload*" & Chr$(10)
        sectname = sectname + "_[Sysop]"
    End If

    l = 2+Len(hdr+filedesc.lpAbstract)-ItemCount(filedesc.lpAbstract, Chr$(13))

    ' Downloaded to...
    If downloaded<>"" Then
        l = l+Len("[]Downloaded to "+FileUrl(downloaded))+1
    End If

    ' CIX header
    CaptureLine "=========="
    CaptureText forum & "/L" & sectno & "_" & sectname
    CaptureText " #" & LTrim(Str(filedesc.dwCatalogNo))
    CaptureLine ", from " & fn & ", " & l & " chars, " & d0
    CaptureLine "----------"
    CaptureLines hdr
    CaptureLines Chr$(10)+filedesc.lpAbstract+Chr$(10)+Chr$(10)
    If downloaded<>"" Then
        CaptureLine "[Downloaded to "+FileUrl(downloaded)+"]"+Chr$(10)
    End If
End Sub