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

Text File | 1999-10-06 | 44.6 KB | 1,100 lines

'T:HMIMAIL.EBS for CompuServe
' VA 4.52 release
' 20-11-97 petec - fixed problem with mail reference
' 30-11-97 petec - mail collection speeded up by using streaming

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 Function TimeZone(s As EMPTIMEZONE) 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
Declare Function GetMailType(i As Integer) 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, MailId As String
Dim MailAddresses As String
Dim MailAttachments As String
Dim MailCount As Integer, MailFlags As Integer, AttachmentCount 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="home:mail" Then
        HMIGotoMail = True
        Exit Function
    End If

    SetHighMessageNumber

    On Error Goto GoMail_Error
    If DoHMIGotoPage("home:mail", -1, CAP_EMAIL, False) Then
        EMPGetConfig EMPconfig, "", "", 0
        WhereAmI = "home: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

'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 = ""
    MailAttachments = ""
    AttachmentCount = 0
    MailFlags = flags

    ' The primary recipient
    MailCC user
End Sub

Sub AddMailInfo(list As String, address As String, realname As String, RecipientType As Integer)
    If list <> "" Then list = list + Chr$(10)
    list = list + Chr$(RecipientType) + address + Chr$(0) + realname
End Sub

Sub AddMailDestination(address As String, realname As String, RecipientType As Integer)
    AddMailInfo MailAddresses, address, realname, RecipientType
    MailCount = MailCount + 1
End Sub

Function ExtractMailDestination(list As String, address As String, realname As String, RecipientType As Integer) As Boolean
    Dim tmp As String

    tmp = ParseString(list, Chr$(10))
    If tmp = "" Then
        ExtractMailDestination = False
        Exit Function
    End If
    RecipientType = Asc(tmp)
    tmp = Mid$(tmp, 2)
    address = ParseString(tmp, Chr$(0))
    realname = tmp
    ExtractMailDestination = True
End Function

'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
        If MailAddresses="" Then
            AddMailDestination email, realname, EMP_PRIMARY_RECIPIENT%
        Else
            AddMailDestination email, realname, EMP_COPY_RECIPIENT%
        End If
    End If
End Sub

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

    MailId = id
    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 = ""
    MailAttachments = ""
    AttachmentCount = 0
    MailFlags = flags
End Sub

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

    If email="" Then email = realname else if realname = "" Then realname = email

    ' 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
        If mode = "bcc" Then
            AddMailDestination email, realname, EMP_BLIND_COPY%
        ElseIf mode = "cc" Then
            AddMailDestination email, realname, EMP_COPY_RECIPIENT%
        Else
            AddMailDestination email, realname, EMP_PRIMARY_RECIPIENT%
        End If
    End If
End Sub

'T:AddAttachment (subroutine) (CompuServe)
Sub AddAttachment(filename As String, truename As String)
    If filename = "" Then filename = truename Else If truename = "" Then truename = filename
    If filename <> "" Then
        AddMailInfo MailAttachments, filename, truename, 0
        AttachmentCount = AttachmentCount + 1
    End If
End Sub

'T:EndMail (subroutine) (Compuserve)
Sub EndMail
    SendMail MailId
End Sub

'T:SetEnvelope (subroutine) (CompuServe)
Sub SetEnvelope(envelope As EMPENVELOPE, address As String, realname As String, UrgentMail As Boolean, RecipientType As Integer)
    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 = RecipientType

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

    ' Remove surrounding [] from the address?
    If Mid$(address, 1, 1)="[" And Right$(address, 1)="]" Then
        address = Mid$(address, 2, Len(address)-2)
    End If

    envelope.lpRecipientName = realname
    envelope.lpRecipientAddr = address
    If envelope.lpRecipientName = "" Then
        envelope.lpRecipientName = envelope.lpRecipientAddr
    End If
    If envelope.lpRecipientAddr = "" Then
        envelope.lpRecipientAddr = envelope.lpRecipientName
    End If

    'LogResult "name = {" + envelope.lpRecipientName + "}"
    'LogResult "addr = {" + envelope.lpRecipientAddr + "}"
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, AtL 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
    If AtL then 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, 11)="X-VA-From: " Then
            RealName = Mid$(TheData, 12)
        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
            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 oldcontents() As EMPCONTENTSDESC, contents() As EMPCONTENTSDESC
    Dim forward As String, InReplyTo As String, RealName As String
    Dim address As String, rname As String
    Dim RecipientType As Integer, LastRecipientType As Integer
    Dim notime As HMITIMESTAMP
    Dim i As Integer, j As Integer, contno As Integer
    Dim addresses As String, badaddresses As String, badcount As Integer
    Dim attachments As String, footer As String
    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
    Redim contents(0 to AttachmentCount)
    Redim oldcontents(0 to 0)
    ' Just send it to ourself?
    If MailCount < 0 Then
        AddMailDestination Session.LoginName, Session.LoginName, EMP_BLIND_COPY%
        If (MailFlags And fDONTCOPY)=0 Then MailFlags = MailFlags + fDONTCOPY
    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, False) Then 'InStr(MailAddresses, "@")<>0) Then
            Exit Sub
        End If
    End If
    contents(0).dwSize = FileLen(tmpFilename)
    contents(0).dwSurcharge = 0
    attachments = MailAttachments    'Copy attachment list to temp string before parsing
    For i = 1 To AttachmentCount
        If ExtractMailDestination(attachments, address, rname, RecipientType) Then
            contents(i).nType = EMP_BINARY_FILE%
            contents(i).dwSize = FileLen(address)
            contents(i).dwSurcharge = 0
        End If
    Next
    oldcontents(0) = contents(0)

