VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 1851|回复: 0

[求助] 用论坛里面大神们的线程调用jmail.dll 邮件就不能发送出去.....

[复制链接]
发表于 2016-4-6 18:50:46 | 显示全部楼层 |阅读模式
RT,本菜在程序按钮里面直接调用就可以发送出去,然而到了线程里面去调用同一个函数,就发不出去了,提示 "The message was undeliverable. All servers failed to receive the message"

蛋疼中.....


发送函数是这样的

Public Function SendMail(sMailuser As String, sMailpass As String, SMTPadrs As String, sMailadrs As String, _
                         sMailStr As String, rMailuser As String, Optional Fileadrs As String, _
                         Optional sMailname As String, Optional mailTitle As String, Optional HttpFile As String) As String
                         '发件帐号,发件密码,STMP地址,发件人地址,邮件正文,收信帐号,附件(多个用逗号隔开),发件人,邮件主题,附件下载地址(多个用逗号隔开)
                        
                         On Error GoTo ToExit
                         Dim Jmail
                         Dim ErrorTimes As Integer, A() As String, i As Integer, C() As String
                         ErrorTimes = 0
                         Set Jmail = CreateObject("Jmail.Message")
                        
                         If InStr(1, Fileadrs, ",") = 0 Then '=====添加本地附件..
                           If InStr(1, Fileadrs, ":\") <> 0 And Dir(Fileadrs) <> "" Then: Jmail.AddAttachment Fileadrs '添加一个附件
                           Else
                           A = Split(Fileadrs, ",")
                             For i = 0 To UBound(A)
                                If InStr(1, A(i), ":\") <> 0 And Dir(A(i)) <> "" Then
                                  Jmail.AddAttachment A(i) '逐一添加附件
                                End If
                             Next i
                         End If

                         If InStr(HttpFile, ",") = 0 Then  '======= 添加网络附件,下载后发送
                             If InStr(HttpFile, "://") <> 0 Then
                               C = Split(HttpFile, "/")
                               Jmail.AddURLAttachment HttpFile, C(UBound(C)) '添加一个附件,文件名不变
                             End If
                           Else
                           A = Split(HttpFile, ",")
                             For i = 0 To UBound(A)
                                If InStr(1, A(i), "://") <> 0 Then
                                  C = Split(A(i), "/")
                                  Jmail.AddURLAttachment A(i), C(UBound(C)) '逐一下载并添加附件
                                End If
                             Next i
                         End If

                        
                         If SMTPadrs = LCase("smtp.mxhichina.com") Then: sMailuser = sMailadrs '阿里企邮特殊处理
                         If SMTPadrs = LCase("smtp.exmail.qq.com") Then: sMailuser = sMailadrs '腾讯企邮特殊处理
                        
                         If sMailname = "" Then: sMailname = "阿拉灯" '发件人姓名
                         If mailTitle = "" Then: mailTitle = "您收到来自阿拉灯提取的文件" '邮件主题
'
'                         MsgBox "发件帐号:" & sMailuser & vbCrLf & _
'                                "邮件密码:" & sMailpass & vbCrLf & _
'                                "发件邮箱:" & sMailadrs & vbCrLf & _
'                                "SMTP地址:" & SMTPadrs & vbCrLf & _
'                                "邮件正文:" & sMailStr & vbCrLf & _
'                                "收件邮箱:" & rMailuser & vbCrLf & _
'                                "附件地址:" & Fileadrs & vbCrLf & _
'                                "发件人  :" & sMailname & vbCrLf & _
'                                "邮件主题:" & mailTitle
                        
                             Jmail.Charset = "gb2312"
                             Jmail.Silent = False
                             Jmail.Priority = 3  '邮件状态,1-5 1为最高
                             Jmail.MailServerUserName = sMailuser       '发件人Email帐号,自己改
                             Jmail.MailServerPassWord = sMailpass       '发件人Email密码,自己改

                             Jmail.FromName = sMailname           '发信人姓名,自己改
                             Jmail.From = sMailadrs  '发邮件地址,自己改

                             Jmail.Subject = mailTitle                '主题
                             Jmail.AddRecipient rMailuser      '收信人地址
                             Jmail.Body = sMailStr                   '信件正文

                             Jmail.Send (SMTPadrs)      'SMTP服务器,如smtp.sohu.com
                             DoEvents
                             Set Jmail = Nothing
                             SendMail = "发送成功"
                             Exit Function
ToExit:
                        ErrorTimes = ErrorTimes + 1
                        If ErrorTimes < 3 Then Resume
                        Select Case Jmail.ErrorCode
                        Case 550
                            SendMail = "邮件地址不存在"
                        Case 535
                            SendMail = "用户名或密码错误"
                        Case Else
                            SendMail = Jmail.ErrorMessage
                        End Select
                        SendError = True

End Function

然后线程模块

Private Declare Function UserDllMain Lib "msvbvm60.dll" (gloaders As Long, gvb As Long, ByVal hinstDLL As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
Private Declare Function VBDllGetClassObject Lib "msvbvm60.dll" (gloaders As Long, gvb As Long, ByVal gvbtab As Long, rclsid As UUID, riid As UUID, ppv As Any) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Private Declare Function CoInitialize Lib "ole32.dll" (ByVal pvReserved As Long) As Long
Private Declare Sub CoUninitialize Lib "ole32.dll" ()
Private Declare Function CreateIExprSrvObj Lib "msvbvm60.dll" (ByVal p1_0 As Long, ByVal p2_4 As Long, ByVal p3_0 As Long) As Long ' VBGOOD 老汉大神  , 各种大神

Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadA As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long '创建线程
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long '创建线程


我郁闷了一晚上...........

点评

可能是发送邮件模块不兼容多线程  发表于 2016-4-9 23:05
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-1 22:05

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表