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

Text File | 1999-10-06 | 35.4 KB | 909 lines

'T:HMIMAIL.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 Sub AddToMsgFile(SourceFileName as String)
Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean
Declare Function MyDate$
Declare Sub ReportSuccess(msg As String)
Declare Function ForumName(ByVal forum As String) As String
Declare Function FullErrorMessage() As String
Declare Function MakeDateString(s As HMITIMESTAMP) As String
Declare Sub CaptureLine(textline As String)
Declare Sub AddToFile(TargetFileName As String, SourceFileName as String)
Declare Function FileUrl(fn As String) As String

Const BlockSize = 2048

'T:iFlags for CompuServe (constant)
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 fBINARY = 8         'CIS binary file
Const fDONTCOPY = 16     'don't copy the message back to you

Public DownloadDir As String
Public WorkingPath As String
Public WhereAmI As String
Public currentCAP As Integer
Public EMPconfig As EMPCONFIG
Public MailName As String
Public PersonalAddress As String
Dim MailSubject As String, MailFilename As String
Dim MailAddresses As String
Dim MailCount As Integer, MailFlags As Integer
Dim OldMail As Boolean, MailSent As Boolean

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

' enum EMPCONTENTTYPES:
Const EMP_TEXT% = 0                                  ' Ascii Text Object
Const EMP_BINARY% = EMP_TEXT + 1                  ' 8-bit data
Const EMP_GIF% = EMP_BINARY + 1                      ' Graphic Interchange Format
Const EMP_BINARY_FILE% = EMP_GIF + 1              ' Contents_Name contains filename
Const EMP_TEXT_FILE% = EMP_BINARY_FILE + 1          ' Text file
Const EMP_TEXT_OBJECT% = EMP_TEXT_FILE + 1        ' TextObject message
Const EMP_JPEG% = EMP_TEXT_OBJECT + 1

' enum EMPIMPORTANCETYPES:
Const EMP_LOW_IMPORTANCE% = 0
Const EMP_NORMAL_IMPORTANCE% = EMP_LOW_IMPORTANCE + 1
Const EMP_HIGH_IMPORTANCE% = EMP_NORMAL_IMPORTANCE + 1

' enum EMPSENSITIVITYTYPES:
Const EMP_STANDARD% = 0

' enum EMPSEARCHTYPES:
Const EMP_SUBJECT% = 0
Const EMP_ORIGINATOR% = EMP_SUBJECT + 1
Const EMP_IMPORTANCE% = EMP_ORIGINATOR + 1
Const EMP_SENSITIVITY% = EMP_IMPORTANCE + 1
Const EMP_READ% = EMP_SENSITIVITY + 1
Const EMP_UNREAD% = EMP_READ + 1
Const EMP_DATE% = EMP_UNREAD + 1
Const EMP_BEFOREDATE% = EMP_DATE
Const EMP_AFTERDATE% = EMP_DATE
Const EMP_MESSAGEID% = 8

' Options:
Const EMP_CAN_RECEIVE_MULTIPLE% = &H1
Const EMP_AUTO_DELETE% = &H1

' Restrictions:
Const EMP_CANT_SEND% = &H1
Const EMP_ONLY_ONE_CONTENT% = &H2
Const EMP_CANT_DELAY_DELETE% = &H4
Const EMP_NO_FORWARD_MSG% = &H8
Const EMP_NO_SURCHARGES_ON_SEND% = &H10

' Components
Const EMP_SRC_TOTAL_SIZE% = &H4

' Components:
Const EMP_MHC_MSG_ID% = &H1
Const EMP_MHC_DATE% = &H2
Const EMP_MHC_ORIGINATOR_ADDR% = &H4
Const EMP_MHC_RECIPIENT_OPTIONS% = &H8
Const EMP_MHC_PRIMARY_RECIPIENTS% = &H10
Const EMP_MHC_COPY_RECIPIENTS% = &H20
Const EMP_MHC_IN_REPLY_TO% = &H40
Const EMP_MHC_TABLE_OF_CONTENTS% = &H80
Const EMP_MHC_EXTENDED_ENVELOPES% = &H100
Const EMP_MHC_EXPIRATION_TIME% = &H200

' Type of Recipient
' enum EMPCOPYTYPES:
Const EMP_PRIMARY_RECIPIENT% = 0
Const EMP_COPY_RECIPIENT% = EMP_PRIMARY_RECIPIENT + 1
Const EMP_BLIND_COPY% = EMP_COPY_RECIPIENT + 1

' Msg Release options
Const EMP_MRO_DELAY_RELEASE% = &H1
Const EMP_MRO_SET_EXPIRE% = &H2
Const EMP_MRO_REPLY_TO% = &H4
Const EMP_MRO_APPEND_DISTRIBUTION% = &H8
Const EMP_MRO_EXTENDED_ENVELOPES% = &H10
Const EMP_MRO_FORWARD_MSG% = &H20

