frmsend.frm

ICQ通讯程序 ICQ通讯程序 ICQ通讯程序

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmSend 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Sending File"
   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  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Height          =   435
      Left            =   720
      TabIndex        =   3
      Top             =   1140
      Width           =   1335
   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 
      Caption         =   "Cancel"
      Enabled         =   0   'False
      Height          =   435
      Left            =   2520
      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 sckSend 
      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 = "frmSend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public hIn, fileLength, ret
Public Temp As String
Public blockSize As Long

'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
Public hostPort As Double

'privates
Private quitNow As Boolean

Private Sub cancel_Click()

If cancel.Caption = "Cancel" Then
sckSystem.Close
sckSystem.Bind
sckSystem.SendData CANCEL_TRANSFER
Unload Me
quitNow = True
ElseIf cancel.Caption = "Close" Then
sckSend.Close   'this severes the data connection, causing the client to save/end the file

Close hIn
'SendFile = True
Unload Me
End If

End Sub

Private Sub Command1_Click()
compLabel.Caption = "Waiting For Other Side To Accept Transfer..."
sckSystem.SendData FILE_NAME & nameOfFile
sckSystem.SendData FILE_SIZE & sizeOfFile
sckSystem.SendData USER_NAME & userName
cancel.Enabled = True
Command1.Enabled = False
End Sub

Private Sub Form_Load()

'this defaults port to connect on to 43597 incase it is not set from outside of this form
If hostPort = 0 Then
    hostPort = 43597
End If

'Disable buddy list updater for transfer
'MyIM.BuddyUpdater.Enabled = False

Me.Caption = "Ready to send " & nameOfFile

'find the file size
sizeOfFile = FileLen(pathToFile)

'prepare progress bar
ProgressBar1.Max = sizeOfFile
ProgressBar1.Min = 0
ProgressBar1.value = ProgressBar1.Min
ProgressBar1.Visible = True

'bind sck controls
sckSystem.Close
sckSystem.RemoteHost = hostIP
sckSystem.LocalPort = hostPort ' Port to monitor
sckSystem.RemotePort = hostPort ' Port to connect to.
sckSystem.Bind 1983

'this one is tcp/ip
sckSend.RemoteHost = hostIP
sckSend.RemotePort = hostPort + 5 ' Port to connect to.
'sckSend.Bind hostPort + 4
'MsgBox "hostPort = " & hostPort + 5
'MsgBox "Binding on " & hostPort + 4

'send initialization information
'sckSystem.SendData FILE_NAME & nameOfFile
'sckSystem.SendData FILE_SIZE & sizeOfFile
'sckSystem.SendData USER_NAME & userName

End Sub

Private Sub Form_Unload(cancel As Integer)
MyIM.BuddyUpdater.Enabled = True
End Sub

Private Sub sckSystem_DataArrival(ByVal bytesTotal As Long)

blockSize = 2048

Dim tempComData As String
sckSystem.GetData tempComData, vbString

Dim Command As String
Command = Mid(tempComData, 1, 1)

'MsgBox command
If Command = CANCEL_TRANSFER Then
    stopSending
End If

If Command = ENABLE_START Then Command1.Enabled = True

If Command = ACCEPT_TRANSFER Then
        DoEvents
        sckSend.Connect
        Do Until sckSend.State = sckConnected ' Wait until connected
            DoEvents
        Loop
        GoTo BeginTransfer
End If

If Command = CONTINUE_TRANSFER Then
'On Error GoTo ErrorHandler
        ' Adjust blocksize at end so we don't read too much data
        If fileLength - Loc(hIn) <= blockSize Then
            blockSize = fileLength - Loc(hIn) + 1
        End If
        Temp = Space$(blockSize)        '// Allocate the read buffer
        Get hIn, , Temp                 '// Read a block of data
        ret = DoEvents()                '// Check for cancel button event etc.
        If quitNow Then GoTo endIt
        sckSend.SendData Temp           '// Off it goes
        
        'update progress bar
        sizeOfFileSent = sizeOfFileSent + blockSize
        'On Error GoTo endIt             '//
        On Error Resume Next
        ProgressBar1.value = sizeOfFileSent
        compLabel.Caption = sizeOfFileSent & " of " & sizeOfFile & " sent. " & Int(sizeOfFileSent / sizeOfFile * 100) & "%"
        DoEvents
        
        If sizeOfFileSent >= sizeOfFile Then
            cancel.Caption = "Close"
            sckSystem.SendData CLOSE_TRANSFER
        End If
        Exit Sub
