GREG_SIDIUS
Voilà j'ai un problème de connection avec Winsock.
sur ma machine j'arrive de faire une connection et à transférer des donnée.
mais le problème, c'est que si je veux connecter 2 pc, marche pas et même sur internet !!!
le prog client est sur mon pc et le prog serveur sur une autre machine. on utilise le même port, et j'ai l'adresse ip du serveur.
voici le code.
==========Serveur==============
Dim FileOpen As Boolean 'Indique si le fichier est déjà ouvert
Dim cAvance, cLenTotal As Long 'Progression du téléchargement, et longueur totale
Private Sub cmdListen_Click()
wskRecevoir.LocalPort = 100
wskRecevoir.Listen 'On ouvre le port 100
End Sub
Private Sub Form_Unload(Cancel As Integer)
wskRecevoir.Close 'On ferme la connection Winsock
End Sub
Private Sub wskRecevoir_ConnectionRequest(ByVal requestID As Long)
If wskRecevoir.State <> sckClosed Then 'Si la connection n'est pas fermée,
wskRecevoir.Close 'on la ferme
wskRecevoir.Accept requestID 'On accepte la connection qui arrive
wskRecevoir.SendData "ConnectionOk" 'Et on l'informe du début de la connection
End If
End Sub
Private Sub wskRecevoir_DataArrival(ByVal bytesTotal As Long)
Dim Data As String 'Variable qui va stoker les données pour creer le fichier
wskRecevoir.GetData Data 'Recevoir les données
If Left(Data, 6) = "Taille" Then 'Si le client envoi la taille du fichier,
cLenTotal = Int(Mid(Data, 7)) 'on l'enregistre
wskRecevoir.SendData "Go" 'On informe que l'on est prêt a recevoir le fichier
Exit Sub
End If
If FileOpen = False Then 'Si le fichier n'as pas encore été ouvert,
Open txtChemin.Text For Binary Access Write As #1 'on le fait
FileOpen = True 'Le fichier est maintenant ouvert (Sert pour ne pas l'ouvrir une deuxième fois)
ElseIf FileOpen = True Then 'S'il est déjà ouvert
DoEvents
End If
cAvance = cAvance + Len(Data) 'La progression du téléchargement
lblStatut.Caption = Int(cAvance / cLenTotal * 100) & "%" 'On affiche le pourcentage téléchargé
If Data = "FinEnvoi" Then 'Si le client informe que le fichier est terminé,
Close #1 'On ferme le fichier
FileOpen = False 'Le fichier n'est plus ouvert (Pour une éventuelle prochaine connection)
wskRecevoir.Close 'On ferme la connection
Else
Put 1, , Data 'On continu de creer le fichier qui télécharge
End If
End Sub
================Client================
Private Sub cmdConnect_Click()
wskSend.Close 'Au cas où il serait encore connecter (évite les plantages)
wskSend.Connect txtIP.Text, 100 'On se connecte
End Sub
Public Function Send_File(FileToSend As String)
Dim Temp As String 'Variable qui va prendre, en langage binaire, le fichier à envoyer
Dim BlockSize As Long 'Variable qui va prendre la taille maximale du fichier a envoyer (Sert pour envoyer un gros fichier)
Open FileToSend For Binary Access Read As #1 'On ouvre le fichier a envoyer
BlockSize = 5000 'On place la longueur la plus haute (Ici pour un fichier de + de 5 Mo) [Très important pour éviter les bugs]
Do While Not EOF(1) 'On boucle jusqu'a ce que le fichier est terminé de télécharger
Temp = Space$(BlockSize) 'Give temp some space To store the data
Get 1, , Temp 'On place les données à envoyer dans la variable Temp
wskSend.SendData Temp 'On envoi les données
DoEvents
Loop
wskSend.SendData "FinEnvoi" 'On prévient que l'envoi est terminé
Close #1 'On ferme le fichier
End Function
Private Sub cmdSend_Click()
Send_File txtChemin.Text 'On envoi le fichier
End Sub
Private Sub Form_Load()
txtIP.Text = wskSend.LocalIP 'On met l'IP du PC par défault
End Sub
Private Sub wskSend_DataArrival(ByVal bytesTotal As Long)
Dim txtRecu As String
wskSend.GetData txtRecu
'Si la connection est vérifiée, on envoi la taille totale du fichier à envoyer pour effectuer un pourcentage de téléchargement :
If txtRecu = "ConnectionOk" Then wskSend.SendData "Taille" & FileLen(txtChemin.Text)
If txtRecu = "Go" Then cmdSend.Enabled = True: lblStatut.Caption = "Connecté" 'On est bien connecté
End Sub
Private Sub wskSend_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)
lblStatut.Caption = Description 'On informe si une erreur se produit
End Sub
si vous trouver une soluce ce serai sympas. merci encore :)
