File Transfer Problem on Winsock
Code on Client winsock arrival which call for screenshot command and send file back to server when done taking screenshot
n is declared as static
fName_Only as string
Code:
Case "#[SCREENSHOT]#"
n = n + 1
If ws.State <> sckClosed Then
FName_Only = App.Path & "\ss" & "-" & n & ".jpg"
TakeSS FName_Only, 1
Lbl_FileSize.Caption = "Filesize: " & FileLen(FName_Only$)
Lbl_FileName.Caption = GetFileName(FName_Only)
SendSSFile FName_Only
End If
Case "#[FORCEOFF]#"
Code:
Private Sub SendSSFile(ssFiles As String)
On Error GoTo Error_Handler
Dim StartTime As Long
Dim OpenedFileNbr, FileLength, Back
Dim Temp As String
Dim PackageSize As Long
Dim LastData As Boolean
FileLength = FileLen(ssFiles)
FileBar.Max = FileLength
FileBar.Value = 0
ws.SendData "#[CMD]#" & "~" & "#[SCREENSHOT]#" & "~" & "#[OPENFILE]#" & "~" & Lbl_FileName.Caption & "~" & FileLength & "~" & ""
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 ssFiles For Binary Access Read As OpenedFileNbr
Temp = ""
Do While Not EOF(OpenedFileNbr)
' Adjust PackageSize at end so we don't read too much data
If FileLength - Loc(OpenedFileNbr) <= PackageSize Then
PackageSize = FileLength - Loc(OpenedFileNbr) + 1
LastData = True
End If
Temp = Space$(PackageSize) '# Make string empty for data
Get OpenedFileNbr, , Temp '# Load data into string
If ws.State <> 7 Then GoTo Error_Exit '# 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 ws.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)
ws.SendData Temp
NextPart = False '# Set the senddata check
Else
GoTo Error_Exit
End If
Loop
Working (2000)
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
ws.SendData "#[CMD]#" & "~" & "#[SCREENSHOT]#" & "~" & "#[CLOSEFILE]#" & "~" & ""
GoTo Error_Exit
TimeOut:
'' MsgBox "Time Out!!!", vbExclamation + vbOKOnly, "Error"
GoTo Error_Exit
Error_Exit:
Exit Sub
Error_Handler:
MsgBox "Err Description: " & Err.Description & vbNewLine _
& "Err Number: " & Err.Number & vbNewLine _
& "Err Source: " & Err.Source, vbCritical + vbOKOnly, "Error"
GoTo Error_Exit
End Sub
Server Code
Code:
Dim DownloadingFile As Integer '# freefile for open files
Dim DoneRec As Long '# for calculating kbps
Dim Fname As String
'Initialize Variable
sData = ""
'Data Arrival inform of x
'===================================================
Socket.GetData sData, vbString
If Left(sData, 7) = "#[CMD]#" Then
sTemp = Split(sData, "~")
Select Case sTemp(1)
Case "#[SCREENSHOT]#"
Select Case sTemp(2)
Case "#[CLOSEFILE]#"
Close #DownloadingFile
Working (3000)
frmMain.sb1.Panels(1).Text = "Done taking screenshot..."
frmMain.ProgressBar1.Visible = False
Load frmScreenShot
frmScreenShot.Show 1, frmMain
Case "#[OPENFILE]#"
frmMain.ProgressBar1.Visible = True
Fname$ = sTemp(3)
frmMain.ProgressBar1.Max = sTemp(4)
DownloadingFile = FreeFile
Open App.Path & "\images\" & Fname$ For Binary Access Write As #DownloadingFile
strFiles = Fname$
End Select
Else
frmMain.ProgressBar1.Value = frmMain.ProgressBar1.Value + bytesTotal
DoneRec = DoneRec + bytesTotal
frmMain.sb1.Panels(1) = "Complete: " & Int(100 / frmMain.ProgressBar1.Max * frmMain.ProgressBar1.Value) & " %"
Put #DownloadingFile, , sData
DoEvents
'' Debug.Print Len(sData)
End If
May problem is that for example filesize is 224kb... the server only received up to 222kb it always lack of 2kb. File is incomplete so I can't display the picture that I taken from he client.
by the way this not my code I just download it from pscode and modify it to suit my needs. tnx to Ronny R. Germany Berlin
Re: File Transfer Problem on Winsock
Re: File Transfer Problem on Winsock
Have a look at this for sending files over a network using winsock.