frmreceive.frm

Com串口即时通讯工具.有服务端和客启端..是学习的好程度!

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmReceive 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "文件接收中..."
   ClientHeight    =   1665
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1665
   ScaleWidth      =   4980
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   1080
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin ComctlLib.ProgressBar ProgressBar1 
      Height          =   435
      Left            =   300
      TabIndex        =   1
      Top             =   240
      Width           =   4395
      _ExtentX        =   7752
      _ExtentY        =   767
      _Version        =   327682
      Appearance      =   1
   End
   Begin VB.CommandButton cancel 
      Cancel          =   -1  'True
      Caption         =   "关闭(&C)"
      Height          =   435
      Left            =   1800
      TabIndex        =   0
      Top             =   1140
      Width           =   1335
   End
   Begin MSWinsockLib.Winsock sckSystem 
      Left            =   120
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock sckReceive 
      Left            =   120
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label compLabel 
      Height          =   255
      Left            =   300
      TabIndex        =   2
      Top             =   780
      Width           =   4395
   End
End
Attribute VB_Name = "frmReceive"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===============
'信息接收窗体
'===============
'file data
Public sizeOfFile As Double     '文件大小
Public sizeOfFileSent As Double '发送文件大小
Public nameOfFile As String     '文件名
Public pathToFile As String     '文件路径
Public userName As String       '用户名

'specify what host to connect to
Public hostIP As String         '服务器IP地址
Public hostPort As Double       '服务器端口

'privates
Private fileNum As Double

'==============
'取消
'==============
Private Sub cancel_Click()
On Error Resume Next
'发送取消或关闭命令
If cancel.Caption = "Cancel" Then
sckSystem.SendData CANCEL_TRANSFER
Unload Me
ElseIf cancel.Caption = "Close" Then
sckSystem.SendData CLOSE_TRANSFER
Unload Me
End If

End Sub

Private Sub Form_Activate()
'
End Sub

Private Sub Form_Initialize()
'
End Sub

'===============
'窗体初使化过程
'初使化服务器连接等操作
'===============
Private Sub Form_Load()

'设置默认端口号为43597
If hostPort = 0 Then
    hostPort = 43597
End If

MyIM.BuddyUpdater.Enabled = False

'进度条初使化
ProgressBar1.Min = 0
ProgressBar1.value = ProgressBar1.Min
ProgressBar1.Visible = True

'绑定
On Error Resume Next
sckSystem.Close
sckSystem.RemoteHost = hostIP
sckSystem.RemotePort = hostPort       '连接端口
sckSystem.Bind 1982
DoEvents
sckSystem.SendData ENABLE_START
DoEvents
'MsgBox "hostIP = " & hostIP
'MsgBox "hostPort = " & hostPort
'MsgBox "Binding on 1982"

'this one is a tcp/ip control
'sckReceive.Close
'sckReceive.LocalPort = hostPort + 4 ' Port to monitor
'sckReceive.Listen
'sckReceive.Bind hostPort + 4
'MsgBox "hostPort = " & hostPort + 3
'MsgBox "Binding on " & hostPort + 4

End Sub

'==============
'窗体卸载过程
'关闭SOCKET
'==============
Private Sub Form_Unload(cancel As Integer)
    Close fileNum
    sckReceive.Close
    sckSystem.Close
    MyIM.BuddyUpdater.Enabled = True
End Sub

'=================
'数据接收完成过程
'==================
Private Sub sckReceive_Close()
    
    '关闭文件，提示数据接收完成
    Close fileNum
    MsgBox "接收 " & nameOfFile & " 成功"
    Unload Me

End Sub

'=============
'连接请求
'=============
Private Sub sckReceive_ConnectionRequest(ByVal requestID As Long)

    '检查SOCKET状态是否关闭，如果没有关闭，在创建新连接前关闭它
    If sckReceive.State <> sckClosed Then sckReceive.Close
    '接受参数requestID的请求
    sckReceive.Accept requestID

End Sub

'==================
'接收SOCKET数据过程
'==================
Private Sub sckReceive_DataArrival(ByVal bytesTotal As Long)
    Dim TempFileData As String
    '接收数据，保存到文件filenum中
    sckReceive.GetData TempFileData
    Put #fileNum, , TempFileData
    fileLength = LOF(fileNum)
        
    'sizeOfFileSent = sizeOfFileSent + bytesTotal
    sizeOfFileSent = LOF(fileNum)
    On Error GoTo endIt
    '进度条变化
    ProgressBar1.value = sizeOfFileSent
    compLabel.Caption = sizeOfFileSent & " / " & sizeOfFile & " 已接收. " & Int(sizeOfFileSent / sizeOfFile * 100) & "%"
    
    '发送进一步接收数据命令
    sckSystem.SendData CONTINUE_TRANSFER
    DoEvents
    
    Exit Sub

ErrorHandler:
    MsgBox "文件 " & CommonDialog1.FileTitle & ".传输过程中发生错误", vbOKOnly, "错误"
    cancel_Click
endIt:
End Sub

'==================
'命令处理SOCKET接收数据过程
'==================
Private Sub sckSystem_DataArrival(ByVal bytesTotal As Long)

Dim Temp As String
sckSystem.GetData Temp, vbString

Dim Command As String, value As String
'解释接收到的命令
Command = Mid(Temp, 1, 1)
value = Mid(Temp, 2, Len(Temp) - 1)

Select Case Command
    '返回文件大小
    Case FILE_SIZE
        sizeOfFile = value
        'prepare progress bar
        ProgressBar1.Max = sizeOfFile
        queryAcceptDload
    '返回用户名
    Case USER_NAME
        userName = value
        queryAcceptDload
    '返回文件名
    Case FILE_NAME
        nameOfFile = value
        Me.Caption = "接收 " & nameOfFile
        queryAcceptDload
    '处理取消传送命令
    Case CANCEL_TRANSFER
        stopSending
    '关闭传送命令
    Case CLOSE_TRANSFER
        'Close fileNum
        cancel.Caption = "关闭"
    '传送完成
    Case END_TRANSFER
        Close fileNum
        sckSystem.SendData CLOSE_TRANSFER
        cancel.Caption = "关闭"
'        MsgBox "Transfer of " & nameOfFile & " completed successfully."
'        Unload Me
End Select

End Sub

'============
'停止发送过程
'=============
Private Sub stopSending()

    Close fileNum
    MsgBox "用户中止文件传输.", vbOKOnly, "文件传输"
    Unload Me

End Sub

'===============
'接收数据过程
'===============
Private Sub queryAcceptDload()
CommonDialog1.CancelError = True
On Error GoTo endIt

    If sizeOfFile <> 0 And nameOfFile <> "" And userName <> "" Then
    
        Dim Temp
        '询问是否愿意接收数据
        Temp = MsgBox("接收 " & nameOfFile & " (" & sizeOfFile & " bytes) 来自 " & userName & "吗?", vbYesNo, "传送 " & nameOfFile & "?")
        If Temp = vbYes Then
            '启动SOCKET
            sckReceive.Close
            sckReceive.LocalPort = hostPort + 4 ' Port to monitor
            sckReceive.Listen
            DoEvents
            '显示保存文件框，创建文件，用于接收文件
            CommonDialog1.fileName = nameOfFile
            CommonDialog1.ShowSave
            '如果没有选择任何保存文件，则发送取消接收文件命令，取消接收
            If CommonDialog1.fileName = "" Then sckSystem.SendData CANCEL_TRANSFER
            '创建新文件用于保存接收到的文件
            fileNum = FreeFile
            Open CommonDialog1.fileName For Binary Access Write As fileNum
            '发送消息，开始传输
            sckSystem.SendData ACCEPT_TRANSFER
                        
        Else
            cancel_Click
        End If
        
    End If

Exit Sub
endIt:
cancel_Click
End Sub