[VB6] uso di winsck non affidabile
alverman
Ho scaricato un progetto di trasferimento files su mswinsck da planet
source.
questo: <a href="http://www.planet-source-
code.com/vb/scripts/ShowCode.asp?
txtCodeId=10579&lngWId=1">http://www.planet-source-
code.com/vb/scripts/ShowCode.asp?txtCodeId=10579&lngWId=1</a>
Il trasferimento ￜ veloce ma l'applicazione presenta un problema.
Il programma funziona bene solo sul primo trasferimento mentre sui
successivi mi mangia 2Kb e lo si vede dalla dimensione del file e non
funziona.
Se chiudo e riapro l'applicazione il primo invio ￜ ok e i successivi
sempre con lo stesso problema
Sono due giorni che ci giro attorno.
Allego la sub che dovrebbe creare il problema ma se volete potete
scaricarlo e provarlo in locale.
Mi date una mano ....... mi manca solo quello per finire ...... per
adesso
Grazie, Alverman
Private Sub Btn_Send_Click()
On Error GoTo ErrorHandler:
Dim StartTime As Long
'You are looking for the remoteadress
'the following routines are nessessary to beware of errors
If Winsock_Send.State <> sckClosed Then '# Reset
if winsock was in use
Winsock_Send.Close
End If
Winsock_Send.Protocol = sckTCPProtocol '# We work
with TCP now
Winsock_Send.LocalPort = 0 '# The
Localport can be a free port and unknow by you because you just need
it to initialize
'# Init the Winsock
If Txt_Port.Text <> 0 Then '# select
the port you entered
Winsock_Send.RemotePort = Txt_Port.Text '# set the
winsock send remoteport; on the same port the client should listen
already
Winsock_Send.RemoteHost = Txt_RemoteIP.Text '# that
should be the same ip the client uses (Local 127.0.0.1)
Else
MsgBox "Select a Port first!"
Exit Sub
End If
Winsock_Send.Connect '#
connecting to port
Lbl_Status.Caption = Winsock_Send.State & " to port: " &
Winsock_Send.RemotePort
StartTime = Timer
Do While Winsock_Send.State <> 7 And Timer - StartTime < 30
DoEvents '# Wait
until the connections ethablishes
Loop ' there
must be a timeout check else it will never end
If Timer - StartTime > 30 Then GoTo Timeout '# When
Timeout
'-----------------------------------------------------
'# Now we come to the send routine
'# You have to open a file in binary mode, read out 2k
packages and send them to the connected port
'# Letz start
Dim OpenedFileNbr, FileLength, Back
Dim Temp As String
Dim PackageSize As Long
Dim LastData As Boolean
FileLength = FileLen(Txt_File.Text)
'Debug.Print FileLength
FileBar.Max = FileLength
FileBar.Value = 0
Winsock_Send.SendData ("FILEINFO|" & FileLength & "|" &
Lbl_FileName.Caption & "|") '# You can add more like filename ,
description ...
StartTime = Timer
Do While NextPart = False And Timer - StartTime <
30 '# When the next Package where not send the procedure will
quit after 30 secs timeout
DoEvents
Loop
If Timer - StartTime > 30 Then GoTo Timeout '#
When Timeout
PackageSize = 2048 '#
Declare the size of the packages to send
'On Error GoTo ErrorHandler
LastData = False '#
You'll see that we need that to make the received
'
file excactly the same size like the original one
NextPart = True '#
NextPart is a form-global variable which
'
contains wheter the package was send or not
'
take a look at the winsock_sendcomplete event
OpenedFileNbr = FreeFile '#
Find a free Filenumber to open your file
Open Txt_File.Text For Binary Access Read As
OpenedFileNbr
'FileLength = FileLen(Txt_File.Text)
Temp = ""
Do Until EOF(OpenedFileNbr)
' Adjust PackageSize at end so we don't
read too much data
'Debug.Print "differenza alla fine " &
FileLength - Loc(OpenedFileNbr) & "PackageSize " & PackageSize
If FileLength - Loc(OpenedFileNbr) <=
PackageSize Then
PackageSize = FileLength - Loc
(OpenedFileNbr) + 1
'Debug.Print "riduco la dimensione del
package size a: " & PackageSize
LastData = True
End If
Temp =
Space$(PackageSize) '# Make string empty for data
Get OpenedFileNbr, ,
Temp '# Load data into string
If Winsock_Send.State <> 7 Then Exit
Sub '# Checks again wether the connections exist or not
On Error Resume Next
StartTime = Timer
Do While NextPart = False And Timer -
StartTime < 30 '# When the next Package where not send the
procedure will quit after 30 secs timeout
DoEvents
Loop
If Timer - StartTime > 30 Then GoTo
Timeout '# When Timeout
If Winsock_Send.State = 7
Then '# Check state again
If LastData = True Then
Temp = Mid(Temp, 1, Len(Temp) -
1) '# We added one byte above, which we don't wanna send
' therefore we need lastdata
End If
FileBar.Value = FileBar.Value + Len
(Temp)
Lbl_Complete.Caption = "Complete: " &
Int(100 / FileLength * FileBar.Value) & " %"
DoneBytes = DoneBytes + Len(Temp)
Winsock_Send.SendData
Temp '# Send datapackage
NextPart =
False '# Set the senddata check
Else
Exit Sub
End If
Loop
Close
#OpenedFileNbr '# Last package was send, now
you can close the file
FileBar.Value = 0
Do While NextPart =
False '# You have to wait until the sendprogress is
done because
DoEvents ' when we close the winsock
before the file was send completly
Loop ' data will be lost -->
We use the close event in the client to
' close the received file too
Winsock_Send.Close
Exit Sub
Timeout:
MsgBox "Timeout" '#
write what you want to say to the user
'# Quit
'-----------------------------------------------------
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical
End Sub
Franz_aRTiglio
> Il programma funziona bene solo sul primo trasferimento mentre sui
> successivi mi mangia 2Kb e lo si vede dalla dimensione del file e non
> funziona.
[cut]
> '# You have to open a file in binary mode, read out 2k
> packages and send them to the connected port
Uh Uh... un qualche contatore non viene azzerato.