' enum EMPRETENTIONTYPES:
Const EMP_USE_DEFAULT_RETENTION% = 0
Const EMP_USE_MAXIMUM_RETENTION% = EMP_USE_DEFAULT_RETENTION + 1
Const EMP_RETAIN_UNTIL_DATE% = EMP_USE_MAXIMUM_RETENTION + 1
Const EMP_DELETE_NORMAL% = EMP_RETAIN_UNTIL_DATE + 1
Const EMP_DELETE_REGARDLESS% = EMP_DELETE_NORMAL + 1
Const EMP_USE_MAXIMUM_RETENTION_REGARDLESS% = EMP_DELETE_REGARDLESS + 1
Const EMP_RETAIN_UNTIL_DATE_REGARDLESS% = EMP_USE_MAXIMUM_RETENTION_REGARDLESS + 1
Const EMP_DELETE_NORMAL_REGARDLESS% = EMP_RETAIN_UNTIL_DATE_REGARDLESS + 1

Function HMIGotoMail()
    Dim i As Integer

    If WhereAmI="cis:mail" Then
        HMIGotoMail = True
        Exit Function
    End If

    SetHighMessageNumber

    On Error Goto GoMail_Error
    If DoHMIGotoPage("cis:mail", -1, CAP_EMAIL) Then
        EMPGetConfig EMPconfig, "", "", 0
        WhereAmI = "cis:mail"
        HMIGotoMail = True
        If EMPconfig.wRestrictions And EMP_ONLY_ONE_CONTENT% Then OldMail = True
        Exit Function
    End If
GoMail_Error:
    WhereAmI = ""
    HMIGotoMail = False
End Function

Function GetMailType(i As Integer) As String
    Select Case i
        Case EMP_TEXT%
            GetMailType = "Ascii"
        Case EMP_BINARY%
            GetMailType = "Binary"
        Case EMP_GIF%
            GetMailType = "GIF"
        Case EMP_BINARY_FILE%
            GetMailType = "Binary file"
        Case EMP_TEXT_FILE%
            GetMailType = "Text file"
        Case EMP_TEXT_OBJECT%
            GetMailType = "Text object"
        Case EMP_JPEG%
            GetMailType = "JPEG"
        Case Else
            GetMailType = "Unknown type - " & Str(i)
    End Select
End Function

'T:MailTo (subroutine) (CompuServe)
Sub MailTo(id As String, user As String, flags As Integer, subject As String, filename As String)
    Dim inpline As String

    If Not HMIGotoMail() Then
        LogResult id + " : Failed : Mail is unavailable : " + FullErrorMessage
        Exit Sub
    End If

    If EMPconfig.wRestrictions And EMP_CANT_SEND% Then
        LogResult id + " : Failed : You are not allowed to send messages"
        Exit Sub
    End If
    MailSubject = Left$(subject, 40)
    MailFilename = filename
    MailCount = 0
    MailAddresses = ""
    MailFlags = flags

    ' The primary recipient
    MailCC user
End Sub

'T:MailCC (subroutine) (CompuServe)
Sub MailCC(cc As String)
    Dim realname As String, email As String, ipname As String
    Dim RemoveRecipient As Boolean

    ' Get the email address
    AnalyseName cc, realname, email
    If email="" Then email = realname

    ' Check to see if we're sending an IP msg to ourselves
    ipname = "internet:"+Session.LoginName+"@compuserve.com"
    ReplaceAllInString ipname, ",", "."
    If StrComp(email, ipname, 1)=0 Then RemoveRecipient = True
    If StrComp(email, Mid$(ipname, 10), 1)=0 Then RemoveRecipient = True
    If StrComp(email, PersonalAddress+"@compuserve.com", 1)=0 Then RemoveRecipient = True

    ' Check to see if we're sending an internal msg to ourselves
    If StrComp(email, PersonalAddress, 1)=0 Then RemoveRecipient = True
    If StrComp(email, Session.LoginName, 1)=0 Then RemoveRecipient = True

    If RemoveRecipient=False Then
        MailCount = MailCount + 1
        If MailAddresses="" Then
            MailAddresses = cc
        Else
            MailAddresses = MailAddresses + Chr$(10) + cc
        End If
    End If
End Sub

'T:SetEnvelope (subroutine) (CompuServe)
Sub SetEnvelope(envelope As EMPENVELOPE, user As String, UrgentMail As Boolean)
    AnalyseName user, envelope.lpRecipientName, envelope.lpRecipientAddr
    If envelope.lpRecipientName = "" Then
        envelope.lpRecipientName = envelope.lpRecipientAddr
    End If
    If envelope.lpRecipientAddr = "" Then
        envelope.lpRecipientAddr = envelope.lpRecipientName
    End If

    If UrgentMail Then
        envelope.moOptions.cImportance = EMP_HIGH_IMPORTANCE%
    Else
        envelope.moOptions.cImportance = EMP_NORMAL_IMPORTANCE%
    End If
    envelope.moOptions.cSensitivity = EMP_STANDARD%
    envelope.moOptions.cReceiptNotification = 0
    envelope.nType = EMP_COPY_RECIPIENT
