Компонент

Имя

Winsock

WS

Label

lblHost

TextBox

txtHost

ProgressBar

ProgressBar1

CommandButton

cmdStart

CommandButton

cmdConnect

TextBox

txtNameFile

Label

lblNameFile

Компонент 

Имя

Winsock

WS

Label

lblSaveFile

TextBox

txtDir

ProgressBar

ProgressBar1

Dim OK, sendOK As Boolean

Private Sub cmdConnect_Click()
WS.Close
WS.Connect txtHost.Text, 100
End Sub

Private Sub cmdStart_Click()

If WS.State <> 7 Then Exit Sub 'Если соединение не установлено выходим из процедуры
Dim FileSize As Long
Dim SizePaket As Integer
Dim Paket As String
Dim sData As Long

FileSize = FileLen(txtNameFile.Text) 'Получаем размер файла
ProgressBar1.Max = FileSize
WS.SendData "#FILE " + GetName(txtNameFile) & "|" & FileSize 'Отсылаем информацию о файле
'Ждем ответа
Do While OK = False
DoEvents
Loop
OK = False
Open txtNameFile For Binary As #1 'Открываем файл
'Проверяем если файл не большой то отправляем его одним пакетом,  где размер пакета равен размеру файла
If FileSize < 1024 Then SizePaket = FileSize '

Do
If FileSize - sData < 1024 Then 'Если последняя часть файла меньше 1024, то отправляем ее с размером пакета равной последней части
SizePaket = FileSize - sData
Else
SizePaket = 1024
End If

Paket = String(SizePaket, " ")
'Читаем из файла часть
Get #1, , Paket
'И отправляем
WS.SendData Paket
'Ждем пока дойдет пакет
Do While sendOK = False
DoEvents
Loop
sendOK = False
sData = sData + SizePaket
ProgressBar1.Value = sData
If sData = FileSize Then Close #1: Exit Sub 'Проверяем отправили мы весь файл
Loop
End Sub

Private Sub Form_Load()
frmServer.Show
End Sub

Function GetName(Dir As String) As String
For i = Len(Dir) To 1 Step -1
If Mid(Dir, i, 1) = "\" Then GetName = Mid(Dir, i + 1, Len(Dir))
Next i
End Function

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
WS.GetData Data
If Data = "ok" Then OK = True 'Получили ответ, что можно отсылать файл
End Sub


Private Sub WS_SendComplete()
sendOK = True 'Пакет отправлен
End Sub

Dim NameFile, FileSize As String
Dim ComeDataSize As Long
Private Sub Form_Load()
WS.Close
WS.LocalPort = 100
WS.Listen
End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
WS.GetData Data
'Здесь мы вытаскиваем из имя файла и его размер
If Mid(Data, 1, 6) = "#FILE " Then
Data = Mid(Data, 7, Len(Data))
For i = 1 To Len(Data)
If Mid(Data, i, 1) = "|" Then
NameFile = Mid(Data, 1, i - 1)
FileSize = Int(Mid(Data, i + 1, Len(Data)))
Open txtDir + NameFile For Binary As #2
ProgressBar1.Max = FileSize
WS.SendData "ok" 'Отправляем клиенту что все можно посылать файл
Exit Sub
End If
Next i
End If
Put #2, , Data 'Записываем в файл пакет
ComeDataSize = ComeDataSize + Len(Data)
ProgressBar1.Value = ComeDataSize
If ComeDataSize = FileSize Then Close #2: MsgBox "Всё!": ComeDataSize = 0
End Sub