如何使用API收发邮件，如何用API进行BASE64编解码

最新推荐文章于 2020-04-08 15:33:12 发布

qaymuic

最新推荐文章于 2020-04-08 15:33:12 发布

阅读量1.4k

点赞数

文章标签： api string function byte 邮件服务器测试

本文链接：https://blog.csdn.net/qaymuic/article/details/10629

版权

minfo.dll是我做的一个收发邮件的动态连接库，目前是测试版。可以从http://xlrj.com/am下载。以下是readme.txt的内容：

这是测试版本，请将MINFO.DLL放入系统目录（例如：c:/windows/system）
minfo.dll包括以下api:
Public Declare Function Logon Lib "minfo.dll" (popinfo As popinfo, ByVal er As String) As Long
登录pop3服务器，如果成功，应使用Logoff退出。
Public Declare Function DeleteMail Lib "minfo.dll" (ByVal nIndex As Long, ByVal er As String) As Long
删除指定的邮件
Public Declare Function GetMailInfo Lib "minfo.dll" (mount As Long, minfo As Long, ByVal er As String) As Long
获取邮件信息，包括邮件数目，邮件标题、发件人、邮件长度、邮件日期
Public Declare Function GetMailData Lib "minfo.dll" (ByVal nIndex As Long, ByVal filename As String, ByVal er As String) As Long
获取指定的邮件内容，并存入文件
Public Declare Sub Logoff Lib "minfo.dll" ()
退出pop3邮件服务器
Public Declare Function Encode Lib "minfo.dll" (data As Byte, ByVal l As Long, rtnlong As Long) As Long
base64编码字节数组
Public Declare Function Decode Lib "minfo.dll" (data As Byte, l As Long) As Long
base64解码字节数组
Public Declare Function SendMail Lib "minfo.dll" (smtpin As smtpinfo, maildata As Byte, ByVal subject As String, ByVal attachment As String, ByVal er As String) As Long
发送邮件

test.xls提供了使用这些api的一些范例。以下是该文件的VBA代码：

Type popinfo
user As String       '用户名
pass As String         '密码
popsvr As String       '接收邮件服务器
End Type
Type mailinfo
from As Long     '发件人
subject As Long     '邮件主题
date As Long   '邮件日期
mlen As Long            '邮件长度
End Type
Type smtpinfo
smtpsvr As String      'smtp服务器
sender As String       '发件人
receiver As String     '收件人，多个收件人用 , 隔开
auth As Long         '是否需要AUTH认证 1 需要 0 不需要
user As String          '用户名
pass As String          '密码
End Type
Public Declare Sub Logoff Lib "minfo.dll" ()
Public Declare Function Logon Lib "minfo.dll" (popinfo As popinfo, ByVal er As String) As Long
Public Declare Function DeleteMail Lib "minfo.dll" (ByVal nIndex As Long, ByVal er As String) As Long
Public Declare Function SendMail Lib "minfo.dll" (smtpin As smtpinfo, maildata As Byte, ByVal subject As String, ByVal attachment As String, ByVal er As String) As Long    '发送邮件
Public Declare Function GetMailInfo Lib "minfo.dll" (mount As Long, minfo As Long, ByVal er As String) As Long '获取邮件信息
Public Declare Function Encode Lib "minfo.dll" (data As Byte, ByVal l As Long, rtnlong As Long) As Long       'BASE64编码
Public Declare Function Decode Lib "minfo.dll" (data As Byte, l As Long) As Long                 'BASE64解码
Public Declare Function GetMailData Lib "minfo.dll" (ByVal nIndex As Long, ByVal filename As String, ByVal er As String) As Long    '获取邮件内容
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub EncodeIt()
Dim hh() As Byte   '编码前的字节数组
hh = StrConv("为了提前为您提供服务，您的软件作品可以现在就通过我们的系统自动加入。", vbFromUnicode) '被编码的字节数组
Dim ll As Long      '编码后字节数组地址
Dim rlong As Long   '编码后长度
ll = Encode(hh(0), UBound(hh) + 1, rlong) 'UBound(hh) + 1是待解码字节数组长度
Dim lll() As Byte
ReDim lll(rlong - 1)
CopyMemory lll(0), ByVal ll, rlong
Dim llll As String
llll = StrConv(lll, vbUnicode)
MsgBox llll
End Sub

