Transfert de fichier via winsock

Soyez le premier à donner votre avis sur cette source.

Vue 9 908 fois - Téléchargée 2 151 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
mercredi 16 mars 2011
Statut
Membre
Dernière intervention
28 septembre 2012

svp je veux un code transférer un fichier sur l'Excel mon Email mouna___2012@hotmail.com
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013

Je viens juste de terminé une fonction à mon logiciel (transfert des fichiers entre Compiègne et Orléans) avec winsock vb6 bien sure, et j’ai une vitesse d’environ 50k, mais tout le monde à normalement cette vitesse, d’ailleurs je ne vois vraiment pas comment faire autrement, les meilleurs monte à 100/120k, mais l’upload de Mr tout le monde c’est 50k !
d’ailleurs installer teamviewer (gros logiciel commerciale, et transférez un fichier «.rar » asse gros(car déjà compressé) et vous devriez transférer à la même vitesse. En tout cas moi je transfert 200k compressé en 4 secondes donc 50k avec Winsock ou teamviewer ! ! !
donc si teamviewer ne peut pas faire mieux ??? Je pense que mon logiciel est au maximum !

PS : au faite pour envoyer des données rapidement j’ai essayé une multitude de combinaison et procédure de dizaine de page codé pour finir simplement quelque ligne dans mon moteur principale Winsock l’on peut envoyer maxi 64k et le receveur maxi 64k, et vous pouvez donc utiliser le tempon maxi car celui qui envoie va moins vite que celui qui récupère
hi,hi,hi !
Après moi je me heurtais à un problème la peur de la perte de données, mais depuis deux jours cela marche très bien, dans le doute j’ai laissé à 30k, et pis les integer compte jusqu’à 32000 ! En faite comme beaucoup j’utiliser doevent, ou un timer à 10ms,…ETC. car lorsque l’on envoyait par exemple 1024 octets+1024 octets on risquait de recevoir 2048 au lieu de 1024, ou alors j’envoyais 8000 et je recevais 4068 !?! Donc pour protéger ce problème certains donner l’exemple de mettre un caractère spécial à la fin du STRING ! Mais en faite la SOLUTION était bien plus simple ! ! ! Un string réellement même à l’intérieur de VB6 c’est quoi : une mémoire à une position fixe, un nom, et une taille, et oui une taille !
La soluce pour envoyé une donnée de 1 à 64000 octets, du text, des images, du son, ou des bloque de fichier c’est de faire data$=vos données
Winsock.SendData string_to_integer(len(data$))+data$ ! ! ! !
(string_to_integer et une function qui transforme un integer en string de deux octets)
Les deux 1er octets, vous êtes obliger de les recevoir, après à vous de regrouper les morceaux avec Getdata de 1000,4000,6000, ou 8000 octets jusqu’à recevoir votre taille définie en amont

Que de temps perdue pour une solution si simple,… je suis comptant d’avoir réussie, mais je suis pas fier de moi, j’ai honte c’était plus facile ! Maintenant je vais pouvoir m’amuser réellement.

PS2 : désolé de ne pouvoir vous donner mon log, il est un peu intransportable, mais pense simple, et tout ira bien, c’est plus simple que les API !
Messages postés
2493
Date d'inscription
jeudi 14 juillet 2005
Statut
Contributeur
Dernière intervention
5 juin 2016
1
Messages postés
3
Date d'inscription
vendredi 20 janvier 2012
Statut
Membre
Dernière intervention
20 janvier 2012

j'aimerai avoir le code d'utilisation de winsock,car mon code ne fonction qu'avec 2 ordi seulement.merci d'avance
Messages postés
38
Date d'inscription
dimanche 20 mars 2005
Statut
Membre
Dernière intervention
30 août 2009

Slt, cette source marche bien, mais que ce soit avec elles ou d'autres, le débit reste très inférieur aux solutions commerciales. Par exemple, lorsque j'envoie un fichier depuis chez moi, je ne dépasse jamais les 50 Ko/sec avec toutes les sources de Transfert que j'ai trouvées, alors qu'avec un programme comme FileZilla Server, j'atteins les 95-100 Ko/sec. Quelqu'un sait-il à quoi c'est dû, peut-être au contrôle Winsock ?
Afficher les 8 commentaires

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.