| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
大量收QQ微信精准粉/交友粉,非诚勿扰千里之行 始于足下
共有 604 人关注过本帖
标题:VB6要如何发信
只看楼主 加入收藏
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
结帖率:98.73%
  已结贴   问题点数:20  回复次数:9   
VB6要如何发信
电脑内并无安装OUTLOOK或其他邮件软体
是否能单纯使用VB6去寄信件~邮件伺服器使用公司内部的~
在ASP.NET可以寄~但是在VB6不知道怎么写?
2018-06-11 13:14
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:224
帖 子:4281
专家分:26128
注 册:2008-10-15
  得分:20 
1、有一个VB6发信的控件,没用过。
2、这个是使用 网络通讯,你完全可以使用 WINSOCK 自己写一个。
只使用 SMTP 协议就可以完成发信。


授人于鱼,不如授人于渔
早已停用QQ了
2018-06-11 13:50
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
CSDN查到这组代码~但是无法运作~
不知道Response是什麼東西老卡在這~
MsgTitle不知道是什麼東西~

程序代码:

Option Explicit

Dim Response As String
Dim Reply As Integer
Dim DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String, Ninth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single

Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, _
              ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)

    Winsock1.LocalPort = 0
        
    If Winsock1.State = sckClosed Then
   
        DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
        first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
        Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
        Third = "Date:" + Chr(32) + DateNow + vbCrLf
        Fourth = "From:" + Chr(32) + FromName + vbCrLf
        Fifth = "To:" + Chr(32) + ToName + vbCrLf
        Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
        Seventh = EmailBodyOfMessage + vbCrLf
        
        Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf  
        Eighth = Fourth + Third + Ninth + Fifth + Sixth  
   
        Winsock1.Protocol = sckTCPProtocol
        Winsock1.RemoteHost = MailServerName
        Winsock1.RemotePort = 25
        Winsock1.Connect
        
        WaitFor ("220")
        
        StatusTxt.Caption = "Connecting...."
        StatusTxt.Refresh
        
        Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
   
        WaitFor ("250")
   
        StatusTxt.Caption = "Connected"
        StatusTxt.Refresh
        Winsock1.SendData (first)
        StatusTxt.Caption = "Sending Message"
        StatusTxt.Refresh
   
        WaitFor ("250")
   
        Winsock1.SendData (Second)
   
        WaitFor ("250")
   
        Winsock1.SendData ("data" + vbCrLf)
        
        WaitFor ("354")
        Winsock1.SendData (Eighth + vbCrLf)
        Winsock1.SendData (Seventh + vbCrLf)
        Winsock1.SendData ("." + vbCrLf)
   
        WaitFor ("250")
   
        Winsock1.SendData ("quit" + vbCrLf)
        
        StatusTxt.Caption = "Disconnecting"
        StatusTxt.Refresh
   
        WaitFor ("221")
   
        Winsock1.Close
    Else
        MsgBox (Str(Winsock1.State))
    End If
   
End Sub

Sub WaitFor(ResponseCode As String)
Dim MsgTitle As String
    Start = Timer
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code." _
                & "Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub

Private Sub cmdSend_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToName.Text, txtoEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
    'MsgBox ("Mail Sent")
    StatusTxt.Caption = "Mail Sent"
    StatusTxt.Refresh
    Beep
    Close
End Sub

Private Sub cmdExit_Click()
    End
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub


[此贴子已经被作者于2018-6-11 14:18编辑过]


不要選我當版主
2018-06-11 14:17
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
Winsock只写过FTP传档案~没试过用来传邮件~

我觉得还是说一下~我是在XP上用VB6开发的Send Mail~
但是是要在Windows2012 R2上运作的~

[此贴子已经被作者于2018-6-11 14:23编辑过]


不要選我當版主
2018-06-11 14:21
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
https://bbs.csdn.net/topics/70230675

代码出处~

不要選我當版主
2018-06-11 14:24
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
结果成功了~之前收不到信的原因是~我同时开启两种网卡~一张公司内部的~一张苹果的~
结果苹果的一切掉~信就进来了~不过还得试试2012行不行~因为成功的不是用贴上的这个~

是用另一个元件Windows内建的CDO.Message~
CDOSYS.dll要去References这个DLL~再写代码~

不要選我當版主
2018-06-11 14:31
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
以下是引用wube在2018-6-11 14:31:42的发言:

结果成功了~之前收不到信的原因是~我同时开启两种网卡~一张公司内部的~一张苹果的~
结果苹果的一切掉~信就进来了~不过还得试试2012行不行~因为成功的不是用贴上的这个~

是用另一个元件Windows内建的CDO.Message~
CDOSYS.dll要去References这个DLL~再写代码~


经过确认此元件只要是Windows OS都能用,所有版本此DLL可供使用,当然也包含Server版OS〜
泛用性比.Net还更广泛,且不需要装任何编译器或SDK或修补档,即可直接使用〜

[此贴子已经被作者于2018-6-14 04:00编辑过]


不要選我當版主
2018-06-14 03:58
wufuzhang
Rank: 3Rank: 3
来 自:广州
等 级:论坛游侠
威 望:1
帖 子:33
专家分:155
注 册:2017-8-9
  得分:0 