End Sub

'T:PreProcessMail (subroutine) (CompuServe)
Function PreProcessMail(InFileName As String, OutFileName As String, _
                   ByRef InReplyTo As String, ByRef RealName As String, _
                   ByRef UrgentMail As Boolean) As Boolean
    Dim OutFileNum as Integer, InFileNum as Integer
    Dim TheData as String
    Dim count As Long

    count = 0
    On Error Goto PreProcessMail_error

    InFileNum = FreeFile()
    Open InFileName For Input Access Read Shared As #InFileNum

    OutFileNum = FreeFile()
    Open OutFileName for Output Access Write Shared as #OutFileNum

    ' Send as shown
    Print #OutFileNum, "@l";

    ' Operate on blocks of BlockSize at a time
    Do While Not Eof(InFileNum)
        Line Input #InFileNum, TheData

        ' Is this from somebody else ?
        If count<3 And Mid$(TheData, 1, 6)="From: " Then
            RealName = Mid$(TheData, 7)
        ElseIf count<3 And Mid$(TheData, 1, 13)="In-Reply-To: " Then
            InReplyTo = Mid$(TheData, 15)
            ReplaceAllInString InReplyTo, ">", ""
        ElseIf count<3 And Mid$(TheData, 1, 14)="Priority: High" Then
            UrgentMail = True
        Else
            ReplaceAllInString TheData, "@", "@@"
            Print #OutFileNum, TheData + Chr$(10);
        End If
        count = count + 1
    Loop
    Print #OutFileNum, " ";

    Close #InFileNum
    Close #OutFileNum
    PreProcessMail = True
    Exit Function

PreProcessMail_error:
    LogResult "Error in PreProcessMail : " + Str$(Err) + " in line " + Str$(Erl) + ":" + Error$
    Close #InFileNum
    Close #OutFileNum
    PreProcessMail = False
End Function

'T:SendMail (subroutine) (CompuServe)
Sub SendMail(id As String)
    Dim filename As String, header As String, user As String
    Dim sendresponse As EMPSENDRESPONSE
    Dim envelopes() As EMPENVELOPE
    Dim badenvelopes() As EMPBADENVELOPE
    Dim contents(0 To 0) As EMPCONTENTSDESC
    Dim forward As String, InReplyTo As String, RealName As String
    Dim notime As HMITIMESTAMP
    Dim i As Integer, j As Integer
    Dim addresses As String, badaddresses As String, badcount As Integer
    Dim path As String, sname As String, nState As Integer
    Dim SourceFileNum as Integer, SourceFileAt as Long
    Dim SourceFileLen as Long, TheData as String, BytesToRead as Long
    Dim confirm As EMPCONFIRMATION
    Dim mroOptions As Integer, UrgentMail As Boolean
    Dim tmpFilename As String, tmp As String

    On Error Goto SendMail_error
    MailSent = False
    MailCount = MailCount - 1
    If MailCount < 0 Then
        LogResult id+" : SendMail Failed : No valid destination addresses"
        Terminal.TransferStatus
        Exit Sub
    End If

    Terminal.Print "Sending mail " + MailSubject + Basic.Eoln$

    InReplyTo = ""
    RealName = MailName
    UrgentMail = False
    If (MailFlags And fBINARY)=fBINARY Then
        ' Binary mail
        SplitPath MailFilename, path, sname
        contents(0).nType = EMP_BINARY_FILE%
        tmpFilename = MailFilename
    Else
        ' ASCII mail
        sname = "Mail Message"
        contents(0).nType = EMP_TEXT_OBJECT%

        ' Process header lines and add formatting codes
        tmpFilename = WorkingPath + "sendmail.txt"
        If Not PreProcessMail(MailFilename, tmpFilename, InReplyTo, RealName, UrgentMail) Then
            Exit Sub
        End If
    End If
    contents(0).dwSize = FileLen(tmpFilename)
    contents(0).dwSurcharge = 0

