| |
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
| |