推荐一个控件jMail.dll,使用方法简单,功能齐全,
也是SMTP协议发送邮件,设置好服务器,很容易发送邮件。

不经历千百遍的调试,怎能体会成功时那一刹那的喜悦。
2018-06-14 09:04
古123
Rank: 2
等 级:论坛游民
帖 子:26
专家分:12
注 册:2017-2-5
  得分:0 
找到一个临时邮箱不知道可不可以用
程序代码:

'方    法:工程 - 引用-Microsoft WinHTTP Services, version 5.1
Dim 临时邮箱_id As String     '邮箱id
Dim 临时邮箱_sid As String    '页面id
Dim 临时邮箱_yid As String    '邮件id

Public Function 临时邮箱_取邮箱() As String
    On Error GoTo 出错处理:
    Dim 临时邮箱_html As String
    Dim 临时邮箱_Cookie As String
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.Open "GET", "http://24mail.chacuo.net/", True
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.SetRequestHeader "Host", "24mail.chacuo.net"
    WinHttp.SetRequestHeader "Connection", "keep-alive"
    WinHttp.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
    WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.89 Safari/537.36"
    WinHttp.SetRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    WinHttp.Send
    WinHttp.WaitForResponse
   
    While WinHttp.Status <> 200
        DoEvents
    Wend
   
    临时邮箱_html = BytesToBstr(WinHttp.ResponseBody, "UTF-8")
    临时邮箱_Cookie = WinHttp.GetAllResponseHeaders
   
    临时邮箱_sid = Split(Split(临时邮箱_Cookie, "Set-Cookie: sid=")(1), Chr(13))(0)
    临时邮箱_id = Split(Split(临时邮箱_html, "<input  id=" & Chr(34) & "converts" & Chr(34) & " name=" & Chr(34) & "converts" & Chr(34) & " type=" & Chr(34) & "text" & Chr(34) & "  value=" & Chr(34))(1), Chr(34))(0)
   
    临时邮箱_取邮箱 = 临时邮箱_id
   
    Set WinHttp = Nothing
   
    Exit Function
出错处理:
    Select Case Err.Number
    Case -2147012894
        Set WinHttp = Nothing
        临时邮箱_取邮箱 = "临时邮箱_取邮箱_连接超时!"
    Case -2147012889
        Set WinHttp = Nothing
        临时邮箱_取邮箱 = "临时邮箱_取邮箱_网络连接不通!"
    Case Else
        Set WinHttp = Nothing
        临时邮箱_取邮箱 = "临时邮箱_取邮箱_未知错误!"
    End Select
End Function


Public Function 临时邮箱_检测邮件() As String
    On Error GoTo 出错处理:
    Dim 临时邮箱_html As String
    Dim 临时邮箱_Cookie As String
    Dim ShuJu As String
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    ShuJu = "data=" & 临时邮箱_id & "&type=refresh&arg="
    WinHttp.Open "POST", "http://24mail.chacuo.net/", True
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.SetRequestHeader "Host", "24mail.chacuo.net"
    WinHttp.SetRequestHeader "Connection", "keep-alive"
    WinHttp.SetRequestHeader "Content-Length", Len(ShuJu)
    WinHttp.SetRequestHeader "Accept", "*/*"
    WinHttp.SetRequestHeader "Origin", "http://24mail.chacuo.net"
    WinHttp.SetRequestHeader "X-Requested-With", "XMLHttpRequest"
    WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.89 Safari/537.36"
    WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    WinHttp.SetRequestHeader "Referer", "http://24mail.chacuo.net/"
    WinHttp.SetRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    WinHttp.SetRequestHeader "Cookie", "sid=" & 临时邮箱_sid & "; Hm_lvt_ef483ae9c0f4f800aefdf407e35a21b3=1428991007; Hm_lpvt_ef483ae9c0f4f800aefdf407e35a21b3=1428991007; bdshare_firstime=1428991007313; mail_ck=2"
    WinHttp.Send ShuJu       '发送
    WinHttp.WaitForResponse  '异步发送
   
    While WinHttp.Status <> 200
        DoEvents
    Wend
   
    临时邮箱_html = BytesToBstr(WinHttp.ResponseBody, "UTF-8")
    临时邮箱_id = WinHttp.GetAllResponseHeaders
   
    If InStr(临时邮箱_html, Chr(34) & "MID" & Chr(34)) > 0 And InStr(临时邮箱_html, Chr(34) & "SIZE" & Chr(34)) > 0 Then '如果收到邮件
        临时邮箱_yid = Split(Split(临时邮箱_html, Chr(34) & "MID" & Chr(34) & ":")(1), ",")(0)
        临时邮箱_检测邮件 = "True"
    Else                                                                                                                 '如果没有收到邮件
        临时邮箱_检测邮件 = "False"
    End If
   
    Set WinHttp = Nothing
   
    Exit Function
