Coder's Guild Mailing List

Winsock help Please? Specificaly TCP/IP File Transfer with VB 6.0

Posted by Duston S. Horacek on 2001-04-03

Greetings, I've written a program that allows a person to connect to another
who also uses this program, and they can then send a file. The Program works
great, as you can connect over a network, or the internet. When you send the
file initialy it works fine, sending the file correctly. HOWEVER when you
send it a second time the file is larger then it should be usualy double.
ANY help is appreciated, and below I will include a copy of the pertinent
Code.

Public Sub SendData(sFile As String, sSaveAs As String, tcpSend As Winsock)
On Error GoTo ErrHandler
    Dim sSend As String, sBuf As String
    Dim ifreefile As Integer
    Dim lRead As Long, lLen As Long, lThisRead As Long, lLastRead As Long
    Dim strData As String
    tcpSend.GetData strData
    ifreefile = FreeFile

    ' Open file for binary access:
    Open sFile For Binary Access Read As #ifreefile
    lLen = LOF(ifreefile)

    ' Loop through the file, loading it up in chunks of 64k:
    Do While lRead < lLen
        lThisRead = 65536
        If lThisRead + lRead > lLen Then
            lThisRead = lLen - lRead
        End If
        If Not lThisRead = lLastRead Then
            sBuf = Space$(lThisRead)
        End If
        Get #ifreefile, , sBuf
        lRead = lRead + lThisRead
        sSend = sSend & sBuf
        sBuf = Space$(0)
    Loop
    lTotal = lLen
    Close ifreefile
    bSendingFile = True
    '// Send the file notification
    tcpSend.SendData "FILE" & sSaveAs
    DoEvents
    '// Send the file
    tcpServer.SendData sSend
    DoEvents
    '// Finished
    tcpSend.SendData "FILEEND"
    bSendingFile = False
        MMControl1.FileName = "FileDone.wav"
        MMControl1.Command = "Open"
        MMControl1.Command = "Play"
    Exit Sub
ErrHandler:
    MsgBox "Err " & Err & " : " & Error
End Sub

Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Dim ifreefile

'    DoEvents
    tcpServer.GetData strData
    If Right$(strData, 7) = "FILEEND" Then
        bFileArriving = False
        lblProgress = "Saving File to " & App.Path & "\" & sFile
        sArriving = sArriving & Left$(strData, Len(strData) - 7)
        ifreefile = FreeFile
        MMControl1.FileName = "File.wav"
        MMControl1.Command = "Open"
        MMControl1.Command = "Play"
            Open sFile For Binary Access Write As #ifreefile
            Put #ifreefile, 1, sArriving
            Close #ifreefile
            ShellExecute 0, vbNullString, App.Path & "\" & sFile,
vbNullString, vbNullString, vbNormalFocus
        lblProgress = "Complete"
    ElseIf Left$(strData, 4) = "FILE" Then
        bFileArriving = True
        sFile = Right$(strData, Len(strData) - 4)
    ElseIf bFileArriving Then
        lblProgress = "Receiving " & bytesTotal & " bytes for " & sFile & "
>from " & tcpServer.RemoteHostIP
        sArriving = sArriving & strData
        MMControl1.FileName = "FileDone.wav"
        MMControl1.Command = "Open"
        MMControl1.Command = "Play"
    End If
End Sub


Again ANy help is appreciated.

Duston S. Horacek

Previous post | Next post | Timeline | Home