SendMail_retry:
    ReDim envelopes(0 To MailCount)
    addresses = MailAddresses
    For i = 0 To MailCount
        If ExtractMailDestination(MailAddresses, address, rname, RecipientType) Then
            SetEnvelope envelopes(i), address, rname, UrgentMail, RecipientType
        End If
    Next

    ' 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)
    mroOptions = EMP_MRO_APPEND_DISTRIBUTION%
    If InReplyTo<>"" Then mroOptions = mroOptions Or EMP_MRO_REPLY_TO%
    If OldMail Then
        EMPSendMsgHeader sendresponse, badenvelopes(), mroOptions, _
                MailSubject, RealName, notime, notime, InReplyTo, envelopes(), _
                oldcontents(), MailCount + 1, "", forward
    Else
        EMPSendMsgHeader sendresponse, badenvelopes(), mroOptions, _
                MailSubject, RealName, notime, notime, InReplyTo, envelopes(), _
                contents(), MailCount + 1, "", forward
    End If
    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)
            If ExtractMailDestination(MailAddresses, address, rname, RecipientType) Then
                If envelopes(i).moOptions.cImportance = 255 Then
                    LogResult id + " : Invalid address (" & _
                        envelopes(i).nType & "): " + address
                    badaddresses = badaddresses + rname + " [" + address + "]" + Chr$(10)
                    badcount = badcount + 1
                Else
                    AddMailDestination address, rname, RecipientType
                End If
            End If
        Next
        If MailCount >= 0 Then Goto SendMail_retry
        LogResult id+" : SendMail Failed : No valid destination addresses"
        Exit Sub
    End If

    attachments = MailAttachments    'Copy attachment list to temp string before parsing
    For contno = 0 To AttachmentCount
        partno = contno + 1
        If contno = 0 Then
            filename = tmpFilename
        Else
            If OldMail then
                partno = 1
                oldcontents(0) = contents(contno)
                EMPSendMsgHeader sendresponse, badenvelopes(), mroOptions, _
                                 MailSubject, RealName, notime, notime, _
                                 InReplyTo, envelopes(), oldcontents(), _
                                 MailCount + 1, "", forward
            End If
            If ExtractMailDestination(attachments, filename, rname, RecipientType) Then
                SplitPath rname, path, sname
            End If
        End If
        ' Find out length of the message/file
        SourceFileLen = FileLen(filename)
        If SourceFileLen <= 0 Then
            LogResult id+" : SendMail Failed : Can't upload file"
            Exit Sub
        End If

        ' Send the file
        BytesToRead = SourceFileLen
        SourceFileNum = FreeFile()
        Open filename 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, partno, MailSubject, sname, contents(contno).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, partno, MailSubject, sname, contents(contno).nType, TheData)
        End If
        Terminal.TransferStatus True, sname, SourceFileLen, SourceFileLen
        i = EMPSendMsgContents(HMI_STATE_NEXT%, partno, MailSubject, sname, contents(contno).nType, "")
        Close #SourceFileNum
        Terminal.TransferStatus

        If OldMail and contno=0 then
            ' Check it succeeded
            EMPGetConfirmation confirm
            If confirm.lpMsgID <> "" Then
                ReportSuccess id & " : Posted Mail " & MailSubject & " VA:"  & Session.Service & ":mail#<" & confirm.lpMsgID & ">"
                MailSent = True
            End If
        End If
    Next

    If not OldMail then
        ' Check it succeeded
        EMPGetConfirmation confirm
        If confirm.lpMsgID <> "" Then
            ReportSuccess id & " : Posted Mail " & MailSubject & " VA:"  & Session.Service & ":mail#<" & confirm.lpMsgID & ">"
            MailSent = True
        End If
    End If

    If (MailFlags And fDONTCOPY)=0 Then
        ' Write message back to yourself
        header = "Date: " + MakeDateString(confirm.wtTimeSent.tsTime) + TimeZone(confirm.wtTimeSent.tzZone) + 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)

        LastRecipientType = -1
        For i = 0 To MailCount
            If ExtractMailDestination(addresses, address, rname, RecipientType) Then
                If Mid$(address, 1, 9)="internet:" Then address = Mid$(user, 10)
                Select Case RecipientType
                Case EMP_PRIMARY_RECIPIENT%
                    If LastRecipientType<>RecipientType Then header = header + "To:"
                Case EMP_COPY_RECIPIENT%
                    If LastRecipientType<>RecipientType Then header = header + "Cc:"
                Case Else
                    If LastRecipientType<>RecipientType Then header = header + "Bcc: "
                End Select
                header = header + " " + rname + " [" + address + "]" + Chr$(10)
            End If
        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
        footer = ""
        For i = 1 To AttachmentCount
            If ExtractMailDestination(MailAttachments, address, rname, RecipientType) Then
                footer = footer + Chr$(10) + "[Attachment " + FileUrl(rname) + " sent]"
            End If
        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;deleteexisting=no"
        Print #1, "Memo #1 (" & Len(header) + SourceFileLen + Len(footer) & ")"
        Print #1, header
        Close #1
        AddToFile filename, tmpFilename
        Open filename For Append Access Read Write Shared As #1
        Print #1, footer
