frmmain.frm

vb代码集,收集许多VB网络编程代码

    
    'Check up textboxes
    For Each c In Controls
        If TypeOf c Is TextBox And c.Name <> "txtBody" Then
            If Len(c.Text) = 0 Then
                MsgBox c.Name & " can't be empty", vbCritical
                Exit Sub
            End If
        End If
    Next
    '
    'Change current state of session
    m_State = POP3_Connect
    '
    'Reset current state of socket
    Winsock1.Close
    '
    'Reset local port value to prevent "Address in use" error
    Winsock1.LocalPort = 0
    '
    'POP3 server software is listening for client connection
    'requests on 110 port, therefore we need connect to host
    'on 110 port
    Winsock1.Connect txtHost, 110

End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    
    Dim strFileName As String
    Dim strMessage As String
    Dim strAttachment As String
    Dim lngPosA As Long
    Dim lngPosB As Long
    
    strMessage = m_colMessages(lvMessages.SelectedItem.Key).MessageText
    strFileName = lvAttachments.SelectedItem.Key
    lngPosA = InStr(1, strMessage, " " & strFileName)
    If lngPosA > 0 Then
        lngPosB = InStrRev(strMessage, vbCrLf, lngPosA) + 2
        If lngPosB > 2 Then
            If (Mid$(strMessage, lngPosB, lngPosA - lngPosB + Len(strFileName) + 1)) Like _
                ("begin ### " & strFileName) Then
                 lngPosA = InStr(lngPosA, strMessage, "`" & vbCrLf & "end" & vbCrLf)
                 If lngPosA > 0 Then
                    With ComDialog
                        '
                        'On Error Resume Next
                        '
                        .FileName = strFileName
                        .ShowSave
                        If Err = 0 Then
                            strAttachment = Mid$(strMessage, lngPosB, lngPosA + 8 - lngPosB)
                            UUDecodeToFile strAttachment, .FileName
                        End If
                    End With
                End If
            End If
        End If
    End If
        

End Sub

Private Sub Form_Load()

    With TabStrip1
        txtBody.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
        Frame5.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
    End With
    
    txtBody.ZOrder 0
    
End Sub

Private Sub lvMessages_ItemClick(ByVal Item As ComctlLib.ListItem)

    Dim oAttachment As CAttachment
    Dim lvItem As ListItem
    
    lvAttachments.ListItems.Clear
    
    For Each oAttachment In m_colMessages(Item.Key).Attachments
        Set lvItem = lvAttachments.ListItems.Add(, oAttachment.FileName, oAttachment.FileName)
        lvItem.SubItems(1) = oAttachment.Size
    Next
    
    txtBody = m_colMessages(Item.Key).MessageBody
    
End Sub

Private Sub TabStrip1_Click()

    If TabStrip1.SelectedItem.Index = 1 Then
        txtBody.ZOrder 0
    Else
        Frame5.ZOrder 0
    End If

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Dim strData As String
    
    Static intMessages          As Integer
    Static intCurrentMessage    As Integer
    Static strBuffer            As String
    '
    'Retrieve, received from server, data.
    Winsock1.GetData strData
    Debug.Print strData
    
    If Left$(strData, 1) = "+" Or m_State = POP3_RETR Then
        'If first symbol of server response is "+"
        'server has accepted previous client command
        'and it is waiting for next actions.
        Select Case m_State
            Case POP3_Connect
                '
                'Reset message counter
                intMessages = 0
                '
                'Change current state of session
                m_State = POP3_USER
                '
                'Send to server USER command to tell him
                'which mailbox we want check out
                Winsock1.SendData "USER " & txtUserName & vbCrLf
                Debug.Print "USER " & txtUserName
            Case POP3_USER
                '
                'Change current state of session
                m_State = POP3_PASS
                '
                'Send password with PASS command
                Winsock1.SendData "PASS " & txtPassword & vbCrLf
                Debug.Print "PASS " & txtPassword
            Case POP3_PASS
                '
                'Change current state of session
                m_State = POP3_STAT
                '
                'Send STAT command to know how many
                'messages in the mailbox
                Winsock1.SendData "STAT" & vbCrLf
                Debug.Print "STAT"
            Case POP3_STAT
                '
                'Parse server response to get number
                'of messages in the mailbox
                intMessages = CInt(Mid$(strData, 5, _
                              InStr(5, strData, " ") - 5))
                If intMessages > 0 Then
                    '
                    'OK! We have one or more.
                    'Change current state of session
                    m_State = POP3_RETR
                    '
                    'Increase counter to know wich message
                    'we will retrieving
                    intCurrentMessage = intCurrentMessage + 1
                    '
                    'And send RETR command to download
                    'first message
                    Winsock1.SendData "RETR 1" & vbCrLf
                    Debug.Print "RETR 1"
                Else
                    '
                    'We have not any message in the mailbox.
                    'Send QUIT command and show to user a message
                    'that she or he has not mail.
                    m_State = POP3_QUIT
                    Winsock1.SendData "QUIT" & vbCrLf
                    Debug.Print "QUIT"
                    MsgBox "You have not mail.", vbInformation
                End If
            Case POP3_RETR
                '
                'Accumulate message data in strBuffer static variable
                strBuffer = strBuffer & strData
                '
                'Until we have been found single dot symbol on a line.
                If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                    '
                    'OK! We have received a message.
                    '
                    'Remove server response string
                    strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                    '
                    'Remove dot symbol that is at the end of a message
                    strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                    '
                    'Add new message to m_colMessages collection
                    Set m_oMessage = New CMessage
                    m_oMessage.CreateFromText strBuffer
                    m_colMessages.Add m_oMessage, m_oMessage.MessageID
                    Set m_oMessage = Nothing
                    '
                    'Clear buffer for next message
                    strBuffer = ""
                    '
                    If intCurrentMessage = intMessages Then
                        '
                        'We have received all messages, and
                        'we need say QUIT
                        m_State = POP3_QUIT
                        Winsock1.SendData "QUIT" & vbCrLf
                        Debug.Print "QUIT"
                    Else
                        '
                        'We have messages to download
                        'Increase message counter
                        intCurrentMessage = intCurrentMessage + 1
                        '
                        'Change current state of session
                        m_State = POP3_RETR
                        '
                        'Send RETR command to download next message
                        Winsock1.SendData "RETR " & _
                        CStr(intCurrentMessage) & vbCrLf
                        Debug.Print "RETR " & intCurrentMessage
                    End If
                End If
            Case POP3_QUIT
                Winsock1.Close
                Call ListMessages
        End Select
    Else
            Winsock1.Close
            MsgBox "POP3 Error: " & strData, _
            vbExclamation, "POP3 Error"
    End If
End Sub

Private 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 & vbCrLf & _
            Description
            
End Sub

Private Sub ListMessages()

    Dim oMes As CMessage
    Dim lvItem As ListItem
    
    For Each oMes In m_colMessages
        Set lvItem = lvMessages.ListItems.Add
        lvItem.Key = oMes.MessageID
        lvItem.Text = oMes.From
        lvItem.SubItems(1) = oMes.Subject
        lvItem.SubItems(2) = oMes.SendDate
        lvItem.SubItems(3) = oMes.Size
    Next
    
End Sub