Autor
|
Tema: winsock downloader con vb6 (Leído 4,130 veces)
|
markx
Desconectado
Mensajes: 11
|
alguien que tenga mano un source en vb6 de un downloader utilizando winsock? algun ejemplo sencillito? gracias
|
|
|
En línea
|
|
|
|
HaDeS, -
WarZone Master
Desconectado
Mensajes: 284
|
Claro, checate este codigo, ya lo habia posteado antes, pero no importa Vamos a bajar el siguiente archivo, y guardarlo en el disco duro, en donde se esta ejecutando el programa: http://snarkles.net/scripts/sneak/sneak-1.27.zip'Se necesitan 2 command button, un winsock de nombre Wk Dim Flag as Boolean Private Sub Command1_Click() Wk.Connect "www.snarkles.net", 80 'Conectamos al host End Sub Private Sub Command2_Click() Wk.SendData "GET /scripts/sneak/sneak-1.27.zip HTTP/1.1" & vbCrLf & _ 'Hacemos la peticion del archivo ubicado en la carpeta scripts/sneak/sneak-1.27.zip "Host: www.snarkles.net" & vbCrLf & _ "Connection: keep-alive" & vbCrLf & vbCrLf End Sub Private Sub Wk_DataArrival(ByVal bytesTotal As Long) Dim Archivo, Archivo2, Headers 'Declaramos las variables, las tres de tipo variant ya que los archivos pueden ser de tipo binari0 Wk.GetData Archivo If InStr(1, Archivo, vbCrLf & vbCrLf, vbTextCompare) <> 0 And Flag = False Then 'Si en la primera peticion se nos envia las cabeceras del servidor que indican que todo va bien, entonces dividimos lo que nos envia en dos partes, la primera que son las cabeceras del servidor, y la segunda que es el archivo Flag = True Headers = Split(Archivo, vbCrLf & vbCrLf, 2) Archivo2 = Headers(1) 'Es la parte de la imagen, sin las cabeceras del servidor Else Archivo2 = Archivo 'Si no se estan enviando las cabeceras, entonces asignamos a archiv2 el valor de archivo. Recordamos que el servidor se conecta varias veces a nosotros para enviarnos el contenido del archivo. End If Open App.Path & "\snarkles.zip" For Binary Access Write As #1 'Abrimos el archivo snarkles.zip, puede ser cualquier otro tipo de archivo, en modo binario Put #1, LOF(1) + 1, Archivo2 'escribimos el contenido al final del archivo del valor que nos ha enviado el servidor Close #1 End Sub
Lo modifique y lo comente para que entendieras:P saludos
|
|
« Última modificación: 1 Septiembre 2007, 00:46 am por HaDeS, - »
|
En línea
|
|
|
|
APOKLIPTICO
Desconectado
Mensajes: 3.871
Toys in the attic.
|
Para que sirve el _ que pusiste despues de cada línea? osea pusiste VBcrlf & _ Saludos
|
|
|
En línea
|
AMD Phenom II 1075T X6 @ 290 Mhz x 11 (HT 2036 Mhz NB Link 2616 Mhz) 1.23 Vcore ASUS M4A89GTD-PRO/USB3 2x2gb G-Skill RipjawsX DDR3 1600 Mhz CL7 (7-8-7-24-25-1T) Seagate 500 Gb XFX HD4850 512Mb GDDR3. 650 Mhz/995 Mhz 1.1 Tflops.
|
|
|
Red Mx
Rojito
Colaborador
Desconectado
Mensajes: 3.649
Viva México Cabrones...
|
es para continuar la linea de codigo es util cuando la lina es muy larga y no se visualisa en la pantalla
y el vbCrLf es para simular un Salto de linea
|
|
|
En línea
|
Desarrollar Malware Es Causa De Cancer...
|
|
|
elrecar
Desconectado
Mensajes: 30
|
yo tambien ando necesitando algo similar, probe el codigo ese pero me lo descarga corrupto
|
|
|
En línea
|
|
|
|
HaDeS, -
WarZone Master
Desconectado
Mensajes: 284
|
Hmm, que raro, acabe de probar el codigo y me baja perfectamente el archivo, estas bajando el mismo que muestra el ejemplo, o es otro archivo. De todas formas con cualquier tipo de archivo deberia funcionar. Saludos, y si es diferente lo que pones, mostranos tu codigo.
|
|
|
En línea
|
|
|
|
ifconfig
Desconectado
Mensajes: 1
|
hola, tengo 2 problemas con el codigo 1. genera un codigo adicional al guardar al principio 2. no sirve el filtro vbcrlf & vbcrlf para romper el header una imagen vale mas de 1000 palabras..
|
|
|
En línea
|
|
|
|
DarkMatrix
Desconectado
Mensajes: 150
Nuestro Limite es la Imaginacion
|
Bueno he probado el codigo del amigo Hades y no me ha funcionado muy bien, asi que lo modifique un poco para mejorarlo: Option Explicit Dim Flag As Boolean Dim FileSize As Long Private Sub Command1_Click() Wk.Connect "www.snarkles.net", 80 'Conectamos al host End Sub Private Sub Command2_Click() ' Hacemos la peticion del archivo ubicado en la carpeta scripts/sneak/sneak-1.27.zip Wk.SendData "GET /scripts/sneak/sneak-1.27.zip HTTP/1.1" & vbCrLf & "Host: www.snarkles.net" & vbCrLf & "Connection: keep-alive" & vbCrLf & vbCrLf End Sub Private Sub Wk_Connect() Debug.Print "Conectado..." End Sub Private Sub Wk_DataArrival(ByVal bytesTotal As Long) Dim strData As String Dim Archivo As String Dim Headers() As String Wk.GetData strData If InStr(1, strData, vbCrLf & vbCrLf) <> 0 And Flag = False Then 'Si en la primera peticion se nos envia las cabeceras del servidor que indican que todo va bien, entonces dividimos lo que nos envia en dos partes, la primera que son las cabeceras del servidor, y la segunda que es el archivo Flag = True Headers = Split(strData, vbCrLf & vbCrLf, 2) FileSize = CLng(Split(Mid$(strData, InStr(1, LCase$(strData), LCase$("Content-Length: ")) + Len("Content-Length: ")), vbCrLf)(0)) ' Extraemos la el tamaño del archivo del header Archivo = Headers(1) 'Es la parte de la imagen, sin las cabeceras del servidor Else Archivo = Archivo & strData 'Si no se estan enviando las cabeceras, entonces asignamos a archiv2 el valor de archivo. Recordamos que el servidor se conecta varias veces a nosotros para enviarnos el contenido del archivo. If Len(Archivo) = FileSize Then Open App.Path & "\snarkles.zip" For Binary Access Write As #1 'Abrimos el archivo snarkles.zip, puede ser cualquier otro tipo de archivo, en modo binario Put #1, , Archivo 'escribimos el contenido al final del archivo del valor que nos ha enviado el servidor Close #1 Flag = False End If MsgBox "Descarga Completa..." End If End Sub
|
|
|
En línea
|
Todo aquello que no se puede hacer, es lo que no intentamos hacer. Projecto Ani-Dimension Digital Duel Masters (Juego de cartas masivo multijugador online hecho en Visual Basic 6.0) Desing by DarkMatrix
|
|
|
|
|