MailTo_error:
        Close #1
        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, lhead As long, subject As String, obinfname 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, badchars As String, lpCount As Integer
    Dim cleanmail As Boolean

    deletemail = ReadIni$("Service "+Session.Service, "Delete Mail", Session.IniFilename)="YES"
    cleanmail = ReadIni$("Service "+Session.Service, "Clean 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()

        If UBound(msg)>=0 Then
            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
                        from = LCase$(hdr.lpOriginatorAddr)

                        ' 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, ";", " "

                        ' If userid=realname then only use one of them
                        If "["+realname+"]"=userid Then
                            userid = ""
                        End If

                        ' Tell the user what's happening
                        Terminal.Print realname & " " & _
                                       MakeDateString(hdr.tsDate) & _
                                       TimeZone(EMPconfig.wtCurrentTime.tzZone) & " " & 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) & _
                                                   TimeZone(EMPconfig.wtCurrentTime.tzZone) & 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
                            nState = HMI_STATE_FIRST%
                            Terminal.TransferStatus False, "Mail Message", 0, content(contentno).dwSize
                            msgtext = EMPReceiveMsgContents(HMI_STATE_FIRST%, _
                                         msgno, content(contentno).cNumber, l, _
                                         BlockSize, content(contentno).nType, lpCount)

                            ' Do we need to use our own header
                            If Mid$(from, 1, 9)="internet:" And _
                               from<>"internet:[e-mail]" And _
                               Left$(msgtext, 7)="Sender:" Then
                                msgheader = ""
                            ElseIf cleanmail And (Left$(msgtext, 9)="Contents:") Then
                                i = InStr(msgtext, "===== Begin Part 1 =====")
                                If (i<>0) And (i<150) Then
                                    i = InStr(i, msgtext, Chr$(13)+Chr$(10)+Chr$(13)+Chr$(10))
                                    If (i<>0) And (i<250) Then msgtext = Mid$(msgtext, i+4)
                                End If
                            End If

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

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

                            ' Get the body text and write it out
                            crs = 0
                            Do
                                If Not firstblock Then
                                    msgtext = ""
                                    msgtext = EMPReceiveMsgContents(HMI_STATE_NEXT%, _
                                                  msgno, content(contentno).cNumber, _
                                                  l, BlockSize, _
                                                  content(contentno).nType, lpCount)
                                End If
                                firstblock = False
                                msgtext = Left$(msgtext, lpCount)
                                l = l + Len(msgtext)
                                Terminal.TransferStatus False, "Mail Message", l-1, content(contentno).dwSize
                                crs = crs + ItemCount(msgtext, Chr$(13))
                                CaptureText msgtext
                            Loop Until Len(msgtext)=0
                            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
                            ElseIf Basic.OS <> ebWin32 Then
                                binfname = Left$(binfname,8)
                            End If

                            If UCase$(binfname)="RE" Then binfname = ""

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

ReadMail_TryAgain:
                            ' 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
                            nState = HMI_STATE_FIRST%
                            Do
                                msgtext = ""  ' needed to stop out of string space error
                                msgtext = EMPReceiveMsgContents(nState, msgno, _
                                           content(contentno).cNumber, l, _
                                           BlockSize, content(contentno).nType, _
                                           lpCount)
                                nState = HMI_STATE_NEXT%

                                If lpCount <= 0 Then Exit Do
                                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;deleteexisting=no"
                            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()
        Else
            msgno = 0
        End If
    Loop Until msgno=0

ReadMail_error:
    If Err=53 Then
        binfname = ""
        Goto ReadMail_TryAgain
    ElseIf 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