Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Danyfirex en 14 Mayo 2013, 20:22 pm



Título: AnonFilesUpload Función
Publicado por: Danyfirex en 14 Mayo 2013, 20:22 pm
Una funcion para subir archivos a Anonfiles  :rolleyes:

Código
  1. ' =================================================================
  2. ' =================================================================
  3. ' => Autor: Danyfirex
  4. ' => Upload file to AnonFiles.com
  5. ' => Gracias AnonFiles.com
  6. ' => Fecha : 14|05|2013
  7. ' => Uso: AnonFilesUpload("c:\hola.rar")
  8. ' => Retorno: Texto de Respuesta (hotlink)
  9. ' =================================================================
  10. ' =================================================================
  11.  
  12.  
  13. Option Explicit
  14.  
  15. Function AnonFilesUpload(filepath As String) As String
  16. Dim boundary As String
  17. Dim Post As String
  18. Dim bytesfinal()  As Byte
  19. Dim bytes() As Byte
  20. Dim url As String
  21. Dim Http As Object
  22. Dim filedata As String
  23.  
  24. url = "https://anonfiles.com/api/hotlink"
  25. boundary = "--------Boundary"
  26.  
  27.  
  28. Open filepath For Binary As #1
  29. ReDim bytes(LOF(1) - 1)
  30. Get #1, , bytes()
  31. Close #1
  32. filedata = StrConv(bytes(), vbUnicode)
  33.  
  34. Post = "--" & boundary & vbCrLf & _
  35. "Content-Disposition: form-data; name=" & Chr(34) & "file" & Chr(34) & "; filename=" & Chr(34) & filename(filepath) & Chr(34) & vbCrLf & _
  36. "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
  37. filedata & vbCrLf & _
  38. "--" & boundary & "--" & vbCrLf
  39.  
  40. bytesfinal() = StrConv(Post, vbFromUnicode)
  41.  
  42. Set Http = CreateObject("winhttp.winhttprequest.5.1")
  43. Http.Open "POST", url, False
  44. Http.SetRequestHeader "Content-Type", "multipart/form-data; " & "boundary=" & boundary
  45. Http.Send (bytesfinal())
  46. AnonFilesUpload = Http.ResponseText
  47. Set Http = Nothing
  48. End Function
  49.  
  50. Function filename(cadena As String) As String
  51. Dim cadenas() As String
  52. cadenas() = Split(cadena, "\")
  53. filename = cadenas(UBound(cadenas))
  54. End Function


Título: Re: AnonFilesUpload Función
Publicado por: XresH en 14 Mayo 2013, 22:32 pm
Excelente, lo probe y me funciono correctamente, para los nuevos si me permitis dejo un comentario y un detalle !

Para usar esta funcion realizada por Danyfirex pueden "llamarla" de esta manera


Código:
txtUrl.Text = AnonFilesUpload("c:\mibat.rar")


Donde txtUrl es en donde obtendremos el string que tiene la url para la
descarga de nuestro archivo, lo que esta entre parentesis es el archivo
que queremos subir.
Tengan en cuenta que cuanto mas grande sea el archivo, mas tiempo lleva.

Buen aporte, Saludos.