End If
If Command = CLOSE_TRANSFER Then GoTo endIt
Exit Sub
BeginTransfer:
'On Error GoTo ErrorHandler
    hIn = FreeFile
    Open pathToFile For Binary Access Read As hIn
    fileLength = LOF(hIn)
            ' Adjust blocksize at end so we don't read too much data
            If fileLength - Loc(hIn) <= blockSize Then
                    blockSize = fileLength - Loc(hIn) '+ 1
            End If
            Temp = Space$(blockSize)        '// Allocate the read buffer
            Get hIn, , Temp                 '// Read a block of data
            ret = DoEvents()                '// Check for cancel button event etc.
            If quitNow Then GoTo endIt
            sckSend.SendData Temp           '// Off it goes
            
            'update progress bar
            sizeOfFileSent = sizeOfFileSent + blockSize
            'On Error GoTo endIt             '//
            ProgressBar1.value = sizeOfFileSent
            compLabel.Caption = sizeOfFileSent & " of " & sizeOfFile & " sent. " & Int(sizeOfFileSent / sizeOfFile * 100) & "%"
        If sizeOfFileSent >= sizeOfFile Then
            cancel.Caption = "Close"
            sckSystem.SendData CLOSE_TRANSFER
        End If
        Exit Sub
ErrorHandler:                                           '// Always close the file handle
        Close hIn
        'SendFile = False
endIt:
        'cancel.Caption = "Close"
        sckSend.Close   'this severes the data connection, causing the client to save/end the file
        Close hIn
        MsgBox "Transfer Complete"
        Unload Me
End Sub

Private Sub stopSending()
    
    quitNow = True
    MsgBox "User has canceled the file transfer.", vbOKOnly, "File Transfer Canceled"
    Unload Me

End Sub

'*******************************************************************
' Credit:       Dan Evans <[e-mail]> (with a few mods my me, John Stalcup 6/5/99)
' Function:     SendFile()
' Purpose:      Send a file via network
' Parameters:   Full path and file name of data to send
' Returns:      True on success, False on error
' Notes:        The socket should already be established
'*******************************************************************
'Public Function SendFile(fileName As String) As Boolean
'        Dim hIn, fileLength, ret
'        Dim temp As String
'        Dim blockSize As Long
'        blockSize = 2048                                '// Set your read buffer size here
'
'On Error GoTo ErrorHandler
'
'        hIn = FreeFile
'        Open fileName For Binary Access Read As hIn
'        fileLength = LOF(hIn)
'
'        Do Until EOF(hIn)
'                ' Adjust blocksize at end so we don't read too much data
'                If fileLength - Loc(hIn) <= blockSize Then
'                        blockSize = fileLength - Loc(hIn) + 1
'                End If
'                temp = Space$(blockSize)        '// Allocate the read buffer
'                Get hIn, , temp                 '// Read a block of data
'                ret = DoEvents()                '// Check for cancel button event etc.
'                If quitNow Then Exit Function
'                sckSend.SendData temp           '// Off it goes
'
'                'update progress bar
'                sizeOfFileSent = sizeOfFileSent + blockSize
'                On Error GoTo endIt             '//
'                ProgressBar1.value = sizeOfFileSent
'                compLabel.Caption = sizeOfFileSent & " of " & sizeOfFile & " sent. " & Int(sizeOfFileSent / sizeOfFile * 100) & "%"
'                'Do Until sckSend.State = sckConnected ' Wait until connected
'                '    DoEvents
'                'Loop
'        Loop
'
'        cancel.Caption = "Close"
'
'ErrorHandler:                                           '// Always close the file handle
'        Close hIn
'        SendFile = False
'endIt:
'End Function