在 每 winsock 发送 命令后,加 一句:
DoEvents
============
如:
Wsock.SendData tmpstr & vbCrLf
DoEvents
====================================
把你代码 发过来 看看 .
[email protected]
DoEvents
============
如:
Wsock.SendData tmpstr & vbCrLf
DoEvents
====================================
把你代码 发过来 看看 .
[email protected]
一样不好用
sonicdater(发呆呆(我答问题*不吵架*因为我呆))
你试试 象下面这样 改写你的程序 ：
=================================================================
Private Enum SMTP_State
MAIL_CONNECT
MAIL_HELO
MAIL_FROM
MAIL_RCPTTO
MAIL_DATA
MAIL_DOT
MAIL_QUIT
End EnumPrivate m_State As SMTP_State
Private m_strEncodedFiles As String
'Private Sub cmdAddFile_Click()
With ComDialog
.ShowOpen
If Len(.FileName) > 0 Then
lstAttachments.AddItem .FileName
End If
End WithEnd SubPrivate Sub cmdClose_Click() Unload Me
End SubPrivate Sub cmdNew_Click() txtRecipient = ""
txtSubject = ""
txtMessage = ""
End SubPrivate Sub cmdRemove_Click() On Error Resume Next
lstAttachments.RemoveItem lstAttachments.ListIndexEnd SubPrivate Sub cmdSend_Click()
'
Dim i As Integer
'
'prepare attachments
'
For i = 0 To lstAttachments.ListCount - 1
lstAttachments.ListIndex = i
m_strEncodedFiles = m_strEncodedFiles & _
UUEncodeFile(lstAttachments.Text) & vbCrLf
Next i
'
Winsock1.Connect Trim$(txtHost), 25
m_State = MAIL_CONNECT
'
End SubPrivate Sub Form_Load()
'
'clear all textboxes
'
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
End If
Next
'
End SubPrivate Sub Form_Unload(Cancel As Integer)
Set m_colAttachments = Nothing
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'Retrive data from winsock buffer
'
Winsock1.GetData strServerResponse
'
Debug.Print strServerResponse
'
'Get server response code (first three symbols)
'
strResponseCode = Left(strServerResponse, 3)
'
'Only these three codes tell us that previous
'command accepted successfully and we can go on
'
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then
Select Case m_State
Case MAIL_CONNECT
'Change current state of the session
m_State = MAIL_HELO
'
'Remove blank spaces
strDataToSend = Trim$(txtSender)
'
'Retrieve mailbox name from e-mail address
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'Send HELO command to the server
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
'
Debug.Print "HELO " & strDataToSend
'
Case MAIL_HELO
'
'Change current state of the session
m_State = MAIL_FROM
'
'Send MAIL FROM command to the server
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
'
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_FROM
'
'Change current state of the session
m_State = MAIL_RCPTTO
'
'Send RCPT TO command to the server
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
'
Debug.Print "RCPT TO:" & Trim$(txtRecipient)
'
Case MAIL_RCPTTO
'
'Change current state of the session
m_State = MAIL_DATA
'
'Send DATA command to the server
Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"
'
Case MAIL_DATA
'
'Change current state of the session
m_State = MAIL_DOT
'
'So now we are sending a message body
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'
'Send Subject line
Winsock1.SendData "Subject:" & txtSubject & vbLf & vbCrLf
'
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String
'
'Add atacchments
strMessage = txtMessage & vbCrLf & vbCrLf & m_strEncodedFiles
'clear memory
m_strEncodedFiles = ""
'Parse message to get lines (for VB6 only)
varLines = Split(strMessage, vbCrLf)
'clear memory
strMessage = ""
'
'Send each line of the message
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
'
Debug.Print CStr(varLine)
Next
'
'Send a dot symbol to inform server
'that sending of message comleted
Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT
'Change current state of the session
m_State = MAIL_QUIT
'
'Send QUIT command to the server
Winsock1.SendData "QUIT" & vbCrLf
'
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select
Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error"
Else
MsgBox "Message sent successfuly.", vbInformation
End If
'
End If
End SubPrivate Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) MsgBox "Winsock Error number " & Number & vbCrLf & _
Description, vbExclamation, "Winsock Error"End Sub
请问：
lstAttachments是什么控件或引用？不懂啊？
你看到我的信了吗？我的程序有何错误？请指正，拜托了，很急的。
Winsock1.SendData "." & vbCrLf能否解释一下呢？另外UUEncodeFile（）函数是不是解码程序呢？
如:
Public Function Base64_Encode(strSource) As String
'
Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'
Dim strTempLine As String
Dim j As Integer
'
For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'
'1 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'2 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
'3 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
'4 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
Next j
'
If Not (Len(strSource) Mod 3) = 0 Then
'
If (Len(strSource) Mod 3) = 2 Then
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
'
strTempLine = strTempLine & "="
'
ElseIf (Len(strSource) Mod 3) = 1 Then
'
'
strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
'
strTempLine = strTempLine & "=="
'
End If
'
End If
'
Base64_Encode = strTempLine
'
End Function是否可以代替？谢谢
http://www.dapha.net/vb/list.asp?id=1401
http://www.dapha.net/vb/list.asp?id=979
我的Email:[email protected]
你的程序是否很稳定呢？我可用了！！
不过我还是希望你能看看我的代码
我再给你发一次
你看看吧
谢谢了！
：）
你的程序不好用啊，能不能再看看我的程序哪出错啊！
拜托了！