frmmain.frm

尝试做了一个利用WINSOCK控件的自动分包发送机制的东东(VB6.0)

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "尝试使用WINSOCK控件的自动分包发送机制来做文件传送"
   ClientHeight    =   2235
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7005
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   7005
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtPort 
      Height          =   330
      Left            =   4320
      TabIndex        =   3
      Text            =   "50000"
      Top             =   135
      Width           =   960
   End
   Begin VB.TextBox txtIP 
      Height          =   330
      Left            =   1125
      TabIndex        =   2
      Text            =   "192.168.0.251"
      Top             =   135
      Width           =   1905
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   180
      Top             =   990
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "Send"
      Height          =   330
      Left            =   5400
      TabIndex        =   1
      Top             =   135
      Width           =   1455
   End
   Begin VB.TextBox txtFile 
      Height          =   330
      Left            =   90
      TabIndex        =   0
      Top             =   540
      Width           =   6765
   End
   Begin VB.Label Label3 
      Caption         =   $"frmMain.frx":0000
      Height          =   1140
      Left            =   720
      TabIndex        =   6
      Top             =   990
      Width           =   6135
   End
   Begin VB.Label Label2 
      Caption         =   "服务器端口:"
      Height          =   240
      Left            =   3105
      TabIndex        =   5
      Top             =   180
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "服务器IP:"
      Height          =   240
      Left            =   90
      TabIndex        =   4
      Top             =   180
      Width           =   1050
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'尝试使用WINSOCK控件的自动分包发送机制来做文件传送
'客户端
'BY 嗷嗷叫的老马
'2008-07-29
Option Explicit

Dim theData() As Byte, theFileName As String

Private Sub cmdSend_Click()
    If Dir(txtFile.Text) <> "" Then
        theFileName = GetFileNameInPath(txtFile.Text)
        Open txtFile.Text For Binary As #1      '把文件读到内存
            ReDim theData(LOF(1) - 1)
            Get #1, , theData
        Close #1
        Winsock1.Connect txtIP, txtPort
        cmdSend.Enabled = False
    End If
End Sub

Private Sub Form_Load()
    txtFile.Text = AddStrToStr(App.Path, "\") & "1.jpg"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim CommandStr As String
    
    On Error Resume Next
    
    With Winsock1
        .GetData CommandStr, vbString         '字节方式取回数据
        Debug.Print "Recv = " & CommandStr
        Select Case CommandStr
            Case SER_CONNECT_OK                 '与服务器端连接上了
                .SendData CLI_READY_SENDDATA & _
                          "," & theFileName & _
                          "," & UBound(theData) + 1         '发送"准备发送数据"
                Debug.Print "   Send = " & CLI_READY_SENDDATA
                DoEvents
            Case SER_READY_RECEIVE_DATA         '服务器端已经准备好接收数据
                .SendData theData                   '发送数据,直接一整包扔进去,WINSOCK应该会自动分包发送
                Debug.Print "   Send = theData()"
                DoEvents
            Case SER_RECEIVE_COMPLET            '服务器接收完成
                .SendData CLI_READY_CLOSE           '发送"准备断开"
                Debug.Print "   Send = " & CLI_READY_CLOSE
                DoEvents
            Case SER_ALLOW_CLOSE                '服务器允许断开
                .Close                              '断开连接
                cmdSend.Enabled = True
        End Select
    End With
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)
    Me.Caption = Description
    cmdSend.Enabled = True
End Sub

Private Sub Winsock1_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    Me.Caption = "bytesSent=" & bytesSent & "/" & "bytesRemaining=" & bytesRemaining
End Sub