SendMail_retry:
    ReDim envelopes(0 To MailCount)
    addresses = MailAddresses
    user = ParseString(MailAddresses, Chr$(10))
    SetEnvelope envelopes(0), user, UrgentMail

    If MailCount >= 1 Then
        For i = 1 To MailCount
            user = ParseString(MailAddresses, Chr$(10))
            SetEnvelope envelopes(i), user, UrgentMail
        Next
    End If

    ' Make sure it's a legal In-Reply-To otherwise newmail dies
    tmp = Left$(InReplyTo, 2)
    If tmp<>"MC" And IsNumeric(tmp)=False Then InReplyTo = ""
    If Len(InReplyTo) > 35 Then InReplyTo = ""

    envelopes(0).moOptions.cReceiptNotification = ((MailFlags And fRECEIPT) <> 0)
    envelopes(0).nType = EMP_PRIMARY_RECIPIENT%
    mroOptions = EMP_MRO_APPEND_DISTRIBUTION%
    If InReplyTo<>"" Then mroOptions = mroOptions Or EMP_MRO_REPLY_TO%
    EMPSendMsgHeader sendresponse, badenvelopes(), mroOptions, _
            MailSubject, RealName, notime, notime, InReplyTo, envelopes(), _
            contents(), MailCount + 1, "", forward
    If sendresponse.wCount > 0 Then
        For i = 0 To Ubound(badenvelopes)
            j = badenvelopes(i).wNumber - 1
            envelopes(j).nType = badenvelopes(i).cReason
            envelopes(j).moOptions.cImportance = 255
        Next
        MailCount = -1
        MailAddresses = ""
        For i = 0 To Ubound(envelopes)
            user = ParseString(addresses, Chr$(10))
            If envelopes(i).moOptions.cImportance = 255 Then
                LogResult id + " : Invalid address (" & _
                    envelopes(i).nType & "): " + user
                badaddresses = badaddresses + user + Chr$(10)
                badcount = badcount + 1
            Else
                MailAddresses = MailAddresses + user + Chr$(10)
                MailCount = MailCount + 1
            End If
        Next
        If MailCount >= 0 Then Goto SendMail_retry
        LogResult id+" : SendMail Failed : No valid destination addresses"
        Exit Sub
    End If

    ' Find out length of the message/file
    SourceFileLen = FileLen(tmpFilename)
    If SourceFileLen <= 0 Then
        LogResult id+" : SendMail Failed : Can't upload file"
        Exit Sub
    End If

    ' Send the file
    BytesToRead = SourceFileLen
    SourceFileNum = FreeFile()
    Open tmpFilename for Binary Access Read Shared as #SourceFileNum
    SourceFileAt = 1        'read point

    TheData = String$(BlockSize, " ")
    nState = HMI_STATE_FIRST%
    Terminal.TransferStatus True, sname, 0, SourceFileLen

    ' Operate on blocks of BlockSize at a time
    Do While BytesToRead > BlockSize
        Get #SourceFileNum, SourceFileAt, TheData
        i = EMPSendMsgContents(nState, 1, MailSubject, sname, contents(0).nType, TheData)
        BytesToRead = BytesToRead - BlockSize
        SourceFileAt = SourceFileAt + BlockSize
        nState = HMI_STATE_NEXT%
        Terminal.TransferStatus True, sname, SourceFileAt-1, SourceFileLen
    Loop

    ' Now do the last block of less than BlockSize
    If BytesToRead > 0 then
        TheData = String$(BytesToRead, " ")
        Get #SourceFileNum, SourceFileAt, TheData
        i = EMPSendMsgContents(nState, 1, MailSubject, sname, contents(0).nType, TheData)
    End If
    Terminal.TransferStatus True, sname, SourceFileLen, SourceFileLen
    i = EMPSendMsgContents(HMI_STATE_NEXT%, 1, MailSubject, sname, contents(0).nType, "")
    Close #SourceFileNum
    Terminal.TransferStatus

    ' Check it succeeded
    EMPGetConfirmation confirm
    If confirm.lpMsgID <> "" Then
        ReportSuccess id & " : Posted Mail " & MailSubject
        MailSent = True
    End If

    If (MailFlags And fDONTCOPY)=0 Then
        ' Write message back to yourself
        header = "Date: " + MyDate$ + Chr$(10)
        If PersonalAddress="" Then
            header = header + "From: " + RealName + " [" + Session.LoginName + "]" + Chr$(10)
        Else
            header = header + "From: " + RealName + " [" + PersonalAddress + "]" + Chr$(10)
        End If
        header = header + "Subject: " + MailSubject + Chr$(10)
        header = header + "Message-Id: <" & confirm.lpMsgID & ">" + Chr$(10)
        If InReplyTo<>"" Then
            header = header + "In-Reply-To: <" & InReplyTo & ">" + Chr$(10)
        End If
        header = header + "Content-Type: " & GetMailType(contents(0).nType) & Chr$(10)

        user = ParseString(addresses, Chr$(10))
        If Mid$(user, 1, 9)="internet:" Then user = Mid$(user, 10)
        header = header + "To: " + user + Chr$(10)
        For i = 1 To MailCount
            user = ParseString(addresses, Chr$(10))
            If Mid$(user, 1, 9)="internet:" Then user = Mid$(user, 10)
            If i=1 Then header = header + "Cc:"
            header = header + " " + user + Chr$(10)
        Next
        For i = 1 To badcount
            user = ParseString(badaddresses, Chr$(10))
            If Mid$(user, 1, 9)="internet:" Then user = Mid$(user, 10)
            header = header + "X-BadAddress: " + user + Chr$(10)
        Next

        ' Create temp file, and put message in it
        filename = UniqueFilename$()
        On Error Goto MailTo_error
        Open filename For Output Access Write Shared As #1
        Print #1, "#pragma ciscontrol=yes"
        Print #1, "Memo #1 (" & Len(header) + SourceFileLen & ")"
        Print #1, header
