DOS/V Power Report 1997 November/VPR9711A.ISO/VPR_DATA/Special/Mich102/mich102.lzh/Michelle.DAS

Text File | 1996-07-03 | 27KB | 1,064 lines

'***********************************************************************
'                  Internet Mail for Dana "Michelle"
'                                 (C) RIM-Arts software 1995,1996
' rel 1.00 95/11
' rel 1.01 95/12
' rel 1.02 96/7
'***********************************************************************

'-----------------------------------------------------------------------
' 起動キーの設定
' キーとシフトステータスの組み合わせで２種類まで設定できます
' キーコードについては、Dana Script Help の「仮想キーコード一覧」と
'「常駐スクリプト」の STATE_KEY_PRESS の説明を参考にして下さい。
'-----------------------------------------------------------------------
Const KEY1   = &H0D        'VK_RETURN
Const SHIFT1 = &H60        'Ctrl+Shift+
Const KEY2   = &H02        'VK_RBUTTON
Const SHIFT2 = &H20        'Ctrl+

'-----------------------------------------------------------------------
' EUC 受信の場合はTrueにしてください。（必ず変換しますのでご注意）
'-----------------------------------------------------------------------
Const EUC_RECEIVE = False

Const MB_YESNO = &H04
Const MB_YESNOCANCEL = &H03
Const MB_ICONQUESTION = &H20
Const MB_DEFBUTTON1 = &H0
Const MB_DEFBUTTON2 = &H100

Const IDOK = 1
Const IDCANCEL = 2
Const IDYES = 6
Const IDNO = 7

Declare Proc DeleteMail Lib "DanaInet.DLL" (messageno%) As Integer
Declare Proc EndReceiveSession Lib "DanaInet.DLL" ()
Declare Proc GetAddress Lib "DanaInet.DLL" (home$, hWnd%) As String
Declare Proc GetConfiguration Lib "DanaInet.DLL" (ini$, name$, add$, login$, pop$, smtp$, del$)
Declare Proc GetErrorStatus Lib "DanaInet.DLL" () As String
Declare Proc GetFormValue Lib "DanaInet.DLL" (control$) As String
Declare Proc GetLastMailNo Lib "DanaInet.DLL" () As String
Declare Proc GetMail Lib "DanaInet.DLL" (messageno%, buf$, newlinecode%, deleteflag%) As Integer
Declare Proc ListMail Lib "DanaInet.DLL" (header$, stat$) As Integer
Declare Proc MailAuthenticate Lib "DanaInet.DLL" (user$) As Integer
Declare Proc MailInitialize Lib "DanaInet.DLL" (pop$, smtp$, hWnd%)
Declare Proc MailShutdown Lib "DanaInet.DLL" ()
Declare Proc OpenSendForm Lib "DanaInet.DLL" (home$, hWnd%)
Declare Proc SendMail Lib "DanaInet.DLL" (from$, add$, cc$, bcc$, subj$, content$) As Integer
Declare Proc SetConfiguration Lib "DanaInet.DLL" (ini$, hWnd%)
Declare Proc SetFormValue Lib "DanaInet.DLL" (control$, value$)
Declare Proc StartReceiveSession Lib "DanaInet.DLL" () As Integer

Declare Proc CreateDirectory Lib "Kernel32" Alias "CreateDirectoryA" (dirname$, n$)
Declare Proc SetFocus Lib "User32" (hWnd%) As Integer
Declare Proc wsprintf Lib "User32" Alias "wsprintfA" (s$, fmt$, ..)

Const STATE_INIT        = 0
Const STATE_KEY_PRESS   = 8
Const STATE_BEFORE_EXIT = 7

Static hRecvMenu%
Static nCnt%
Static nNewCnt%
Static bInit%

Static g_name$
Static g_add$
Static g_login$
Static g_pop$
Static g_smtp$
Static g_bDel%
Static g_ini$
Static outbox$
Static inbox$

Static sInBox$(10000)

Main ()

    Select Case .DanaState
    Case STATE_INIT
        g_name$ = Space$(256)
        g_add$ = Space$(256)
        g_login$ = Space$(256)
        g_pop$ = Space$(256)
        g_smtp$ = Space$(256)
        g_ini$ = .HomePath + "DanaInet.INI"
        UpdateConfig()
        If g_pop$ = "" Or g_smtp$ = "" Then
            SetConfiguration(g_ini$, .hMainWnd)
            UpdateConfig()
            MsgBox("Michelleのメインメニューは、Ctrl+Shift+Enter" + Chr(10) + "または、Ctrl+右ﾏｳｽﾎﾞﾀﾝで起動します")
        End If
        outbox$ = .HomePath + "outbox\"
        inbox$  = .HomePath + "inbox\"
        CreateDirectory(inbox$, 0)
        CreateDirectory(outbox$, 0)
        CreateDirectory(outbox$ + "sent\", 0)
        StayResident()
    Case STATE_KEY_PRESS
        OnKeyPress(.ParmA, .ParmB)
    Case STATE_BEFORE_EXIT
        OnBeforeExit()
    Case Else
    End Select

End

'/////////////////////////////////////////////////////////
' Message handlers

'--------------------------------------------------------
' Key pressed
'--------------------------------------------------------
Proc OnKeyPress(nKey%, nShift%)
'    Dim sCmd$
'    sCmd$ = KeyToCmd(nKey, nShift)
    If (nKey = KEY1 And nShift = SHIFT1) Or (nKey = KEY2 And nShift = SHIFT2) Then
        InetMailMain()
        .ParmA = 0
    End If
End Proc

'--------------------------------------------------------
' Before exit Dana
'--------------------------------------------------------
Proc OnBeforeExit()
    MichelleExit()
End Proc

'/////////////////////////////////////////////////////////
' Initialize

'Menu ID (must be greater than 10000 and less than 17000)
Const C_SEND    = 10001
Const C_RECV    = 10002
Const C_SENDALL = 10003
Const C_REPLY   = 10004
Const C_LIST    = 10005
Const C_DELETE  = 10006
Const C_CONFIG  = 10007
Const C_RECVALL = 10008
Const C_DELFILE = 10009
Const C_TRASH   = 10010
Const C_INBOXDAT= 10011
Const C_ADDRBOOK= 10012
Const C_EDITDELI= 10013
Const C_OPENLOG = 10014
Const C_EDITSIG = 10015
Const C_EMPTYSENT= 10016

Const INBOX_DAT    = "inbox.dat"
Const MAILDELI_DAT = "maildeli.dat"
Const SENTMAIL_LOG = "sentmail.log"
Const SIGNATURE_TXT = "sign.txt"

Const WILD_CARD = "*.*"

Const C_EXIT    = 9999

Proc MichelleExit()
    Dim f$, d$
    If hRecvMenu Then DiscardMenu(hRecvMenu)
    If bInit Then MailShutdown()
    d$ = inbox$ + "trash\"
    f$ = Dir(d$ + WILD_CARD)
    While f$ <> ""
        FKill(d$ + f$)
        f$ = Dir("")
    Wend
End Proc

'--------------------------------------------------------
' Main Routine
'--------------------------------------------------------
Proc InetMailMain ()

    Dim hMenu%, hMenuIn%, hMenuOut%, hMenuUsr%, hMenuMov%, hMenuEmpty%, hMenuSent%
    hMenu = NewMenu()
    If .TotLine > 0 Then            'Check this or die. :-)
        If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Or UCase(inbox$) = UCase(Left(.PathName, Len(inbox$))) Then
            hMenuMov = AddMenuItem(hMenu, "移動(&M)", 0)
            AddFolders(hMenuMov, 17000)
                AddMenuItem(hMenuMov, "ごみ箱", C_TRASH)
            AddMenuItem(hMenu, "削除(&D)", C_DELFILE)
            AddMenuItem(hMenu, "", -1)
        End If
    End If
    AddMenuItem(hMenu, "受信(&R)", C_RECV)
    AddMenuItem(hMenu, "全て受信(&V)", C_RECVALL)
    AddMenuItem(hMenu, "送信(&S)...", C_SEND)
    AddMenuItem(hMenu, "一括送信(&A)", C_SENDALL)
    AddMenuItem(hMenu, "返信ﾒｰﾙの作成(&P)", C_REPLY)
    AddMenuItem(hMenu, "", -1)
    hMenuIn = AddMenuItem(hMenu, "受信箱(&I)", 0)
    CreateBox(hMenuIn, 0, "inbox")
    hMenuOut = AddMenuItem(hMenu, "送信箱(&O)", 0)
    If CreateBox(hMenuOut, 100, "outbox") Then
        AddMenuItem(hMenuOut, "", -1)
    End If
        hMenuSent = AddMenuItem(hMenuOut, "送信済み(&S)", 0)
        If CreateBox(hMenuSent, 200, "outbox\sent") Then
            AddMenuItem(hMenuSent, "", -1)
            AddMenuItem(hMenuSent, "空にする(&E)", C_EMPTYSENT)
        End If
        AddMenuItem(hMenuOut, "送信ログ(&L)", C_OPENLOG)
    hMenuUsr = AddMenuItem(hMenu, "書簡整理箱(&U)", 0)
    CreateUsrBox(hMenuUsr)
    AddMenuItem(hMenu, "", -1)
    AddMenuItem(hMenu, "ｻｰﾊﾞｰ上のﾒｰﾙを削除(&T)...", C_DELETE)
    hMenuEmpty = AddMenuItem(hMenu, "書簡箱を整理(&E)...", 0)
        AddMenuItem(hMenuEmpty, "受信箱(&I)", 18000)
        AddFolders(hMenuEmpty, 18000)
    If nNewCnt Then
        AddMenuItem(hMenu, "受信ﾒｰﾙ一覧(&L)...", C_LIST)
    End If
    AddMenuItem(hMenu, "", -1)
    AddMenuItem(hMenu, "自動振分け定義編集(&Y)...", C_EDITDELI)
    AddMenuItem(hMenu, "署名の編集(&G)...", C_EDITSIG)
    AddMenuItem(hMenu, "アドレス帳(&B)...", C_ADDRBOOK)
    AddMenuItem(hMenu, "環境設定(&C)...", C_CONFIG)
    AddMenuItem(hMenu, "Michelle の終了(&X)", C_EXIT)
    Dim nRC%
    nRC = DoMenu(hMenu)

    Dim sTgt$, f$

    Select Case nRC
    Case C_SEND
        Send()
    Case C_RECV
        Receive()
    Case C_RECVALL
        ReceiveAll()
    Case C_REPLY
        Reply()
    Case C_LIST
        ReceivedMail()
    Case C_DELETE
        Delete()
    Case C_SENDALL
        AllSend()
    Case C_CONFIG
        SetConfiguration(g_ini$, .hMainWnd)
        UpdateConfig()
    Case C_DELFILE
        If MsgBox("削除します．よろしいですか？", "", MB_YESNO) = IDYES Then
            SaveAs(.PathName)
            FKill(.PathName)
            Command("CloseFile")
        End If
    Case C_TRASH
        sTgt$ = inbox$ + "trash"
        CreateDirectory(sTgt$, 0)
        FKill(.PathName)
        SaveAs(sTgt$ + "\" + .FileName)
    Case C_INBOXDAT
        FileOpen(.HomePath + INBOX_DAT)
    Case C_EDITDELI
        FileOpen(.HomePath + MAILDELI_DAT)
    Case C_EDITSIG
        FileOpen(.HomePath + SIGNATURE_TXT)
    Case C_ADDRBOOK
        InsertString(GetAddress(.HomePath, .hMainWnd))
    Case C_OPENLOG
        FileOpen(.HomePath + SENTMAIL_LOG)
        .Cols = 256
        Command("TextBot")
    Case C_EXIT
        MichelleExit()
        Terminate()
    Case C_EMPTYSENT
        sTgt$ = outbox$ + "sent\"
        f$ = Dir(sTgt$ + WILD_CARD)
        While f$ <> ""
            FKill(sTgt$ + f$)
            f$ = Dir("")
        Wend
    Case Else
        If nRC > 0 And nRC <= 10000 Then
            FileOpen(sInBox$(nRC))
        Else If nRC > 17000 And nRC < 18000 Then
            ' Move to
            sTgt$ = inbox$ + GetMenuItem(hMenuMov, nRC)
            CreateDirectory(sTgt$, 0)
            FKill(.PathName)
            SaveAs(sTgt$ + "\" + .FileName)
        Else If nRC >= 18000 Then
            ' Empty Folders
            If nRC > 18000 Then
                sTgt$ = inbox$ + GetMenuItem(hMenuEmpty, nRC) + "\"
            Else
                sTgt$ = inbox$
            End If
            EmptyFolder(sTgt$)
        End If
    End Select

    DiscardMenu(hMenu)

End Proc

'--------------------------------------------------------
' Server Initialize
'--------------------------------------------------------
Proc MailInit() As Integer
    If bInit Then Return True
    If MailInitialize(g_pop$, g_smtp$, .hMainWnd) Then
        If MailAuthenticate(g_login$) Then
            bInit = True
            Return True
        Else
            MsgBox("認証に失敗しました" + Chr(10) + GetErrorStatus())
            MailShutdown()
            Return False
        End If
    Else
        MsgBox("初期化に失敗しました" + Chr(10) + GetErrorStatus())
        Return False
    End If
End Proc

'--------------------------------------------------------
' Add Folders to Menu
'--------------------------------------------------------
Proc AddFolders(hMenu%, nBase%)
    Dim fp%
    Dim s$
    Dim n%
    fp = FOpen(.HomePath + INBOX_DAT, "r")
    If fp Then
        s$ = FGets(fp)
        While s$ <> ""
            s$ = Trim(s$)
            If s$ <> Chr(10) And Left$(s$, 1) <> "#" Then
                n = n + 1
                AddMenuItem(hMenu, Left(s$, Len(s$)-1), nBase + n)
            End If
            s$ = FGets(fp)
        Wend
        FClose(fp)
    End If
End Proc

Proc CreateUsrBox(hMenu%)
    Dim fp%
    Dim s$, d$
    Dim n%
    Dim nBase%
    Dim hSubMenu%
    nBase = 300
    fp = FOpen(.HomePath + INBOX_DAT, "r")
    If fp Then
        s$ = FGets(fp)
        While s$ <> ""
            s$ = Trim(s$)
            If s$ <> Chr(10) And Left$(s$, 1) <> "#" Then
                n = n + 1
                d$ = Left(s$, Len(s$)-1)
                hSubMenu = AddMenuItem(hMenu, d$, 0)
                CreateBox(hSubMenu, nBase, "inbox\" + d$)
                nBase = nBase + 100
            End If
            s$ = FGets(fp)
        Wend
        FClose(fp)
    End If
    hSubMenu = AddMenuItem(hMenu, "ごみ箱", 0)
    CreateBox(hSubMenu, nBase, "inbox\trash")
    AddMenuItem(hMenu, "", -1)
    AddMenuItem(hMenu, "書簡定義の編集(&E)", C_INBOXDAT)
End Proc

Proc CreateBox(hMenu%, nInit%, sDir$) As Integer
    Dim s$, d$, f$, n%
    d$ = .HomePath + sDir$
    s$ = Dir(d$ + "\" + WILD_CARD)
    While s$ <> ""
        Dim h$
        f$ = d$ + "\" + s$
        h$ = GetHeader(f$)
        If Trim(h$) <> "" Then
            n = n + 1
            If n > 100 Then
                Return n-1
            End If
            sInBox$(nInit + n) = f$
            AddMenuItem(hMenu, "&" + Str(n) + " " + h$, nInit + n)
        End If
        s$ = Dir$("")
    Wend
    Return n
End Proc

'--------------------------------------------------------
' Get Header Information from Mail File
'--------------------------------------------------------
Proc GetHeader(sFile$) As String
    Dim fp%, s$, n%
    Dim from$, subj$
    fp = FOpen(sFile$, "r")
    If fp Then
        s$ = FGets(fp)
        While s$ <> Chr(10) And s$ <> ""
            s$ = Left(s$, Len(s$) - 1)
            n = InStr(s$, ":")
            If n Then
                Dim m$
                m$ = UCase(Left(s$, n - 1))
                If m$ = "FROM" Then
                    from$ = Mid$(s$, n + 1, 40)
                Else If m$ = "SUBJECT" Then
                    subj$ = Mid$(s$, n + 1, 40)
                End If
            End If
            s$ = FGets(fp)
        Wend
        FClose(fp)
    End If
    Return subj + Chr(9) + from$
End Proc

'/////////////////////////////////////////////////////////
' Command routines

'--------------------------------------------------------
' Empty This Folder
'--------------------------------------------------------
Proc EmptyFolder(sFold$)
    Dim s$
    Dim nRC%
    s$ = Dir(sFold$ + WILD_CARD)
    If s$ = "" Then
        MsgBox("書簡箱は空です")
        Return
    End If
    While s$ <> ""
        nRC = MsgBox(Trim(GetHeader(sFold$ + s$)) + Chr(10) + "削除しますか？", "", MB_YESNOCANCEL | MB_ICONQUESTION)
        If nRC = IDCANCEL Then Return
        If nRC = IDYES Then
            FKill(sFold$ + s$)
        End If
        s$ = Dir("")
    Wend
End Proc

'--------------------------------------------------------
' Send Command
'--------------------------------------------------------
Proc Send()
    Dim add$, subj$, cc$, bcc$, content$
    Dim nRC%
    Silent()
    Command("SelectAll")
    content$ = GetSelected()
    SelectCancel()
    GotoThere(1,1)
    NoSilent()
    Refresh()
    Dim hLine%
    Dim sLine$
    Dim n%, nIdx%, s$
    Dim sArr$(4)
    Dim I%
    For I = 1 To 4
        sArr$(I) = ""
    Next
    Dim bFound%
    hLine = GetTopLine()
    sLine$ = LoadThisLine(hLine)
    If InStr(sLine$, ":") <> 0 Then
        Do
            n = InStr(sLine$, ":")
            If n Then
                s$ = Left(sLine$, n-1)
                Select Case UCase(s$)
                Case "TO"
                    nIdx = 1
                Case "SUBJECT"
                    nIdx = 2
                Case "CC"
                    nIdx = 3
                Case "BCC"
                    nIdx = 4
                Case Else
                    nIdx = 0
                End Select
                If nIdx Then
                    sArr$(nIdx) = Trim(Mid$(sLine$, n + 1))
                End If
            Else If sLine$ = "" Then
                bFound = True
                Exit Do
            Else
                If nIdx Then
                    sArr$(nIdx) = sArr$(nIdx) + Trim(sLine$)
                End If
                Exit Do
            End If
            hLine = GetNext(hLine)
            If hLine = 0 Then Exit Do
            sLine$ = LoadThisLine(hLine)
        Loop While True
    End If
    add$  = sArr$(1)
    subj$ = sArr$(2)
    cc$   = sArr$(3)
    bcc$  = sArr$(4)
    If bFound Then
        n = InStr(content$, Chr(13) + Chr(10) + Chr(13) + Chr(10))
        If n Then
            content$ = Mid(content$, n + 4, Len(content$))
        End If
    End If
    Do
        SetFormValue("To", add$)
        SetFormValue("Subject", subj$)
        SetFormValue("Cc", cc$)
        SetFormValue("Bcc", bcc$)
        If OpenSendForm(.HomePath, .hMainWnd) <> IDOK Then Return
        add$  = GetFormValue("To")
        subj$ = GetFormValue("Subject")
        cc$   = GetFormValue("Cc")
        bcc$  = GetFormValue("Bcc")
        If add$ <> "" Then
            Exit Do
        Else
            MsgBox("宛先(To:)を入力して下さい")
        End If
    Loop While True

    If MsgBox("今すぐ送信しますか？", "", MB_YESNO) = IDYES Then
        If MailInit() Then
            content$ = content$ + GetSignature()
            If SendMail(g_name$ + " <" + g_add$ + ">", add$, cc$, bcc$, subj$, content$) = 0 Then
                MsgBox("送信に失敗しました" + Chr(10) + GetErrorStatus())
            Else
                If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Then
                    FKill(.PathName)
                    SaveAs(outbox$ + "sent\" + .FileName)
                    Command("CloseFile")
                Else
                    SaveAsOutMail(add$, cc$, bcc$, subj$, content$, False)
                End If
                AddLogFile(add$, subj$)
            End If
        End If
    Else
        If UCase(outbox$) = UCase(Left(.PathName, Len(outbox$))) Then
            SaveAs(.PathName)
            FKill(.PathName)
            Command("CloseFile")
            SaveAsOutMail(add$, cc$, bcc$, subj$, content$, True)
        Else
            SaveAsOutMail(add$, cc$, bcc$, subj$, content$, True)
        End If
    End If
End Proc

'--------------------------------------------------------
' Send All
'--------------------------------------------------------
Proc AllSend()
    Dim s$, d$, tmp$, tmp2$
    Dim fp%, n%
    Dim add$, cc$, bcc$, subj$, content$
    Dim sig$
    sig$ = GetSignature()
    d$ = outbox$
    s$ = Dir(d$ + WILD_CARD)
    If s$ = "" Then
        MsgBox("送信待ち状態のメールはありません")
        Return
    End If
    While s$ <> ""
        add$ = ""
        cc$ = ""
        bcc$ = ""
        subj$ = ""
        content$ = ""
        fp = FOpen(d$ + s$, "r")
        If fp Then
            tmp$ = FGets(fp)
            While tmp$ <> Chr(10) And tmp$ <> ""
                tmp$ = Left(tmp$, Len(tmp$) - 1)
                n = InStr(tmp$, ":")
                If n Then
                    tmp2$ = UCase(Left(tmp$, n - 1))
                    Select Case tmp2$
                    Case "TO"
                        add$ = LTrim(Mid(tmp$, n + 1))
                    Case "CC"
                        cc$ = LTrim(Mid(tmp$, n + 1))
                    Case "BCC"
                        bcc$ = LTrim(Mid(tmp$, n + 1))
                    Case "SUBJECT"
                        subj$ = LTrim(Mid(tmp$, n + 1))
                    End Select
                End If
                tmp$ = FGets(fp)
            Wend
            tmp$ = FGets(fp)
            While tmp$ <> ""
                StoB(tmp$, Len(tmp$) - 1, &H0D)
                content$ = content$ + tmp$ + Chr(10)
                tmp$ = FGets(fp)
            Wend
            FClose(fp)
            If MailInit() Then
                content$ = content$ + sig$
                If SendMail(g_name$ + " <" + g_add$ + ">", add$, cc$, bcc$, subj$, content$) = 0 Then
                    MsgBox("送信に失敗しました" + Chr(10) + GetErrorStatus())
                    Return
                End If
                AddLogFile(add$, subj$)
                FCopy(d$ + s$, outbox$ + "sent\" + s$)
                FKill(d$ + s$)
            Else
                Return
            End If
        End If
        s$ = Dir("")
    Wend
End Proc

Dim fname$(40)
Dim bAll%

'--------------------------------------------------------
' Add Log File
'--------------------------------------------------------
Proc AddLogFile(add$, subj$)
    Dim fp%
    Dim s$
    s$ = Space(256)
    fp = FOpen(.HomePath + SENTMAIL_LOG, "w")
    FSeek(fp, 0, 1)
    wsprintf(s$, "%s %s To:%-30s %s" + Chr(10), Date(), Time("%H:%M"), add$, subj$)
    FPuts(fp, s$)
    FClose(fp)
End Proc

'--------------------------------------------------------
' Receive All Mail in Server
'--------------------------------------------------------
Proc ReceiveAll()
    bAll = True
    Receive()
    bAll = False
End Proc

'--------------------------------------------------------
' Receive Unread Mail
'--------------------------------------------------------
Proc Receive()
    Dim buf$
    Dim stat$
    Dim nRC%
    Dim recv$
    buf$ = Space$(2048)
    stat$ = Space$(256)
    If MailInit() Then
        If StartReceiveSession() Then
            nCnt = 0
            nNewCnt = 0
            If hRecvMenu <> 0 Then
                DiscardMenu(hRecvMenu)
            End If
            hRecvMenu = NewMenu()
            Dim nBytes%
            nBytes = ListMail(buf$, stat$)
            While nBytes
                nCnt = nCnt + 1
                If InStr(stat$, "R") = 0 Or bAll Then
                    fname$(nCnt) = TmpName(inbox$)
                    FileOpen(fname$(nCnt))
                    If .TotLine > 1 Then
                        MsgBox("メールが多すぎます")
                        Exit While
                    End If
                    .Cols = 256
                    AddMenuItem(hRecvMenu, "&" + buf, nCnt)
                    recv$ = Space(nBytes + 256)        'approximately.
                    GetMail(nCnt, recv$, 0, g_bDel)
                    nNewCnt = nNewCnt + 1
                    DoEvents()
                    SetFocus(.hWnd)            'for Dana's bug
                    InsertString(recv$)
                    Command("TextTop")
                    If EUC_RECEIVE = True Then
                        EucToSjisText()
                    End If
                    SaveAs(fname$(nCnt))
                    Delivery()
                    fname$(nCnt) = .PathName
                End If
                nBytes = ListMail(buf$, stat$)
            Wend
            recv$ = ""
            EndReceiveSession()
        Else
            MsgBox("受信に失敗しました" + Chr(10) + GetErrorStatus())
        End If
    End If

    If nNewCnt > 1 Then
        nRC = DoMenu(hRecvMenu)
        if (nRC <> -1) Then FileOpen(fname$(nRC))
    Else If nNewCnt = 0 Then
        Dim sNew$
        sNew$ = "新着メールはありません"
        If nCnt Then
            sNew$ = sNew$ + Chr(10) + Str(nCnt) + " 通の既読メールがサーバーにあります"
        End If
        MsgBox(sNew$)
    End If
End Proc

'--------------------------------------------------------
' List of Received Mail
'--------------------------------------------------------
Proc ReceivedMail()
    Dim nRC%
    If hRecvMenu Then
        nRC = DoMenu(hRecvMenu)
        if (nRC <> -1) Then FileOpen(fname$(nRC))
    End If
End Proc

'--------------------------------------------------------
' Compose Reply Mail
'--------------------------------------------------------
Proc Reply()
    Dim add$, subj$, cc$, content$
    Dim nRC%
    Silent()
    Command("SelectAll")
    content$ = GetSelected()
    SelectCancel()
    GotoThere(1,1)
    NoSilent()
    Refresh()
    Dim hLine%
    Dim sLine$
    Dim n%, nIdx%, s$
    Dim sArr$(4)
    Dim I%
    For I = 1 To 4
        sArr$(I) = ""
    Next
    hLine = GetTopLine()
    sLine$ = LoadThisLine(hLine)
    If InStr(sLine$, ":") <> 0 Then
        Do
            n = InStr(sLine$, ":")
            If n Then
                s$ = Left(sLine$, n-1)
                Select Case UCase(s$)
                Case "FROM"
                    nIdx = 1
                Case "SUBJECT"
                    nIdx = 2
                Case "CC"
                    nIdx = 3
                Case "REPLY-TO"
                    nIdx = 4
                Case Else
                    nIdx = 0
                End Select
                If nIdx Then
                    sArr$(nIdx) = Trim(Mid$(sLine$, n + 1))
                End If
            Else If sLine$ = "" Then
                Exit Do
            Else
                If nIdx Then
                    sArr$(nIdx) = sArr$(nIdx) + Trim(sLine$)
                End If
            End If
            hLine = GetNext(hLine)
            If hLine = 0 Then Exit Do
            sLine$ = LoadThisLine(hLine)
        Loop While True
    End If
    If sArr$(4) <> "" Then        'Reply-To
        add$ = sArr$(4)
    Else
        add$  = sArr$(1)
    End If
    subj$ = "Re:" + sArr$(2)
    cc$   = sArr$(3)
    If add$ = "" Then
        MsgBox("返信先がわかりません．")
        Return
    End If
    n = InStr(content$, Chr(13) + Chr(10) + Chr(13) + Chr(10))
    If n Then
        content$ = Mid(content$, n + 4, Len(content$))
    End If
    FileOpen(TmpName(outbox$))
    SetFocus(.hWnd)
    Silent()
    InsertString(content$)
    Command("SelectAll")
    AddString("> ")
    SelectCancel()
    GotoThere(1,1)
    InsertString("To: " + add$ + Chr(10))
    InsertString("Subject: " + subj$ + Chr(10))
    If cc$ <> "" Then
        InsertString("Cc: " + cc$ + Chr(10))
    End If
    InsertString(Chr(10))
    Command ("TextBot")
    NoSilent()
    Command ("InsertAft")
    Refresh()
End Proc

'--------------------------------------------------------
' Delete Mail Which Have been Read
'--------------------------------------------------------
Proc Delete()
    Dim I%
    Dim buf$
    Dim stat$
    buf$ = Space$(2048)
    stat$ = Space$(256)
    If MsgBox("サーバー上のメールを全て削除します" + Chr(10) + "よろしいですか？",  "", MB_YESNO) = IDNO Then
        Return
    End If
    MailInit()
    If StartReceiveSession() Then
        I = 0
        While ListMail(buf$, stat$)
            I = I + 1
            If InStr(stat$, "R") = 0 Then
                If MsgBox(buf$ + Chr(10) + "未読メールです" + Chr(10) + "削除してよろしいですか？",  "", MB_YESNO | MB_DEFBUTTON2) = IDYES Then
                    If DeleteMail(I) = False Then
                        MsgBox("削除に失敗しました" + Chr(10) + GetErrorStatus())
                        EndReceiveSession()
                        Return
                    End If
                End If
            Else If DeleteMail(I) = False Then
                MsgBox("削除に失敗しました" + Chr(10) + GetErrorStatus())
                EndReceiveSession()
                Return
            End If
        Wend
        EndReceiveSession()
    End If
End Proc

'////////////////////////////////////////////////////////////////
' Sub routines

Proc UpdateConfig()
    Dim sDel$
    sDel = "  "
    GetConfiguration(g_ini$, g_name$, g_add$, g_login$, g_pop$, g_smtp$, sDel$)
    g_bDel = Val(sDel$)
End Proc

'--------------------------------------------------------
' Delivery Received Mail
'--------------------------------------------------------
Proc Delivery()
    Dim fp%
    Dim s$
    Dim n1%, n2%, i%, nC%
    Dim head$, sch$, fold$
    fp = FOpen(.HomePath + MAILDELI_DAT, "r")
    If fp = 0 Then Return
    s$ = FGets(fp)
    Do
        s$ = Trim(Left(s$, Len(s$)-1))
        If Left(s$, 1) <> "#" And s$ <> "" Then
            i = 0
            n1 = 0
            n2 = 0
            Do
                nC = LodB(s$, i)
                If nC = &H09 Then
                    If n1 = 0 Then
                        n1 = i
                    Else If n2 = 0 Then
                        n2 = i
                        Exit Do
                    End If
                End If
                i = i+1;
            Loop While nC
            If n1 And n2 Then
                head$ = Left(s$, n1)
                sch$  = Mid(s$, n1+2, n2 - (n1+1))
                fold$ = Mid(s$, n2 + 2)
                If fold$ = "ごみ箱" Then
                    fold$ = "trash"
                End If
            End If
            If head$ <> "" And sch$ <> "" And fold$ <> "" Then
                Dim hLine%
                Dim sLine$
                Dim sHead$
                sLine$ = ""
                sHead$ = ""
                hLine = GetTopLine()
                While hLine
                    sLine$ = Trim(LoadThisLine(hLine))
                    If sLine$ = "" Then Exit While
                    i = InStr(sLine$, ":")
                    If i <> 0 Or (i = 0 And sHead$ <> "") Then
                        If i <> 0 Then
                            sHead$ = Left(sLine$, i-1)
                            sLine$ = Mid(sLine$, i+1)
                        End If
                        If UCase(sHead$) = UCase(head$) Then
                            n1 = InStr(sLine$, sch$)
                            If n1 Then
                                Dim sSave$
                                sSave$ = inbox$ + fold$
                                CreateDirectory(sSave$, 0)
                                FKill(.PathName)
                                SaveAs(sSave$ + "\" + .FileName)
                                Return
                            End If
                        End If
                    End If
                    hLine = GetNext(hLine)
                Wend
            End If
        End If
        s$ = FGets(fp)
    Loop While s$ <> ""
    FClose(fp)
End Proc

'--------------------------------------------------------
' Save to Outbox
'--------------------------------------------------------
Proc SaveAsOutMail(add$, cc$, bcc$, subj$, content$, bOutBox%) As String
    Dim outdir$
    Dim fp%
    Dim s$
    If bOutBox Then
        s$ = TmpName(outbox$)
    Else
        s$ = TmpName(outbox$ + "sent\")
    End If
    fp = FOpen(s$, "w")
    If fp Then
        FPuts(fp, "To:" + add$ + Chr(10))
        FPuts(fp, "Cc:" + cc$ + Chr(10))
        FPuts(fp, "Bcc:" + bcc$ + Chr(10))
        FPuts(fp, "Subject:" + subj$ + Chr(10) + Chr(10))
        Dim cr%
        Dim w$
        Dim nLen%
        nLen = Len(content$)
        Do
            cr% = InStr(content$, Chr(13))
            If cr Then
                w$ = Left(content$, cr-1) + Chr(10)
                content$ = Mid$(content$, cr+2, nLen)
            Else
                w$ = content$ + Chr(10)
                content$ = ""
            End If
            FPuts(fp, w$)
        Loop While content$ <> ""
        FClose(fp)
    Else
        MsgBox("送信箱が開けません")
    End If
    Return s$
End Proc

'--------------------------------------------------------
' Get Unique Temporary File Name
'--------------------------------------------------------
Dim nTmpCnt%

Proc TmpName(dirname$) As String
    Dim s$
    Do
        s$ = Date("%m%d%H%M") + "." + Hex$(nTmpCnt)
        nTmpCnt = nTmpCnt + 1
        If nTmpCnt >= &H1000 Then nTmpCnt = 0
        s$ = dirname$ + s$
    Loop While Dir$(s$) <> ""
    Return s$
End Proc

'--------------------------------------------------------
' Get Signature Text
'--------------------------------------------------------
Proc GetSignature() As String
    Dim s$
    Dim sig$
    Dim fp%
    sig$ = Chr(13) + Chr(10)
    fp = FOpen(.HomePath + SIGNATURE_TXT, "r")
    If fp Then
        s$ = FGets(fp)
        While s$ <> ""
            s$ = Left(s$, Len(s$) -1)
            sig$ = sig$ + s$ + Chr(13) + Chr(10)
            s$ = FGets(fp)
        Wend
    End If
    If sig$ = Chr(13) + Chr(10) Then
        sig$ = ""
    End If
    Return sig$
End Proc

'-----------------------------------------------------------
' convert EUC mail to SJIS
'-----------------------------------------------------------
Proc EucToSjisText()
    Dim Cur$, Sav$
    Dim hLine%
    Dim bKanji%
    hLine = GetTopLine()
    Sav$ = Space$(16384)
    Do While hLine
        Cur$ = LoadThisLine(hLine)
        Dim I%, Idx%, Char%, Char2%, nLen%
        Idx = 0
        nLen = Len(Cur$)
        bKanji = False
        For I = 0 To nLen
            Char = LodB(Cur$, I)
            If Char = &H00 Then
                Exit For
            Else
                If Char > &H7F Then
                    bKanji = True
                    I = I + 1
                    If Char = &H85 Then
                        Char2 = LodB(Cur$, I)
                        StoB(Sav$, Idx, Char2)
                        Idx = Idx + 1
                    Else
                        Char = (Char << 8) + LodB(Cur$, I)
                        Char2 = EucToSjis(Char)
                        StoB(Sav$, Idx, Char2 >> 8)
                        StoB(Sav$, Idx+1, Char2 & &HFF)
                        Idx = Idx + 2
                    End If
                Else
                    StoB(Sav$, Idx, Char)
                    Idx = Idx + 1
                End If
            End If
        Next I
        StoB(Sav$, Idx, &H00)
        if bKanji Then hLine = SaveThisLine(hLine, Sav$)
        hLine = GetNext(hLine)
    Loop
End Proc