[VB6]: Trasferimento di files tra Client e Server

[nandoar]

salve a tutti ho trovato girando nella rete un applicazione seria del Winsock usato per mandare file dato ma ho avuto problemi per quanto riguarda il codice dato che stava ucciso con l'accetta ma lo ho aggiustato alla meglio maniera ma ci sta un problema che ancora mi esce quello su di una run time n76 dato che nn ci riesco propio ad aggiustarlo posto il codice qui

'questo è del client secondo me questo funziona al 100%
__________________________________________________ _
Option Explicit
Private Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
Private Const SO_SNDBUF = &H1001
Private Const SOL_SOCKET = &HFFFF&

Private FILEHANDLE As Integer
Private DIMENSIONEPACCHETTO As Long

Private Sub Connetti_Click()
If Socket.State <> sckClosed Then Socket.Close
Socket.LocalPort = 0
Socket.Connect IndirizzoIP.Text, 1500
End Sub

Private Sub Form_Unload(Cancel As Integer)
If SocketInvio.State <> sckClosed Then SocketInvio.Close
If Socket.State <> sckClosed Then Socket.Close
Socket.LocalPort = 0
End Sub

Private Sub Invia_Click()
Dim POSIZIONE As Integer
If Socket.State <> sckConnected Then Exit Sub
If Dir(NomeFile.Text) = "" Then
MsgBox "Il file non esiste!", vbCritical + vbOKOnly
Else
POSIZIONE = 0
While InStr(POSIZIONE + 1, NomeFile.Text, "\") > 0
POSIZIONE = InStr(POSIZIONE + 1, NomeFile.Text, "\")
Wend
Socket.SendData "/FILE " & Mid(NomeFile.Text, POSIZIONE + 1) & " " & FileLen(NomeFile.Text)
End If
End Sub

Private Sub SocketInvio_Connect()
Dim DATI(511) As Byte
FILEHANDLE = FreeFile
Open NomeFile.Text For Binary As FILEHANDLE
Get FILEHANDLE, , DATI
SocketInvio.SendData DATI
Call getsockopt(SocketInvio.SocketHandle, SOL_SOCKET, SO_SNDBUF, DIMENSIONEPACCHETTO, Len(DIMENSIONEPACCHETTO))
If DIMENSIONEPACCHETTO = 0 Then DIMENSIONEPACCHETTO = 8192
End Sub

Private Sub SocketInvio_Close()
Close FILEHANDLE
If SocketInvio.State <> sckClosed Then SocketInvio.Close
End Sub

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
Dim DATI() As Byte
Call Socket.GetData(DATI)
DATI = StrConv(DATI, vbUnicode)
If Left(DATI, 11) = " +OK: PORTA" Then
If SocketInvio.State <> sckClosed Then SocketInvio.Close
SocketInvio.LocalPort = 0
SocketInvio.Connect Socket.RemoteHostIP, Mid(DATI, 12)
End If
If (Left(DATI, 10) = " +OK: RECV") Then
If FILEHANDLE <> 0 Then
DATI = Space(DIMENSIONEPACCHETTO / 2)
Get FILEHANDLE, , DATI
SocketInvio.SendData DATI
End If
End If
If (Left(DATI, 10) = " +OK: FINE") Then
Close FILEHANDLE
SocketInvio.Close
MsgBox "Trasferimento completato!", vbInformation + vbOKOnly
End If
End Sub








'questo del server secondo me questo funziona allo 0%
__________________________________________________
Option Explicit

Private FILEHANDLE As Integer
Private DIMENSIONEFILE As Long
Private FILEDASALVARE As String

Private Sub Form_Load()
StatoLabel.Caption = ""
Avanzamento.Caption = "0 bytes ricevuti su 0"
Socket.LocalPort = 1500
Socket.Listen
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Socket.State <> sckClosed Then Socket.Close
End Sub

Private Sub Socket_Close()
If Passivo.State <> sckClosed Then Passivo.Close
If Socket.State <> sckClosed Then Socket.Close
Stati.AddItem "Connessione chiusa."
Socket.Listen
End Sub

Private Sub Socket_ConnectionRequest(ByVal requestID As Long)
Socket.Close
Socket.Accept requestID
Stati.AddItem "Accettata connessione."
End Sub

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
Dim DATI() As Byte
Dim NOMEFILE As String
Dim DIMENSIONE As Long
Dim POSIZIONE As Integer
Dim TEMPSTR As String

Call Socket.GetData(DATI)
DATI = StrConv(DATI, vbUnicode)
Select Case Left(UCase(DATI), 5)
Case "/FILE"
' I files sono mandati nella forma:
' /FILE NOME DIMENSIONE
' possono contenere anche spazi:
' /FILE NOME DEL FILE DIMENSIONE
TEMPSTR = Mid(DATI, 7)
POSIZIONE = 0
While InStr(POSIZIONE + 1, TEMPSTR, " ") > 0
POSIZIONE = InStr(POSIZIONE + 1, TEMPSTR, " ")
Wend
' POSIZIONE conterrà il punto dove inizia la dimensione
NOMEFILE = Left(TEMPSTR, POSIZIONE - 1)
DIMENSIONE = CLng(Mid(TEMPSTR, POSIZIONE + 1))
TEMPSTR = "È in arrivo un file di nome " & NOMEFILE & " di " & CStr(DIMENSIONE) & " bytes."
TEMPSTR = TEMPSTR & vbNewLine
TEMPSTR = TEMPSTR & "Desideri accettarlo?"
If MsgBox(TEMPSTR, vbYesNo + vbQuestion) = vbYes Then
FILEDASALVARE = App.Path & "\RICEVUTI\" & NOMEFILE
If Dir(FILEDASALVARE) <> "" Then
TEMPSTR = "Il file " & NOMEFILE & " esiste già." & vbNewLine
TEMPSTR = TEMPSTR & "Desideri sovrascriverlo?"
If MsgBox(TEMPSTR, vbYesNo + vbQuestion) = vbYes Then
Kill FILEDASALVARE
Else
' Chiedi di cambiare il nome o fare altro...
' Noi lo rifiuteremo...
Socket.SendData " -ERR: NONACCETTATO" & vbNewLine
Stati.AddItem "File " & NOMEFILE & " rifiutato."
Exit Sub
End If
End If
DIMENSIONEFILE = DIMENSIONE
If Passivo.State <> sckClosed Then Passivo.Close
Passivo.LocalPort = 0
Passivo.Listen
Socket.SendData " +OK: PORTA " & Passivo.LocalPort & vbNewLine
Stati.AddItem "Accettazione del file " & NOMEFILE
Stati.AddItem "Ascolto sulla porta " & Passivo.LocalPort
StatoLabel.Caption = "Ricezione del file " & NOMEFILE & " di " & DIMENSIONE & " bytes."
Avanzamento.Caption = "0 bytes ricevuti su " & DIMENSIONE
AvanzamentoProgress.Value = 0
AvanzamentoProgress.Max = 0
Else
Socket.SendData " -ERR: NONACCETTATO" & vbNewLine
Stati.AddItem "File " & NOMEFILE & " rifiutato."
End If
Case "/FINE"
Passivo.Close
Close FILEHANDLE
FILEDASALVARE = ""
Stati.AddItem "Ricezione del file completata."
End Select
End Sub

Private Sub Passivo_Close()
Close FILEHANDLE
FILEDASALVARE = ""
Stati.AddItem "Ricezione del file completata."
End Sub

Private Sub Passivo_ConnectionRequest(ByVal requestID As Long)
FILEHANDLE = FreeFile
Open FILEDASALVARE For Binary As FILEHANDLE
Passivo.Close
Passivo.Accept requestID
' Tutto ciò che verrà inviato da ora in poi su questo
' socket verrà salvato sul file FILEDASALVARE
End Sub

Private Sub Passivo_DataArrival(ByVal bytesTotal As Long)
Dim DATI() As Byte
Call Passivo.GetData(DATI)
If UBound(DATI) + LOF(FILEHANDLE) + 1 >= DIMENSIONEFILE Then
ReDim Preserve DATI(DIMENSIONEFILE - LOF(FILEHANDLE) - 1)
Put FILEHANDLE, , DATI
Stati.AddItem "Salvato chunk di " & UBound(DATI) + 1 & " bytes."
Avanzamento.Caption = LOF(FILEHANDLE) & " bytes ricevuti su " & DIMENSIONEFILE
AvanzamentoProgress.Max = DIMENSIONEFILE
AvanzamentoProgress.Value = LOF(FILEHANDLE)
Socket.SendData " +OK: FINE"
DoEvents
Passivo.Close
Close FILEHANDLE
FILEDASALVARE = ""
Stati.AddItem "Ricezione del file completata."
Else
Put FILEHANDLE, , DATI
Stati.AddItem "Salvato chunk di " & UBound(DATI) + 1 & " bytes."
Avanzamento.Caption = LOF(FILEHANDLE) & " bytes ricevuti su " & DIMENSIONEFILE
AvanzamentoProgress.Max = DIMENSIONEFILE
AvanzamentoProgress.Value = LOF(FILEHANDLE)
Socket.SendData " +OK: RECV " & LOF(FILEHANDLE)
End If
End Sub

Private Sub Stati_DblClick()
Stati.Clear
End Sub



aiuto

[nandoar]

alka infatti li avevo scritto magari usando il protocollo mediante apertura in binario e nn tramite il codice del progetto gia inserito

[nandoar]

il problema lo ho risolto il fatto è che si deve aggiungere gli on error resume next e creare la cartella "Ricevuti" con mkdir