Jag försöker skicka en fil över mitt nätverk med hjälp av WinSock och ett exempelprogram jag laddat ner någonstans! Men problemet är att jag i WinSock_DataArrival använder denna kod:

Private Sub WinSock_DataArrival(ByVal bytesTotal As Long)
Dim Ale As String

WinSock.GetData Ale

If Left(Ale, 4) = "namn" Then
Ale = Mid(Ale, 5)
shpDittNamn.Caption = Ale

ElseIf Left(Ale, 4) = "msgb" Then
Ale = Mid(Ale, 5)
MsgBox Ale, vbInformation, "Remote"

ElseIf Left(Ale, 4) = "bild" Then
Open "C:\Temp.bmp" For Binary As #1
Dim StrData() As Byte
WinSock.GetData StrData, vbString
Debug.Print StrData
Put #1, , StrData

ElseIf Left(Ale, 4) = "text" Then
Ale = Mid(Ale, 5)

If txtDinChat.Text = "" Then
txtDinChat.Text = Ale
Else
txtDinChat.SelStart = Len(txtDinChat.Text)
txtDinChat.SelText = vbCrLf & Ale
End If

End If
End Sub

Han får koden "bild" först vilket jag tror är problemet! För filen C:\Temp.bmp blir 0 bytes i storlek, inget annat fel rapporteras!
Hur kan man lösa problemet tror ni?

Modulen jag använder:

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub SendFile(FileName As String, WinSock As WinSock)
Dim FreeF As Integer
Dim LocData() As Byte
Dim LenData As Long
Dim sendloop As Long

FreeF = FreeFile

Open FileName For Binary As #FreeF ' Open file

ReDim LocData(1 To 2048) As Byte ' Work in 2kb chunks

LenData = LOF(FreeF) ' Get length of file

For sendloop = 1 To LenData \ 2048 ' Go through file

Get #FreeF, , LocData 'Get data from the file nCnt is from where to start the get

WinSock.SendData LocData 'Send the chunk

Next

If LenData Mod 2048 <> 0 Then ' If there is any left over at the end

ReDim LocData(1 To LenData Mod 2048) As Byte ' Clear up the leftovers

Get #FreeF, , LocData 'Get data from the file nCnt is from where to start the get

WinSock.SendData LocData 'Send the chunk

End If

Close #FreeF ' Close the file

Sleep 200 ' Let computer catch up

End Sub


Public Function oPD(Text As String) As String
'Use this if you get your data in Binary into any textbox
'this turns all the chunk into the Ascii numbers use the rpd
'function to restore it.
'If you open binary into a text box the chances that you'll get
'an Out Of Memory error are high.

Dim TextC As String * 3
Dim G As Long
Dim TextX As String
Dim x As Long

G = Len(Text)

For x = 1 To G
TextC = Asc(Mid(Text, x, 1))
TextX = TextX & TextC
Next x
oPD = TextX
End Function

Public Function rPD(Text As String) As String
Dim TextC As String * 3
Dim G As Long
Dim TextX As String
Dim x As Long

G = Len(Text)

For x = 1 To G
On Local Error Resume Next
TextC = Chr(Mid(Text, x, 3))
TextX = TextX & TextC
Next x
rPD = TextX
End Function


Koden jag använder för att skicka:

SavePicture Pic, "C:\Temp.tmp"

Sleep 200
WinSock.SendData "bild"
Sleep 200
SendFile "C:\Temp.tmp", WinSock

Har inte testat koden själv, men du använder ju Winsock.GetData 2 gånger i händelsen Winsock_DataArrival. Det borde inte finnas någon data att hämta 2:a gången du gör det (WinSock.GetData StrData, vbString), utan du får nog utvärdera innehållet i variabeln Ale, och skriva det till filen.