出错处理:
    Select Case Err.Number
    Case -2147012894
        Set WinHttp = Nothing
        临时邮箱_检测邮件 = "临时邮箱_检测邮件_连接超时!"
    Case -2147012889
        Set WinHttp = Nothing
        临时邮箱_检测邮件 = "临时邮箱_检测邮件_网络连接不通!"
    Case Else
        Set WinHttp = Nothing
        临时邮箱_检测邮件 = "临时邮箱_检测邮件_未知错误!"
    End Select
End Function

Public Function 临时邮箱_读取邮件() As String
    On Error GoTo 出错处理:
    Dim 临时邮箱_html As String
    Dim 临时邮箱_Cookie As String
    Dim ShuJu As String
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    ShuJu = "data=" & 临时邮箱_id & "&type=mailinfo&arg=f%3D" & 临时邮箱_yid
    WinHttp.Open "POST", "http://24mail.chacuo.net/", True
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.SetRequestHeader "Host", "24mail.chacuo.net"
    WinHttp.SetRequestHeader "Connection", "keep-alive"
    WinHttp.SetRequestHeader "Content-Length", Len(ShuJu)
    WinHttp.SetRequestHeader "Accept", "*/*"
    WinHttp.SetRequestHeader "Origin", "http://24mail.chacuo.net"
    WinHttp.SetRequestHeader "X-Requested-With", "XMLHttpRequest"
    WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.89 Safari/537.36"
    WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    WinHttp.SetRequestHeader "Referer", "http://24mail.chacuo.net/"
    WinHttp.SetRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    WinHttp.SetRequestHeader "Cookie", "sid=" & 临时邮箱_sid & "; bdshare_firstime=1428991007313; Hm_lvt_ef483ae9c0f4f800aefdf407e35a21b3=1428991007; Hm_lpvt_ef483ae9c0f4f800aefdf407e35a21b3=1428992933; mail_ck=4"
    WinHttp.Send ShuJu       '发送
    WinHttp.WaitForResponse  '异步发送
   
    While WinHttp.Status <> 200
        DoEvents
    Wend
   
    临时邮箱_html = BytesToBstr(WinHttp.ResponseBody, "UTF-8")
    临时邮箱_id = WinHttp.GetAllResponseHeaders
   
    临时邮箱_读取邮件 = 临时邮箱_html
   
    Set WinHttp = Nothing
   
    Exit Function
出错处理:
    Select Case Err.Number
    Case -2147012894
        Set WinHttp = Nothing
        临时邮箱_读取邮件 = "临时邮箱_读取邮件_连接超时!"
    Case -2147012889
        Set WinHttp = Nothing
        临时邮箱_读取邮件 = "临时邮箱_读取邮件_网络连接不通!"
    Case Else
        Set WinHttp = Nothing
        临时邮箱_读取邮件 = "临时邮箱_读取邮件_未知错误!"
    End Select
End Function

Public Function BytesToBstr(strBody, CodeBase)
    Dim ObjStream
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .Write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
        .Close
    End With
    Set ObjStream = Nothing
End Function

'=========================================================
Private Sub Command1_Click()
    Text1.Text = 临时邮箱_取邮箱() & "@027168.com"
End Sub

Private Sub Command2_Click()
    Text2.Text = 临时邮箱_检测邮件()
End Sub

Private Sub Command3_Click()
    Text3.Text = 临时邮箱_读取邮件()
End Sub
'=========================================================调用方法
2018-06-19 09:27
wube
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:17
帖 子:1733
专家分:3607
注 册:2011-3-24
  得分:0 
我是用CDOSYS.DLL代码很短对Exchange Server
程序代码:

    strYouEmail = "123@1111.com.tw" '也能群组寄信
    strCCEmail = "234@1111.com.tw"
    sch = "http://schemas.microsoft.com/cdo/configuration/"
    Set cdoConfig = CreateObject("CDO.Configuration")
    With cdoConfig
        .Fields.Item(sch & "sendusing") = 2 '## (1) 使用 local SMTP, (2) 为外部 SMTP
        .Fields.Item(sch & "smtpserver") = MAILGATE '## 您的网址
        .Fields.Item(sch & "smtpserverport") = 25 '## SMTP Server Port (预设即为 25)
        .Fields.Update
    End With
   
    Set cdoMessage = CreateObject("CDO.Message")
    With cdoMessage
        Set .Configuration = cdoConfig
        .From = "通知信 <" & strYouEmail & ">"
        .To = strYouEmail '## 收件者
        .CC = strCCEmail '## 副本
'
       .BCC = strYouEmail '## 密件副本
        .Subject = "TD FTP TXT Path Error"
'       .HTMLBody = "信件内容" '## HTML 网页格式信件
        .TextBody = Temp '## 文字格式信件内容
'
       .AddAttachment "C:\123.JPG" '## 附加档案
        .Send
    End With
    Set cdoMessage = Nothing
    Set cdoConfig = Nothing


引用自 :
http://www.eion.com.tw/Blogger/?Pid=1134

透过 Gmail SMTP 发信也行

[此贴子已经被作者于2018-6-19 11:28编辑过]


不要選我當版主
2018-06-19 11:25







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.030704 second(s), 8 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved