Global BMail
Global BMail_SmtpServer
Global BMail_MailFrom
Global BMail_PopServer
Global BMail_User
Global BMail_Password
Global BMail_RcvDir
Global BMail_LastError
Global BMail_MailSize
Global BMail_MailCount
Global BMail_MailFile

' ******************************************************
' 初期化
' ******************************************************
Public Function lbInitBMail()

    If Not IsObject(BMail) Then
        Set BMail = CreateObject("Basp21")
    End If

End Function

' ******************************************************
' 受信処理の初期化
' ******************************************************
Public Function lbInitRcv(PopServer, User, Password, RcvDir)

    BMail_PopServer = PopServer
    BMail_User = User
    BMail_Password = Password
    BMail_RcvDir = RcvDir
    If Not FsExist(RcvDir & "", 1) Then
        Call FsMkDir(RcvDir & "")
    End If

End Function

' ******************************************************
' ユーザ・パスワードの初期化
' ******************************************************
Public Function lbInitUserPass(User, Password)

    BMail_User = User
    BMail_Password = Password

End Function

' ******************************************************
' 送信処理の初期化
' ******************************************************
Public Function lbInitSnd(SmtpServer)

    BMail_SmtpServer = SmtpServer

End Function

' ******************************************************
' メール件数の取得
' ******************************************************
Public Function lbGetMailCount() As Long

    Dim Output
    Dim strArray

    ' 初期化
    Call lbInitBMail
    
    ' 受信
    Output = BMail.RcvMail( _
                BMail_PopServer, _
                BMail_User, _
                BMail_Password, _
                "STAT", ">" & BMail_RcvDir _
                )

    ' 正常終了
    If IsArray(Output) Then
        strArray = Split(Output(0), " ")
        If IsArray(strArray) Then
            BMail_MailSize = Val(strArray(1))
            BMail_MailCount = Val(strArray(0))
        Else
            BMail_MailSize = 0
            BMail_MailCount = 0
        End If
    ' 異常終了
    Else
        BMail_MailCount = -1
        BMail_LastError = Output
    End If
    
    lbGetMailCount = BMail_MailCount

End Function

' ******************************************************
' メールタイトルの取得
' ******************************************************
Public Function lbGetMailList()

    Dim Output

    ' 初期化
    Call lbInitBMail
    
    ' 受信
    Output = BMail.RcvMail( _
                BMail_PopServer, _
                BMail_User, _
                BMail_Password, _
                "LIST", ">" & BMail_RcvDir _
                )

    If IsArray(Output) Then
        BMail_MailCount = UBound(Output) + 1
    Else
        BMail_MailCount = 0
    End If

    lbGetMailList = Output

End Function

' ******************************************************
' メールタイトルをグリッドへセット
' ******************************************************
Public Function lbGetMailListToGrid(Grid As MSHFlexGrid)

    Dim Output
    Dim PosFrom
    Dim PosDate
    Dim idx

    ' 初期化
    Call lbInitBMail
        
    Grid.Cols = 4
    
    ' 受信
    Output = BMail.RcvMail( _
                BMail_PopServer, _
                BMail_User, _
                BMail_Password, _
                "LIST", ">" & BMail_RcvDir _
                )

    If IsArray(Output) Then
        BMail_MailCount = UBound(Output) + 1
        Grid.Rows = 2
        Grid.TextMatrix(1, 1) = ""
        For idx = 1 To BMail_MailCount
            Grid.Rows = idx + 1
            PosFrom = InStrRev(Output(idx - 1), "From:")
            PosDate = InStrRev(Output(idx - 1), "Date:")
            Grid.TextMatrix(idx, 0) = idx
            Grid.TextMatrix(idx, 1) = _
                Mid(Output(idx - 1), 10, PosFrom - 10)
            Grid.TextMatrix(idx, 2) = _
                Mid(Output(idx - 1), PosFrom + 6, PosDate - PosFrom - 6)
            Grid.TextMatrix(idx, 3) = _
                Mid(Output(idx - 1), PosDate + 6, Len(Output(idx - 1)) - PosDate - 5)
        Next
    Else
        BMail_MailCount = 0
        Grid.Rows = 1
    End If

    lbGetMailListToGrid = Output

End Function

' ******************************************************
' メールの送信
' ******************************************************
Public Function lbSendMail(Mailto, Mailfrom, Subject, Body)

    ' 初期化
    Call lbInitBMail
    
    If Mailfrom = "" Then
        lbSendMail = BMail.SendMail( _
                BMail_SmtpServer, _
                Mailto, _
                BMail_MailFrom, _
                Subject, Body, "" _
            )
    Else
        lbSendMail = BMail.SendMail( _
                BMail_SmtpServer, _
                Mailto, _
                Mailfrom, _
                Subject, _
                Body, "" _
            )
    End If

End Function

' ******************************************************
' 番号より、本文のみを取得する
' 【戻り値】: 本文
' ******************************************************
Public Function lbRcvMail(MailNo)

    Dim Output
    Dim OutArray

    ' 初期化
    Call lbInitBMail
    
    ' 受信
    BMail_MailFile = ""
    Output = BMail.RcvMail( _
                BMail_PopServer, _
                BMail_User, _
                BMail_Password, _
                "SAVE " & MailNo, ">" & BMail_RcvDir _
                )


    If IsArray(Output) Then
        BMail_MailFile = Output(0)
        OutArray = BMail.ReadMail(Output(0), "body:nofile:", ">" & BMail_RcvDir)
        If IsArray(OutArray) Then
            lbRcvMail = Mid(OutArray(0), 7, Len(OutArray(0)) - 6)
        Else
            lbRcvMail = ""
        End If
    Else
        lbRcvMail = ""
    End If

End Function

' ******************************************************
' 番号より、メールをサーバから削除
' ******************************************************
Public Function lbDelMail(MailNo)
    
    Dim Output
    Dim OutArray

    ' 初期化
    Call lbInitBMail
    
    ' 受信
    BMail_MailFile = ""
    Output = BMail.RcvMail( _
                BMail_PopServer, _
                BMail_User, _
                BMail_Password, _
                "DELE " & MailNo, ">" & BMail_RcvDir _
                )

    If Val(Output) = 1 Then
        lbDelMail = True
    Else
        lbDelMail = False
    End If

End Function

' ******************************************************
' 初期化
' ******************************************************
Private Sub Form_Load()

    Call lbInitSnd("xxx.xxx.xxx.xxx")
    Call lbInitRcv("xxx.xxx.xxx.xxx", "xxxxxx", "xxxxxx", "C:\temp\rcvdir")
    BMail_MailFrom = "lightbox@nifty.com"
    
    Grid.AllowUserResizing = flexResizeColumns
    Grid.ScrollTrack = True

End Sub

' ******************************************************
' Subject、From、Dateヘッダーの一覧
' ******************************************************
Private Sub 一覧取得_Click()

    Call lbGetMailListToGrid(Grid)

End Sub

' ******************************************************
' メールを送る
' ******************************************************
Private Sub 送信_Click()

    Call MsgBox(lbSendMail("xxxxxx@xxxxxx", "", Now, 本文.Text))

End Sub

' ******************************************************
' サーバから削除
' ******************************************************
Private Sub 削除_Click()

    Call lbDelMail(番号.Text)

End Sub

' ******************************************************
' 本文表示
' ******************************************************
Private Sub Grid_DblClick()

    MsgBox lbRcvMail(Grid.Row)
    MsgBox BMail_MailFile

End Sub