El Arte De Crear Lo Nuevo
 
ÍndiceCalendarioGaleríaFAQBuscarMiembrosGrupos de UsuariosRegistrarseConectarse
Ultra-Cheats Anuncio

Comparte | 
 

 [Taller] Enviar Archivos

Ver el tema anterior Ver el tema siguiente Ir abajo 
AutorMensaje
ViRuS-DoKtOr
Administrator
Administrator
avatar

Posts : 85
UC Reputacion : 226
Agradecimientos : 6
Fecha de inscripción : 01/06/2009
Edad : 21
Localización : Venezuela

MensajeTema: [Taller] Enviar Archivos   Lun Jun 08, 2009 6:08 pm

El siguiente código fuente consta como está dicho en el título de 2 formularios que utilizan el control Winsock de visual basic para poder enviar un archivo.

El envío se realiza de la siguiente forma: Primero el cliente selecciona el archivo, y este se carga en un array de bytes. Luego el servidor lee ese array de bytes y lo escribe en disco.

Código del formulario para el Cliente:

Iniciar un nuevo proyecto, y dentro de un formulario colocar los siguientes controles

-Un control Winsock.
-3 Controles TextBox: El Text1 es para la dirección Ip, el Text2 es para el puerto y el Text3 es para la ruta del archivo.
-3 controles CommandButton. El Command1 es para conectar al servidor. El command2 es para enviar el archivo. El Command3 es para abrir el cuadro de diálogo "Seleccionar archivo"
-Por último un control CommonDialog1 para el cuadro de diálogo de seleccionar archivo
Quedaria Algo Asi ...


Codigo
Citación :
Option Explicit

'Declaración del Api GetFileTitle
Private Declare Function GetFileTitle _
Lib "comdlg32.dll" _
Alias "GetFileTitleA" ( _
ByVal lpszFile As String, _
ByVal lpszTitle As String, _
ByVal cbBuf As Integer) As Integer

Private Sub Command1_Click()
On Error Resume Next
'conectamos al servidor. El Text1 es la dirección IP y el Text2 es el puerto
Winsock1.Connect Text1, Text2
Command1.Enabled = False
End Sub

Private Sub Command2_Click()

Dim sFileName As String
'Comprobamos que hay un archivo a enviar
If Trim(Text3) = "" Then
MsgBox "Debe elegir un archivo"
Exit Sub
End If

If Dir(Text3) <> "" Then
sFileName = GetFileName(Text3)

'Enviamos los datos (El tamaño, y el nombre)
Winsock1.SendData "|Archivo|" & FileLen(Text3) & "|" & sFileName
Else
MsgBox "El archivo no existe"
End If

End Sub

Private Sub Command3_Click()
With CommonDialog1
.FileName = vbNullString
.ShowOpen
If .FileName <> "" Then
Text3 = .FileName
End If
End With
End Sub

Private Sub Form_Load()
'Ip del formulario servidor
Text1 = "127.0.0.1"
'Puerto
Text2 = "3000"
Text3.Enabled = False
Command1.Caption = "Conectar"
Command2.Caption = "Enviar"
Command3.Caption = " ..."
Me.Caption = "Cliente"
End Sub

Private Sub Winsock1_Close()

On Error Resume Next

Command1.Enabled = True
Command2.Enabled = False

'Cerramos el winsock
Winsock1.Close

MsgBox "La Conexion se ha cerradado", vbInformation
End Sub

Private Sub Winsock1_Connect()
Command1.Enabled = False
Command2.Enabled = True

MsgBox "Conectado correctamente al servidor"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim sData As String
Winsock1.GetData sData, vbString

If sData = "|Ok|" Then Call Enviar_Archivo
End Sub

Private Sub Winsock1_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)

On Error Resume Next

Command1.Enabled = True
Command2.Enabled = False
'Cerramos el winsock
Winsock1.Close
MsgBox "Error al cerrar la conexion"
End Sub

Private Sub Enviar_Archivo()
Dim Size As Long
Dim arrData() As Byte

Open Text3 For Binary Access Read As #1

'Obtenemos el tamaño exacto en bytes del archivo para
' poder redimensionar el array de bytes
Size = LOF(1)
ReDim arrData(Size - 1)

'Leemos y almacenamos todo el fichero en el array
Get #1, , arrData
'Cerramos
Close