MailTo_error:
        Close #1
        AddToFile filename, tmpFilename
        result = QueueFile(Session.Service, filename, IM_DELETE)
    End If
    If (MailFlags And fBINARY)=0 Then DeleteFile tmpFilename
    Exit Sub

SendMail_error:
    ' Report error to user
    LogResult id+" : SendMail Failed : Error :" & FullErrorMessage
    Terminal.TransferStatus
End Sub

Function ListUsers(recipient() As EMPNAMEANDADDR, erecipient() As EMPNAMEANDADDR) As String
    Dim u As String, n As String, i As Integer

    On Error Resume Next
    For i = 0 To Ubound(recipient)
        If recipient(i).lpAddr <> "" Then
            ReplaceAllInString recipient(i).lpName, ";", " "
            If UCase$(Mid$(recipient(i).lpAddr, 1, 9))="INTERNET:" Then
                u = Mid$(recipient(i).lpAddr, 10)
            Else
                If Mid$(recipient(i).lpAddr, 1, 1)="[" Then
                    u = recipient(i).lpName+" "+recipient(i).lpAddr
                Else
                    u = recipient(i).lpName+" ["+recipient(i).lpAddr+"]"
                End If
            End If
            If n="" Then
                n = u
            Else
                n = n + Chr$(10) + " " + u
            End If
        End If
    Next
    For i = 0 To Ubound(erecipient)
        If erecipient(i).lpAddr <> "" Then
            ReplaceAllInString erecipient(i).lpName, ";", " "
            If UCase$(Mid$(erecipient(i).lpAddr, 1, 9))="INTERNET:" Then
                u = Mid$(erecipient(i).lpAddr, 10)
            Else
                If Mid$(erecipient(i).lpAddr, 1, 1)="[" Then
                    u = erecipient(i).lpName+" "+erecipient(i).lpAddr
                Else
                    u = erecipient(i).lpName+" ["+erecipient(i).lpAddr+"]"
                End If
            End If
            If n="" Then
                n = u
            Else
                n = n + Chr$(10) + " " + u
            End If
        End If
    Next
    On Error Goto 0
    n = Trim$(n)
    If n <> "" And Right$(n, 1)=Chr$(10) Then
        ListUsers = Mid$(n, 1, Len(n)-1)
    Else
        ListUsers = Trim$(n)
    End If
End Function

Function ExtractX400Name(xaddr As String) As String
    Dim i As Integer, realname As String

    i = InStr(xaddr, "g=", 1)
    If i<>0 Then realname = Mid$(xaddr, i+2)
    i = InStr(realname, ")")
    If i<>0 Then realname = Mid$(realname, 1, i-1)
    i = InStr(xaddr, "s=", 1)
    If i<>0 Then realname = realname + " " + Mid$(xaddr, i+2)
    i = InStr(realname, ";")
    If i<>0 Then realname = Mid$(realname, 1, i-1)
    If realname="" Then realname = "X400 Gateway"

    ExtractX400Name = realname
End Function

