frmrec.frm

vb发送文件,检查邮件,串口操作,查看文件等关于socket的源代码!

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmRec 
   Caption         =   "接收(WinSock)"
   ClientHeight    =   1965
   ClientLeft      =   4455
   ClientTop       =   2085
   ClientWidth     =   6150
   LinkTopic       =   "Form1"
   ScaleHeight     =   1965
   ScaleWidth      =   6150
   Begin MSWinsockLib.Winsock udpServer 
      Left            =   975
      Top             =   135
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock tcpServer 
      Left            =   450
      Top             =   135
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   330
      Left            =   0
      TabIndex        =   0
      Top             =   1635
      Width           =   6150
      _ExtentX        =   10848
      _ExtentY        =   582
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   10425
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FrmRec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mFileName As String
Private mFileHandle As Long

Private Sub Form_Load()
    
    mFileHandle = 0
    mFileName = ""
    
    With Me.tcpServer
        .LocalPort = 1234
        .Listen
    End With
    
    With Me.udpServer
        .Protocol = sckUDPProtocol
        .RemoteHost = "localhost"
        .RemotePort = 9990
        .LocalPort = 9999
        .Bind 9999
    End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
    tcpServer.Close
    udpServer.Close
End Sub

Private Sub SetTipText(ByVal TipText As String)
    ' 用于显示提示、会话过程等信息
    Me.StatusBar1.Panels(1).Text = TipText
End Sub


Private Sub tcpServer_ConnectionRequest(ByVal requestID As Long)
    If tcpServer.State <> sckClosed Then tcpServer.Close
    tcpServer.Accept requestID
End Sub

Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
    ' 接受文件数据
    Dim buff() As Byte
    
    If mFileHandle = 0 Then Exit Sub
    
    ReDim buff(0 To (bytesTotal - 1))
    
    Call tcpServer.GetData(buff, vbArray + vbByte, bytesTotal)
    
    Put #mFileHandle, , buff
End Sub

Private Sub udpServer_DataArrival(ByVal bytesTotal As Long)
    ' 接收会话数据
    
    Dim buff As String
    Dim cmd As String
    
    Call udpServer.GetData(buff, , bytesTotal)
    SetTipText buff
    If Left(buff, 1) = ":" Then     ' 如果以“：”开始表示命令
        Select Case True
        Case Left(buff, 6) = ":Close"
            tcpServer.Close
        Case Left(buff, 10) = ":FileName="  ' 设置文件名称
            If Len(mFileName) > 0 Then
                SetTipText "不允许传输第二个文件"
            Else
                mFileName = Mid(buff, InStr(buff, "=") + 1)     ' 等号后的是文件名
                
                mFileHandle = FreeFile
                Open (App.Path & "\" & mFileName) For Binary Access Write As mFileHandle
                
            End If
        Case Left(buff, 9) = ":Complete"   ' 文件传输完成
            If mFileHandle <> 0 Then
               Close mFileHandle
               mFileHandle = 0
            End If
        End Select
    End If
End Sub