Option Explicit
Private iFileNum As Integer, lPacketSize As Long
Private Sub Form_Load()
On Error GoTo Err
Winsock1.Close
Winsock1.LocalPort = 1003
Winsock1.Listen
Me.Caption = "Listening: Port 1003"
Exit Sub
Err:
MsgBox "Socket Error!" & vbNewLine & _
Err.Description
Unload Me
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close
Timer1.Interval = 0
Timer1.Enabled = False
End Sub
Private Sub Winsock1_Close()
If Winsock1.State = sckClosing Then
Winsock1.Close
End If
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then
Winsock1.Close
End If
Winsock1.Accept requestID
SendFile Winsock1, App.Path & "\tmp.jpg"
End Sub
Public Sub SendFile(SocketObject As Winsock, ByVal FilePath As String, Optional ByVal PacketSize As Long = 1024)
Dim Buffer() As Byte
lPacketSize = PacketSize ' save the PacketSize for the timer
Timer1.Enabled = False ' make suze timer is not enabled
iFileNum = FreeFile ' get free file number
Open FilePath For Binary Access Read As iFileNum ' open file
' if file size is smaller than PacketSize, then send the whole file, but not more
ReDim Buffer(lngMIN(LOF(iFileNum), PacketSize) - 1)
Get iFileNum, , Buffer ' read data
SocketObject.SendData Buffer ' send data
End Sub
Public Function lngMIN(ByVal L1 As Long, ByVal L2 As Long) As Long
If L1 < L2 Then
lngMIN = L1
Else
lngMIN = L2
End If
End Function
Private Sub Winsock1_SendComplete()
Timer1.Enabled = False
Timer1.Interval = 1
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim Buffer() As Byte, BuffSize As Long
Timer1.Enabled = False
If iFileNum <= 0 Then Exit Sub
If Loc(iFileNum) >= LOF(iFileNum) Then ' FILE COMPLETE
Close iFileNum ' close file
iFileNum = 0 ' set file number to 0, timer will exit if another timer event
BuffSize = 0
Winsock1.Close
Winsock1.LocalPort = 1003
Winsock1.Listen
Me.Caption = "Listening: Port 1003"
Exit Sub
End If
'if the remaining size in the file is smaller then PacketSize, the read only whatever is left
BuffSize = lngMIN(LOF(iFileNum) - Loc(iFileNum), lPacketSize)
ReDim Buffer(BuffSize - 1) ' resize buffer
Get iFileNum, , Buffer ' read data
Winsock1.SendData Buffer ' send data
' Show progress
Me.Caption = "Sending: " & Format(Loc(iFileNum) / CDbl(LOF(iFileNum)) * 100#, "#0.00") & "% Done"
' timer event will be called again when last packet is sent, close the file then
End Sub