'T:FetchMail (subroutine) (CompuServe)
Sub FetchMail(id As String)
    Dim hdr As EMPHEADER, precipient() As EMPNAMEANDADDR, b As Boolean
    Dim crecipient() As EMPNAMEANDADDR, content() As EMPCONTENTS
    Dim msgno As Integer, i As Integer, messagefilename As String
    Dim msgtext As String, count As Long, binfname As String
    Dim l As Long, subject As String, obinfname As String, badchars As String
    Dim msgheader As String, searchterm(0 to 0) As EMPSEARCHTERM
    Dim msg() As EMPMSGSUMMARY, userid As String, szStatus() As EMPMSGSTATUS
    Dim lpMsgs() As EMPMSGDISPOSE, disp As EMPDISPOSERESPONSE
    Dim crs As Integer, tmp As String, s As String, realname As String
    Dim contentno As Integer, mailnum As Integer, from As String
    Dim reciplist As EMPRECIPIENTSLIST, eprecipient() As EMPNAMEANDADDR
    Dim ecrecipient() As EMPNAMEANDADDR, deletemail As Boolean
    Dim firstblock As Boolean

    deletemail = ReadIni$("Service "+Session.Service, "Delete Mail", Session.IniFilename)="YES"

    ' The Content() doesn't seem to be working
    Terminal.Print "Checking for new mail..." + Basic.Eoln$

    ' Go MAIL
    If Not HMIGotoMail() Then
        LogResult "Collect Mail : Failed : Mail is unavailable : " + FullErrorMessage
        Exit Sub
    End If
    If EMPconfig.wUnreadMsgs=1 Then
        Terminal.Print "There is 1 unread mail message." + Basic.Eoln$
    Else
        Terminal.Print "There are " & LTrim(Str(EMPconfig.wUnreadMsgs)) & " unread mail messages." + Basic.Eoln$
    End If

    ' Search for any mail
    searchterm(0).nType = EMP_AFTERDATE%
    searchterm(0).lpPattern = "800101:"
    msgno = 0

    ' Start downloading
    On Error Goto ReadMail_error
    messagefilename = UniqueFileName$()
    Capture CAPTURE_ON, messagefilename

    Do
        EMPSearchMsg msg(), 10, msgno, EMP_SRC_TOTAL_SIZE%, searchterm()

        ReDim lpMsgs(0 To UBound(msg))
        For mailnum = 0 To UBound(msg)
            msgno = msg(mailnum).wMsgNo
            If msgno>0 Then
                count = count + 1
                If count=1 Then Terminal.CaptureStatus CAPTURE_ON
                Terminal.CaptureStatus count

                EMPGetMsgHeader hdr, precipient(), crecipient(), content(), msgno, &HFF

                ' Extended recipient list
                If (hdr.wComponents And EMP_MHC_EXTENDED_ENVELOPES%)<>0 Then
                    EMPReadRecipients reciplist, eprecipient(), ecrecipient(), msgno, 1, 50, 1, 50
                End If
                For contentno = 0 To UBound(content)
                    ' Check for empty fields
                    subject = msg(mailnum).lpSubject
                    If subject="" Then subject = "==== No Subject ===="
                    If Mid(hdr.lpOriginatorAddr, 1, 1)="[" Then
                        userid = hdr.lpOriginatorAddr
                    Else
                        userid = "["+hdr.lpOriginatorAddr+"]"
                    End If

                    ' Get realname out of X400 mess
                    If Left$(msg(mailnum).lpOriginatorName, 5)="X400:" Then
                        realname = ExtractX400Name(msg(mailnum).lpOriginatorName)
                    Else
                        realname = msg(mailnum).lpOriginatorName
                    End If
                    ReplaceAllInString realname, ";", " "

                    ' Tell the user what's happening
                    Terminal.Print realname & " " & _
                                   MakeDateString(hdr.tsDate) & " " & subject
                    If UBound(content)>0 Then Terminal.Print ", Part" & Str(contentno+1) & " of" & Str(UBound(content)+1) & "."
                    Terminal.Print Basic.Eoln$

                    If content(contentno).nType=EMP_TEXT% Or _
                       content(contentno).nType=EMP_TEXT_FILE% Or _
                       content(contentno).nType=EMP_TEXT_OBJECT% Then
                        ' Generate the message header
                        msgheader = "Date: " & MakeDateString(hdr.tsDate) & Chr$(10) & _
                                    "From: " & realname & " " & userid & Chr$(10) & _
                                    "Subject: " & subject & Chr$(10) & _
                                    "Message-Id: <" & hdr.lpMsgID & ">" & Chr$(10) & _
                                    "Content-Type: " & GetMailType(content(contentno).nType) & Chr$(10)
                        If hdr.lpInReplyTo>"" Then msgheader = msgheader + "In-Reply-To: <" + hdr.lpInReplyTo + ">" + Chr$(10)
                        msgheader = msgheader + "To: " + ListUsers(precipient(), eprecipient()) + Chr$(10)
                        tmp = ListUsers(crecipient(), ecrecipient())
                        If tmp<>"" Then msgheader = msgheader + "Cc: " + tmp + Chr$(10)
                        If hdr.moOptions.cImportance = 0 Then msgheader = msgheader + "Priority: Low" + Chr$(10)
                        If hdr.moOptions.cImportance = 1 Then msgheader = msgheader + "Priority: Normal" + Chr$(10)
                        If hdr.moOptions.cImportance = 2 Then msgheader = msgheader + "Priority: Urgent" + Chr$(10)

                        ' Get first block so we can check it's not CIS's
                        ' dreadful automatic MIME decode junk
                        l = 1
                        firstblock = True
                        Terminal.TransferStatus False, "Mail Message", 0, content(contentno).dwSize
                        msgtext = EMPReadTextContents(msgno, content(contentno).cNumber, l, BlockSize)

                        'Terminal.Print "Orig=" + hdr.lpOriginatorAddr + basic.eoln$

                        ' Do we need to use our own header
                        from = LCase$(hdr.lpOriginatorAddr)
                        If Mid$(from, 1, 9)="internet:" And _
                           from<>"internet:[e-mail]" And _
                           Left$(msgtext, 9)<>"Contents:" Then
                            msgheader = ""
                        End If

                        ' Translate control characters?
                        If Mid$(from, 1, 9)="internet:" Then
                            CaptureText Chr$(10) & "#pragma ciscontrol=no"
                        Else
                            CaptureText Chr$(10) & "#pragma ciscontrol=yes"
                        End If

                        ' Write the header + size
                        l = content(contentno).dwSize + Len(msgheader) + 1
                        CaptureText Chr$(10) & "Memo #" & LTrim(Str(msgno)) & " (" & l & ")" & Chr$(10)
                        If msgheader<>"" Then CaptureText msgheader & Chr$(10)

                        ' Get the body text and write it out
                        l = 1
                        crs = 0
                        Do
                            If Not firstblock Then
                                msgtext = EMPReadTextContents(msgno, content(contentno).cNumber, l, BlockSize)
                            End If
                            firstblock = False
                            l = l + Len(msgtext)
                            Terminal.TransferStatus False, "Mail Message", l-1, content(contentno).dwSize
                            crs = crs + ItemCount(msgtext, Chr$(13))
                            CaptureText msgtext
                        Loop Until msgtext=""
                        If l < content(contentno).dwSize Then
                            CaptureText String$(content(contentno).dwSize - l, " ")
                        End If
                        CaptureLine String$(crs, " ")
                        Terminal.TransferStatus
                    Else
                        ' Try to figure out the filename
                        If content(contentno).lpName="" Then
                            binfname = subject
                        Else
                            binfname = Filename$(content(contentno).lpName)
                        End If
                        obinfname = binfname
                        LogResult "Downloading binary mail:" & binfname

                        ' Support long file names in 32-bit version
                        If Basic.OS = ebWin32 Then
                            badchars = "[]:;'""{}<>,+=*"+Chr$(13)
                        Else
                            badchars = " []:;'""{}<>,+=*"+Chr$(13)
                        End If

                        ' Figure out mail filename - truncate at invalid character.
                        binfname = Trim$(binfname)
                        For i=1 to Len(binfname)
                            If InStr(badchars, Mid$(binfname, i, 1)) Then
                                binfname = Mid$(binfname, 1, i-1)
                                Exit For
                            End If
                        Next

                        ' Make sure that whatever I have is a dos legal filename
                        If InStr(binfname, ".")<>0 Then
                            If Basic.OS <> ebWin32 Then
                                binfname = Left$(Left$(binfname,InStr(binfname, ".")-1),8) & "." & Mid$(binfname, InStr(binfname, ".")+1, 3)
                            End If
                            i=InStr(".", binfname)+1
                            i=InStr(".", binfname)
                            If i<>0 Then
                                binfname = Mid$(binfname, 1, i-1)
                            End If
                        End If
                        If UCase$(binfname)="RE" Then binfname = ""

                        If binfname <> obinfname Then LogResult "Name truncated to:" & binfname
                        obinfname = binfname

                        ' Was it a filename?
                        If FileExists(DownloadDir+binfname) Or binfname="" Then
                            ' Generate a filename
                            i = 1
                            Do
                                binfname = "mail"+Ltrim(Str(i))+".bin"
                                i = i+1
                            Loop While FileExists(DownloadDir+binfname)
                        End If
                        If binfname <> obinfname Then LogResult "File exists - renamed to:" & binfname

                        Open DownloadDir+binfname For Binary Access Write Shared As #1
                        l = 1
                        Terminal.TransferStatus False, binfname, 0, content(contentno).dwSize
                        Do
                            msgtext = ""  ' needed to stop out of string space error
                            crs = EMPReadBinaryContents(msgno, _
                                       content(contentno).cNumber, l, msgtext, _
                                       BlockSize)
                            If crs <= 0 Then Exit Do
                            'Work round bug in Terminal 182 which always
                            'sets string length to BlockSize
                            msgtext = Left$(msgtext, crs)
                            Put #1, , msgtext
                            l = l + Len(msgtext)
                            Terminal.TransferStatus False, binfname, l-1, content(contentno).dwSize
                        Loop
                        Terminal.TransferStatus

                        ' Write a message pointing to the file
                        msgheader = "Date: " & MakeDateString(hdr.tsDate) & Chr$(10) & _
                                    "From: " & realname & " " & userid & Chr$(10) & _
                                    "Subject: " & subject & Chr$(10) & _
                                    "Message-Id: <" & hdr.lpMsgID & ">" & Chr$(10) & _
                                    "Content-Type: " & GetMailType(content(contentno).nType) & Chr$(10)
                        If hdr.lpInReplyTo>"" Then msgheader = msgheader + "In-Reply-To: <" + hdr.lpInReplyTo + ">" + Chr$(10)
                        msgheader = msgheader + "To: " + ListUsers(precipient(), eprecipient()) + Chr$(10)
                        tmp = ListUsers(crecipient(), ecrecipient())
                        If tmp<>"" Then msgheader = msgheader + "Cc: " + tmp + Chr$(10)
                        If hdr.moOptions.cImportance = 0 Then msgheader = msgheader + "Priority: Low" + Chr$(10)
                        If hdr.moOptions.cImportance = 1 Then msgheader = msgheader + "Priority: Normal" + Chr$(10)
                        If hdr.moOptions.cImportance = 2 Then msgheader = msgheader + "Priority: Urgent" + Chr$(10)
                        msgheader = msgheader + Chr$(10) + "*** File Message ***" + Chr$(10) + Chr$(10)
                        msgheader = msgheader + "The size of the file is" & Str(content(contentno).dwSize) & " bytes." + Chr$(10)
                        msgheader = msgheader + "The file will be stored in " & FileUrl(DownloadDir + binfname) + Chr$(10) + Chr$(10)
                        If content(contentno).lpSubject<>"" Then
                            msgheader = msgheader + "Additional Information:" + Chr$(10)
                            msgheader = msgheader + content(contentno).lpSubject + Chr$(10)
                        End If

                        ' Write the pseudo msg
                        CaptureText Chr$(10) & "#pragma ciscontrol=yes"
                        CaptureText Chr$(10) & "Memo #" & LTrim(Str(msgno)) & " (" & Len(msgheader) & ")" & Chr$(10)
                        CaptureText msgheader

                        Close #1
                    End If
                Next

                ' Delete the mail we just got
                If deletemail Then
                    lpMsgs(mailnum).nDisposition = EMP_DELETE_REGARDLESS%
                    lpMsgs(mailnum).nMsgNo = msgno
                End If
            End If
        Next
        If deletemail Then EMPSendMsgDisposition disp, szStatus(), lpMsgs()
    Loop Until msgno=0