Sub DecodeIt()
Dim gg() As Byte        '待解码字节数组
Dim bb As Long           '解码后字节数组地址
Dim m As Long            '解码后字节数组的长度
Dim ff As String
ff = "PCFET0NUWVBFIEhUTUwgUFVCTElDICItLy9XM0MvL0RURCBIVE1MIDQuMCBUcmFuc2l0aW9uYWwv"
ff = ff & vbCrLf & "PCFET0NUWVBFIEhUTUwgUFVCTElDICItLy9XM0MvL0RURCBIVE1MIDQuMCBUcmFuc2l0aW9uYWwv"
ff = ff & vbCrLf & "dD0idGV4dC9odG1sOyBjaGFyc2V0PWdiMjMxMiI+DQo8TUVUQSBjb250ZW50PSJNU0hUTUwgNi4w"
ff = ff & vbCrLf & "MC4yNzE1LjQwMCIgbmFtZT1HRU5FUkFUT1I+DQo8U1RZTEU+PC9TVFlMRT4NCjwvSEVBRD4NCjxC"
ff = ff & vbCrLf & "T0RZIGJnQ29sb3I9I2ZmZmZmZj4NCjxESVY+PEZPTlQgc2l6ZT0yPsTjw8e1xMjtvP7K1NPDyrHD"
ff = ff & vbCrLf & "3MLryuTKssO0PC9GT05UPjwvRElWPjwvQk9EWT48L0hUTUw+DQo="
gg = StrConv(ff, vbFromUnicode)
bb = Decode(gg(0), m)
Dim cc() As Byte
ReDim cc(m - 1)
CopyMemory cc(0), ByVal bb, m
Dim dd As String
dd = StrConv(cc, vbUnicode)
MsgBox dd
End Sub
Sub GetMail()
On Error GoTo BBB
Dim info1 As popinfo
info1.user = "whypop3"     '用户名
info1.pass = "whypop3"        '密码
info1.popsvr = "pop.163.com"    'pop3邮件服务器
Dim info2() As mailinfo       '作为邮件信息将被返回
Dim s As String     '出错信息
Dim rc As Long      '1,代表成功，0,失败
Dim c As Long       '邮件数目
Dim temp As Long   '邮件信息地址
Dim n As Long
s = String(255, Chr(0))
rc = Logon(info1, s)
If rc = 0 Then
MsgBox s
Exit Sub
End If
rc = GetMailInfo(c, temp, s)
If rc = 0 Then
MsgBox s
ElseIf c = 0 Then
MsgBox "您没有新邮件"
Else
ReDim info2(c - 1)
CopyMemory info2(0), ByVal temp, Len(info2(0)) * c
vv = "您共有" & c & "封邮件"
For i = 0 To c - 1
Dim from As String
Dim subject As String
Dim dat As String
Dim lenth As Long
CopyMemory from, info2(i).from, 4
CopyMemory subject, info2(i).subject, 4
CopyMemory dat, info2(i).date, 4
CopyMemory lenth, info2(i).mlen, 4
vv = vv & vbCrLf & vbCrLf & "发件人：" & Left(from, InStr(from, Chr(0)) - 1)
vv = vv & " " & "主题：" & Left(subject, InStr(subject, Chr(0)) - 1)
vv = vv & " " & "长度：" & lenth
vv = vv & "   " & "发件日期：" & Left(dat, InStr(dat, Chr(0)) - 1)
Next
MsgBox vv
s = String(255, Chr(0))
Dim l1 As Long
l1 = GetMailData(1, "e:/temp.eml", s) '1 邮件序号， "e:/temp.eml" 存储到文件名
If l1 = 0 Then
MsgBox s
GoTo BBB
End If
ShellExecute 0, "open", "e:/temp.eml", "", "", SW_SHOWNORMAL
DeleteMail 1, s    '1 邮件序号
MsgBox s
End If
BBB:
Logoff
End Sub
Sub sendemail()
Dim smtpin As smtpinfo
Dim s As String
s = String(255, Chr(0))
smtpin.sender = "whypop3@163.COM"
smtpin.receiver = "whypop3@163.com"
smtpin.smtpsvr = "smtp.163.com"
smtpin.auth = 1
smtpin.user = "whypop3"
smtpin.pass = "whypop3"
Dim gg As String
gg = vbCrLf & vbCrLf & "hello!everybody!!!"
Dim dby() As Byte
dby = StrConv(gg, vbFromUnicode)
Dim rc As Long
rc = SendMail(smtpin, dby(0), "测试程序", "e:/temp.eml" & Chr(34) & "e:/temp.exe", s) '几个参数分别为smtpinfo结构，邮件内容字节数组，主题，附件名称（用 " 隔开多个附件），出错信息
If rc = 1 Then
MsgBox "发送成功！"
Else
MsgBox "发送失败！" & vbCrLf & s
End If
End Sub