Bueno hice esta funcion hace un tiempo, pero creo que sigue funcionando xD.
Sos libre de hacer las modificaciones que quieras. Espero que te sea util.
La siguiente funcion sirve para
ENVIAR ARCHIVOS:
'La funcion va a indicar si se produjo algun error (si devuelve True es que se envio correctamente)
Private Function EnviarArchivo(Archivo As String, Ruta As String, Buffer As Long, Winsock As Winsock) As Boolean 'Archivo es el archivo que vamos a enviar y Ruta es el lugar donde los va a guardar el servidor
Dim Todo As String
Dim Tamaño As Long
Dim i As Integer
On Error GoTo Error
Open Archivo For Binary As #1 'Abrimos el archivo que vamos a enviar de forma binaria
Tamaño = LOF(1) 'Obtenemos el tamaño del archivo a enviar
Todo = Input(LOF(1), 1) 'Almacenamos el codigo binario del archivo en una variable
Close #1
'Enviamos los datos del archivo (Tamaño, Ruta, Nombre)
Winsock.SendData "Dat" & "*" & Tamaño & "*" & Ruta
Pausa 0.5 'hacemos una pequeña pausa para dar tiempo a que lleguen los datos
'Ahora enviamos el archivo por partes
For i = 1 To Len(Todo)
If i <> 1 Then 'una vez q se envia la primera parte
i = i + Buffer - 1 'empezamos a sumar el Buffer
End If
Winsock.SendData Mid(Todo, i, Buffer) 'enviamos desde donde kedamos (i) hasta la cantidad indicada (Buffer)
Pausa 0.3 'hacemos otra pausa
If i > Len(Todo) Then ' si (i) supera la longitud del archivo
MsgBox "El archivo se envio staisfactoriamente.", vbInformation, "NYlOn" 'inidicamos q se envio el archivo
Winsock.SendData "END" 'le avisamos al servidor que cierre el archivo
End If
Next i
EnviarArchivo = True
Exit Function
Error:
EnviarArchivo = False
End Function
'Esto genera una pausa en el programa
Public Sub Pausa(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Se utiliza:
EnviarArchivo "C:\MiArchivo.jpg", "C:\RutaFinal\Archivo.jpg", 600, Winsock1
Y en el evento DataArrival del Winsock que resive el archivo, va este codigo:
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Code, Datos() As String
On Error GoTo Cerrar
Winsock1.GetData Code
Select Case Left(Code, 3)
Case "Dat" ' Si son los datos del archivo
Datos = Split(Code, "*") ' los separamos por "*"
Open Datos(2) For Binary As #1 'abrimos el archivo indicado para luego ir introduciendo los datos
Case "END" 'esto nos indica que cerremos el archivo (cuando termina de enviarse)
Close #1 'lo cerramos xD
Case Else 'si no fue ninguna de las otras instrucciones
Put #1, , Code 'es pq son datos del archivo. Los almacenamos
End Select
Exit Sub
Cerrar:
Close #1 'esto es porque, si ocurre algun error, el archivo queda abierto y no se puede eliminar
End Sub
El codigo esta testeado y funciona, pero aun asi nunca sabes donde puede saltar un problema... Asique si pasa algo, postea =)
Saludos.-
Mostrar Mensajes
.-