ReadMail_error:
    If Err<>9 Then
        LogResult "Error in FetchMail : " + FullErrorMessage()
    End If
    On Error Goto 0
    Capture CAPTURE_OFF
    Terminal.CaptureStatus CAPTURE_OFF

    ' Import the mail
    If count > 0 Then
        b = QueueFile(Session.Service, messagefilename, IM_DELETE)
        ReportSuccess id & " :" & Str$(count) & " mail messages have been collected"
    Else
        DeleteFile messagefilename
        ReportSuccess id & " : There was no mail to collect"
    End If
End Sub

'T:ExternalMailAddress (subroutine) (CompuServe)
Function ExternalMailAddress(s As String)
    Dim p As Integer, q As Integer

    p = InStr(s, ":")
    q = InStr(s, " ")
    If p>0 And p<q Then
        ExternalMailAddress = True
    ElseIf OldMail And InStr(s, "@") Then
        ExternalMailAddress = True
    Else
        ExternalMailAddress = False
    End If
End Function

'T:AttachFile (subroutine) (CompuServe)
Sub AttachFile(id As String, filename As String, person As String, _
               eraseafter As String, codetype As String)
    Dim user As String, externalusers As String, localusers As String
    Dim cisfilename As String, fname As String, sent As String
    Dim i As Integer, maxlen As Integer, inBracket As Boolean
    Dim ch As String

    sent = person
    cisfilename = FileName$(filename)
    maxlen = Len(person)
    For i=1 To maxlen
        ch = Mid$(person, i, 1)
        If InBracket And ch=")" Then
            InBracket = False
            user = user + ch
        ElseIf InBracket=False And ch="(" Then
            InBracket = True
            user = user + ch
        ElseIf InBracket=False And ch=";" Then
            If ExternalMailAddress(user) Then
                externalusers = externalusers + Chr$(10) + user
            Else
                localusers = localusers + Chr$(10) + user
            End If
            user = ""
        Else
            user = user + ch
        End If
    Next
    If user<>"" Then
        If ExternalMailAddress(user) Then
            externalusers = externalusers + Chr$(10) + user
        Else
            localusers = localusers + Chr$(10) + user
        End If
    End If

    If localusers > "" Then
        localusers = Mid$(localusers, 2)    'Take off leading '\n'

        MailTo "Attachment", ParseString(localusers, Chr$(10)), fBINARY+fDONTCOPY, cisfilename, filename
        While localusers<>""
            MailCC ParseString(localusers, Chr$(10))
        Wend
        SendMail "Attachment"
    End If
    If externalusers > "" Then
        externalusers = Mid$(externalusers, 2)  'Take off leading '\n'
        fname = Session.ServicePath + "cis.bin"
        FileEncode filename, fname, CODE_UUENCODE

        MailTo "Attachment", ParseString(externalusers, Chr$(10)), fDONTCOPY, cisfilename, fname
        While externalusers<>""
            MailCC ParseString(externalusers, Chr$(10))
        Wend
        SendMail "Attachment"
        DeleteFile fname
    End If
    If MailSent Then ReportSuccess id & " : " & filename & " was sent to " & sent
End Sub