Se trata de un proyecto para subir imagenes a facebook directamente con un click en las imagenes de tu ordenardor sin entrar a la pagina en Facebook
Leer más - Descargar (http://www.leandroascierto.com.ar/categoria/Aplicaciones/articulo/Facebook_Photo_Uploader.php)
Se necesitan tester.
(http://www.leandroascierto.com.ar/imagenes/Facebook1.png)
Muy buena herramienta :) aver si la utilizo uno de estos dias
sige haci Leandro :D
.
Lastima no uso FaceBook, pero por lo visto no estas usando las APIS, no va a durar.
Dulces Lunas!¡.
Leandro :D ..
Por favor
Como haria para enviar un comentario ?, No entendi bien tu modulo...
Podrias hacer sol oesa parte en un sub, con su modulo respectivo.. Gracias ;)
Public Function PublishComent(ByVal sPostFormId As String, ByVal sFb_dtsg As String, ByVal sComent As String) As Boolean
Dim hInternetOpen As Long
Dim hInternetConnect As Long
Dim hHttpOpenRequest As Long
Dim bResult As Boolean
Dim sReadBuffer As String * 1024
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
hInternetOpen = InternetOpen(USER_AGENT, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
'InternetSetOption hInternetOpen, INTERNET_OPTION_CONNECT_TIMEOUT, TIME_OUT, 4
'InternetSetOption hInternetOpen, INTERNET_OPTION_RECEIVE_TIMEOUT, TIME_OUT, 4
'InternetSetOption hInternetOpen, INTERNET_OPTION_SEND_TIMEOUT, TIME_OUT, 4
hInternetConnect = InternetConnect(hInternetOpen, "m.facebook.com", INTERNET_DEFAULT_HTTPS_PORT, vbNullString, "HTTP/1.1", INTERNET_SERVICE_HTTP, 0, 0)
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", "/a/home.php?refid=7", "HTTP/1.0", vbNullString, 0, lFlags, 0)
sBuffer = "fb_dtsg=" & sFb_dtsg & "&post_form_id=" & sPostFormId & "&charset_test=%E2%82%AC%2C%C2%B4%2C%E2%82%AC%2C%C2%B4%2C%E6%B0%B4%2C%D0%94%2C%D0%84&status=" & Unicode2UTF8(sComent) & "&update=Compartir"
PublishComent = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, ByVal sBuffer, Len(sBuffer))
'sBuffer = vbNullString
'Do
' sReadBuffer = vbNullString
' bResult = InternetReadFile(hHttpOpenRequest, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
' sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
' If Not CBool(lNumberOfBytesRead) Then Exit Do
'Loop
'If CBool(InStr(sBuffer, "/home.php?refid=7") > 0) Then
'MsgBox UTF82Unicode(MidText(sBuffer, "(<a href=" & Chr$(34) & "</a> (", ")"))
'LogIn = UTF82Unicode(MidText(sBuffer, "(<a href=" & Chr$(34) & "</a> (", ")"))
' LogIn = True
'End If
Call InternetCloseHandle(hHttpOpenRequest)
Call InternetCloseHandle(hInternetConnect)
Call InternetCloseHandle(hInternetOpen)
End Function
Muy buena idea usar la version mobil de facebook :P esa no tiene cambios bruscos y siempre es "simplon" :D
Ya lo pruebo
EDIT:
No me funciona por una cuestion de seguridad de facebook :P que tengo que poner un nombre de pc en la que estoy entrando (util para saber si alguien me keylogueo y entra en mi cuenta ;) aunque hasta ahora no ha pasado :xD)
https://www.facebook.com/loginnotify/setup_machine.php (https://www.facebook.com/loginnotify/setup_machine.php)
(http://i53.tinypic.com/30a3tk9.png)
:P
Aca te rescato el html del form (en modo PC, no se si en mobil sera igual)
<form method="post" action="/loginnotify/setup_machine.php" onsubmit="return Event.__inlineSubmit(this,event)">
<input type="hidden" autocomplete="off" name="post_form_id" value="f42a137476005393d34bbb23ec0cb000" />
<input type="hidden" name="lsd" value="lwufu" autocomplete="off" />
<div class="mvl ptm uiInterstitial uiInterstitialLarge uiBoxWhite">
<div class="uiHeader uiHeaderBottomBorder mhl mts uiHeaderPage mhl mts interstitialHeader">
<div class="clearfix uiHeaderTop">
<div class="uiHeaderActions rfloat">
</div>
<div>
<h2 class="uiHeaderTitle">Da un nombre a este equipo</h2>
</div>
</div>
</div>
<div class="phl ptm uiInterstitialContent"><br />
<div>Para añadir este ordenador a tu lista de dispositivos de confianza primero debes darle un nombre (por ejemplo, casa, trabajo, biblioteca, laboratorio). A continuación recibirás una notificación para confirmar tu inicio de sesión desde ese equipo.
</div><br />
<div>
<table class="uiInfoTable noBorder">
<tr>
<th class="label">Nombre del ordenador:
</th>
<td class="data">
<div>
<div class="field_container error_floating_container">
<input class="inputtext" type="text" name="machinename" />
</div>
</div></td>
</tr>
<tr>
<th class="label">
</th>
<td class="data">
<table class="am_saveoptiontable">
<tr><td>
<input type="checkbox" value="1" id="remembercomputer" name="remembercomputer" /></td><td>
<div>
<label for="remembercomputer">No volver a preguntarme desde este equipo
</label><br />
</div></td>
</tr>
</table></td>
</tr>
</table>
</div>
</div>
<div class="uiInterstitialBar uiBoxGray topborder">
<div class="clearfix">
<div class="rfloat">
<label class="uiButton uiButtonConfirm" for="u684741_1">
<input value="Continuar" type="submit" id="u684741_1" />
</label>
</div>
<div class="pts">
<a href="/ajax/loginnotify/dialog_why.php" rel="dialog">¿Por qué veo esto?</a>
</div>
</div>
</div>
</div>
</form>
Muy bueno quedo leandro! A mi no me aparecio nada raro, no le encuentro bugs aunque el experto en buscar bugs es Raul jaja xD
Quedo buenisimo, me subio rapidisimo las fotos.
Bueno lo prove bien de bien y iba anotando en un notepad lo q pensaba jaja mira:
cuando no hay imagen para subir
y le das a subir fotos, aparece un msgbox
q no queda tan lindo comparado con la buenisima interfaz
del resto del programa asique pienso q podrias poner
q si no hay una imagen cargada entonces q se active
el common dialog para poner una imagen a cargar, es decir
q haga el evento del boton Cargar mas sin q aparezca ningun msgbox.
Despues el "Acerca de" quedaria mejor si fuera como un link
es decir, solo pusiste un label, estaria bueno q cambie el cursor
cuando esta posicionado asi sobre sale mas ( por eso digo q seria
mejor si fuera como un link ya q haria eso)
Y lo mismo para los enlaces q tenes dentro del "Acerca de"
Al crear un album nuevo me aparecio un msgbox q dice Error pero solo una vez
ahora no, hare mas pruebas..
Talvez va en gustos pero no me gusta q al poner Cancelar cierres toda la aplicacion,
la q tienes q cerrar tendria q ser el FbHttpRequest,pienso,para q se cancele la subida
de la imagen pero q la aplicacion grafica quede mostrandose por si quiere borrar de la
lista esa foto y poner otras nuevas a subir, sin tener q volver a entrar denuevo.
Despues esta todo bien creo
-------------------------------------------------------------------------
Y ya q estamos, con lo q dijo BlackZero, q dijo q no iba a durar y el porq te puso el codigo html raul pienso q talvez puedes ayudarme con algo q estoy haciendo:
http://foro.elhacker.net/net/ayuda_proyecto_con_webbrowser-t320533.0.html
Tu respuesta capas q es: Crea otro ejecutable q se iniciara con diferentes parametros, asi como hiciste con el FbhttpRequest.exe
Pero talvez no lo haces asi, yo lei en tu web pero no entendi y no lei el codigo porq tampoco lo entiendo mucho, pero alguna parte la debes haber echo como estoy haciendo yo y talvez me solucionas esa duda xD
Muy linda herramienta ;-)
Me gustaría que utilizaras threads en vez un proceso por cada subida :P
Saludos
te quedo muy lindo Leandro como siempre, lo unico... capas que sea un parto mantenerlo si cambia facebook, pero la idea esta excelente.
saludos.
Gracias por los comentarios, bueno me olvide mencionar que no esta aplicado lo del Proxy, ya que no tengo forma de probarlo, alguien sabe si existe alguna aplicación para instalar en la pc que trabaje como proxy , o bien algunos ejemplos de como implentarlo segun muestra el formulario de configuración?
@raul338 me mataste con eso, tendria que verlo, pero bueno creo que las personas como tu quedan fuera del uso de la aplicacion :D :D :D
@F3B14N si seria lo correcto, pero la verdad no le tengo mucha fe a vb con el uso de threads seria un gran dolor de cabeza.
@XXX-ZERO-XXX gracias por los consejos, se pueden implementar sin problemas, y si la verdad el msgbox es bastante feo :-\
@BlackZeroX▓▓▒▒░░ gracias igual :¬¬ :¬¬ ;D
Espera hasta encontrar lo del proxy y esperamos la version 2 :P
Una interfaz impresionante, siempre con ese toque profesional :) Buen trabajo Leandro, a falta de probarlo solo digo que deberías usar la API de Facebook para ser un Pro de verdad :xD... :silbar:
Cita de: LeandroA en 10 Marzo 2011, 19:30 PM
@F3B14N si seria lo correcto, pero la verdad no le tengo mucha fe a vb con el uso de threads seria un gran dolor de cabeza.
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function VirtualProtect Lib "KERNEL32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function CreateThread Lib "KERNEL32" (ByVal lpSecurityAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function ReadProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function VBDllGetClassObject Lib "MSVBVM60" (g1 As Long, g2 As Long, ByVal g3_vbHeader As Long, REFCLSID As Long, REFIID As GUID, ppv As Long) As Long
Private Declare Function CreateIExprSrvObj Lib "MSVBVM60" (ByVal p1_0 As Long, ByVal p2_4 As Long, ByVal p3_0 As Long) As Long
Private Declare Function CoInitialize Lib "OLE32" (ByVal pvReserved As Long) As Long
Private Declare Sub CoUninitialize Lib "OLE32" ()
Private VBHeaderAddress As Long
Private MainAddress As Long
Public Sub CreateNewThread(ByVal lAddress As Long, ByVal lVal As Long, Optional ByRef lHandle As Long, Optional ByRef lThread As Long)
If VBHeaderAddress = 0 Then
Call GetFakeHeader: Call GetMainAddress
Call VirtualProtect(ByVal MainAddress, 1, &H40, 0&)
End If
lHandle = CreateThread(ByVal 0&, ByVal 0&, lAddress, ByVal lVal, 0, lThread)
End Sub
Public Sub InitCurrentThread()
Call CreateIExprSrvObj(0, 4, 0)
Call CoInitialize(0)
Call InitDLL
End Sub
Public Sub TerminateCurrentThread()
Call CoUninitialize
End Sub
Public Sub GetFakeHeader()
Dim lPtr As Long
Dim lProc As Long
Dim bData(1024) As Byte
Dim sData As String
Dim lRet As Long
lPtr = App.hInstance
Do While lRet = 0
Call ReadProcessMemory(-1, ByVal lPtr, bData(0), 1024, 0&)
sData = StrConv(bData, vbUnicode)
lRet = InStr(1, sData, "VB5!", vbBinaryCompare)
lPtr = lPtr + 1024
Loop
VBHeaderAddress = lPtr + lRet - 1024 - 1
End Sub
Private Sub GetMainAddress()
Call ReadProcessMemory(-1, ByVal VBHeaderAddress + &H2C, MainAddress, 4, 0&)
'If MainAddress = 0 Then
' 'MainAddress = AddressOf Private Sub Form_Initialize()
'End If
End Sub
Private Sub InitDLL()
Dim pIID As GUID
With pIID
.Data1 = 1
.Data4(0) = &HC0
.Data4(7) = &H46
End With
Call ReadProcessMemory(-1, &HC3, ByVal MainAddress, 4, 0&)
Call VBDllGetClassObject(0, 0, VBHeaderAddress, 0, pIID, 0)
Call ReadProcessMemory(-1, &H8B, ByVal MainAddress, 4, 0&)
End Sub
Private Sub Main()
CLIENT_Main.Show
End SubFunciona sin problemas, simplemente pon Sub Main como objeto inicial y desde ahi inicia el/los forms normalmente. Recorda llamar InitCurrentThread en cada nuevo thread también.
Cita de: F3B14N en 11 Marzo 2011, 18:01 PM
Funciona sin problemas, simplemente pon Sub Main como objeto inicial y desde ahi inicia el/los forms normalmente. Recorda llamar InitCurrentThread en cada nuevo thread también.
Hola la verdad no entiendo el codigo y me cierra todo con error cuando llamo a InitCurrentThread
como aplicas eso con las apis de inet?
Cita de: LeandroA en 11 Marzo 2011, 22:52 PM
Hola la verdad no entiendo el codigo y me cierra todo con error cuando llamo a InitCurrentThread
como aplicas eso con las apis de inet?
Llama la función
CreateNewThread pasandole el puntero a una funcion donde se iniciará el nuevo hilo, al inicio de esa funcion llama
InitCurrentThread y luego hace las llamadas que quieras, todo eso será en un nuevo thread, recorda usar vbModal cuando vas a mostrar forms y lo que dije anteriormente
pon Sub Main como objeto inicial y desde ahi inicia el/los forms normalmenteSaludos