'Enviamos el archivo
Winsock1.SendData arrData

End Sub

Private Function GetFileName(sPath As String)
Dim sBuffer As String * 255
Dim sTemp As String

GetFileTitle sPath, sBuffer, Len(sBuffer)
GetFileName = Left(sBuffer, InStr(1, sBuffer, Chr(0)) - 1)
End Function

Controles para el formulario servidor

-Un control Winsock
-Un TextBox. Para el Puerto
-1 Control Command Button ( para poner a la escucha y poder recibir una petición de conexión

Nos Quedaria Algo Asi ...



Codigo :
Citación :
Option Explicit

'**********************************************************

Dim Flag As Boolean
Dim lBytes As Long
Dim lFileSize As Long

Private Sub Command1_Click()
On Error GoTo error_handler
With Winsock1
'Le asignanmos el número de puerto
.LocalPort = Text1
'Ponemos a la escucha
.Listen
End With
Command1.Enabled = False
Exit Sub
error_handler:
MsgBox Err.Description
End Sub

Private Sub Form_Load()
Text1 = "3000"
Command1.Caption = "Poner a la escucha"
Me.Caption = "servidor"
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
On Error GoTo error_handler

Command1.Enabled = False
With Winsock1
'Cerramos el Winsock
.Close
.Accept requestID
End With

MsgBox "Conexion recibida"
Exit Sub
error_handler:
MsgBox Err.Description, vbCritical, "Winsock1_ConnectionRequest"
End Sub

Private Sub Winsock1_Close()
On Error GoTo error_handler

Command1.Enabled = True
Winsock1.Close

MsgBox "Conexion cerrada"
Exit Sub
error_handler:
MsgBox Err.Description, vbCritical, "Winsock_Close"
End Sub

Private Sub Winsock1_Connect()
MsgBox "Conexion aceptada", vbInformation
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'On Error GoTo error_handler

'Array de Bytes para escribir el archivo en disco
Dim arrData() As Byte
Dim vData As Variant

If Flag = False Then
Winsock1.GetData vData, vbString
If Mid(vData, 1, 9) = "|Archivo|" Then
Flag = True
lBytes = 0
vData = Split(vData, "|")
lFileSize = vData(2)
' Le enviamos como mensaje al cliente que comienze el envio del archivo
Winsock1.SendData "|Ok|"

'Creamos un archivo en modo binario
Open App.Path & "\" & vData(3) For Binary Access Write As #1
End If
End If

If Flag Then
' Aumentamos lBytes con los datos que van llegando
lBytes = lBytes + bytesTotal
'Recibimos los datos y lo almacenamos en el arry de bytes
Winsock1.GetData arrData

'Escribimos en disco el array de bytes, es decir lo que va llegando
Put #1, , arrData

' Si lo recibido es mayor o igual al tamaño entonces se terminó y cerramos
'el archivo abierto
If lBytes >= lFileSize Then
'Cerramos el archivo
Close #1
'Reestablecemos el flag y la variable lBytes por si se intenta enviar otro archivo
Flag = False
lBytes = 0
'Mostrar mensaje de finalización
MsgBox "El archivo se ha recibido por completo"
End If
End If
' Exit Sub
'error_handler:
'MsgBox Err.Description

End Sub


Private Sub Winsock1_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)

On Error Resume Next

Command1.Enabled = True
'Cerramos el Winsock
Winsock1.Close
'Mostramos el aviso de que se cerró la conexión
MsgBox "La Conexion se ha cerrado", vbInformation
End Sub


Espero Que Les Halla Servido .. ;D
Volver arriba Ir abajo
Ver perfil de usuario http://ultra-cheats.coolbb.net
 
[Taller] Enviar Archivos
Ver el tema anterior Ver el tema siguiente Volver arriba 
Página 1 de 1.
 Temas similares
-
» Como enviar archivos de mas de 20 megas
» Taller de coches, cosechadoras, TRACTORES AMARILLOS XD... LO QUE SEA para usar en MRO XD
» Reproducir archivos HD: Mkv...
» Cuanto os cuesta enviar las cartas?
» [Taller] El lobo diseñador~

Permisos de este foro:No puedes responder a temas en este foro.
| Ultra-Cheats | 2009 :: Talleres-
Cambiar a: