Salut, Ce code vous montre la maniere de faire un transfert de fichier via le composant Winsock. Evidemment ce n'est pas la seule maniere, il y en a d'autres.
Source / Exemple :
'Simple File transfert using Winsock.ocx, if you dont want of this dependancy you can use csocket @vbip.com
'Greetz: undergroundkonnekt team
'this is an exemple, if you use it, give the credit to its author.
Option Explicit
Dim BlnTflag As Boolean 'Flag de transfert, Transfert Flag
Dim LngCursor As Long 'Pointeur de position dans fichier source, source file position pointer
''''''''''''''''CLIENT'''''''''''''''''
'''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''
Private Sub CmdConnect_Click()
WskC.Connect TxtIp.Text, TxtCPort.Text 'Connection
End Sub
Private Sub CmdSend_Click()
On Error GoTo actcancel
If BlnTflag = False Then 'si on est pas dans un transfert, if we're not transferring
LngCursor = 0 'reinitialisation du pointeur, pointer reinitialisation
If WskC.State <> 7 Then
'Call ErrorHandler(2)
Else
DlgSend.ShowOpen 'common dialog
WskC.SendData "Transfert" & "|" & DlgSend.FileTitle & "|" & FileLen(DlgSend.FileName) 'on envoie le nom du fichier, we send the file name
End If
Else
Exit Sub
End If
actcancel: Exit Sub
End Sub
Private Sub WskC_Close()
Me.Caption = "Disconnected"
CmdConnect.Caption = "Connect"
End Sub
Private Sub WskC_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Me.Caption = "Disconnected"
CmdConnect.Caption = "Connect"
End Sub
Private Sub WskC_Connect()
Me.Caption = "Connected"
CmdConnect.Caption = "Disconnect"
End Sub
Private Sub WskC_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String 'datas reçues, received datas
Dim strBuffer As String 'Buffer
WskC.GetData strdata 'get data
'si il reste moins de 2048 octets
'if there are more than 2048 left
If FileLen(DlgSend.FileName) - LngCursor < 2048 Then
'on ajuste la taille du buffer
'Buffer size adjustment
strBuffer = Space(FileLen(DlgSend.FileName) - LngCursor)
'Si il reste plus de 2048 octets
'if there are more than 2048 bytes left
ElseIf FileLen(DlgSend.FileName) - LngCursor > 2048 Then
'buffer = 2048
strBuffer = Space(2048)
End If
'Si le pointeur est egal à la taille fichier source
'if pointer value = source file size
If FileLen(DlgSend.FileName) = LngCursor Then
'on a fini le transfert, on ferme le fichier on le dit au server
'we have finished the transfert, we close the opened file, and we tell the server the job is done
LblStatut.Caption = "Statut: " & DlgSend.FileName & " successfully uploaded"
WskC.SendData "E"
Close #1
Exit Sub
End If
'Le server nous demande de commencer le transfert
'the server ask for the transfert beginning
If Left(strdata, 1) = "S" Then
LblStatut.Caption = "Statut: Uploading " & DlgSend.FileName
'on ouvre le fichier en binaire
'we open the file in binary mode
Open DlgSend.FileName For Binary As #1
Get #1, , strBuffer 'on prend un bout de code equivalent au buffer, we get some datas according to the buffer size
WskC.SendData strBuffer 'on l'envoie, we send it
LngCursor = Len(strBuffer) 'on update le pointeur au debut du transfert il est de la taille du buffer(2048), we update the pointer, at the beginning of a transfert it's 2048
'Le server demande un autre bout de fichier
'The server ask for another file chunk
ElseIf Left(strdata, 1) = "N" Then
Get #1, LngCursor + 1, strBuffer 'on reprend l'equivalent du buffer, we take some datas (=buffersize)
WskC.SendData strBuffer 'on envoie, we send
LngCursor = LngCursor + Len(strBuffer) 'on update le pointeur, we update the pointer
End If
End Sub
'''''''''''SERVER''''''''''''
'''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''
Private Sub CmdListen_Click()
On Error Resume Next
If TxtSPort.Text <> "" Then
WskS.LocalPort = TxtSPort.Text
WskS.Close
WskS.Listen 'Listening
Else
'Call ErrorHandler(1)
End If
End Sub
Private Sub WskS_ConnectionRequest(ByVal requestID As Long)
WskS.Close
WskS.Accept requestID
End Sub
Private Sub WskS_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Dim StrSplited() As String
Dim StrFilename As String
Dim LngFileSize As Long
WskS.GetData strdata 'getdata
StrSplited = Split(strdata, "|") 'On split les datas, we split data (delimiter = |)
If strdata = "E" Then 'si c'est la fin d'un transfert, if it's the end of a transfert
Close #2 'on ferme le fichier destination, we close the dest file
BlnTflag = False 'we update the flag
Exit Sub
End If
If BlnTflag = False Then 'si on est pas dans un transfert, if we're not in a file transfert
'on l'initialise en updatant le flag, en récuperant le nom du fichier , on ouvre un fichier vierge en binaire, puis en demande un bout de fichier
'transfert initialisation: flag update, file name get, we open a free file, then we ask for the first chunk
If StrSplited(0) = "Transfert" Then
StrFilename = StrSplited(1)
BlnTflag = True
WskS.SendData "S"
If Dir(App.Path & "\" & StrFilename) <> "" Then 'on efface le fichier si il est déja present, we erase the file if it exists
Kill (App.Path & "\" & StrFilename)
End If
Open App.Path & "\" & StrFilename For Binary As #2
End If
Else
Put #2, LOF(2) + 1, strdata 'on ecrit les bout de donner en fin de fichier, we write data at the end of the file
WskS.SendData "N" 'we ask for another chunk
End If
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.