Mensajes

Hola se me a dado la idea de crear un buscador de multimedia, pero tengo una duda con respecto al analisis del codigo web(html,java,csx etc).   la mayoria de las  web reciven el contenido en Gzip. que luego el navegador lo traduce y obtiene el codigo. mi duda principal es encontrar la direccion el enlaze del video o musica. Ej: con www.youtube.com : http://www.youtube.com/watch?v=x4nT4XxAoQ4 dentro de ese link se encuentra un embed que contiene la ruta del video en el server, como encuentro ese link. cualquier informacion estaria genial. grax y la duda secundaria : hay alguna modulo en alguna web para extraer el contenido gzip

mira te e echo un ejemplo muy rapido. no lo e probado, seguro tiene errores pero  es lo q buscas, estoy apurado por irme de joda. cuando llegue te lo mejoro .

Código (vb) [Seleccionar] Expandir

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Const ProAcceall As Long = &H1F0FFF
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseox As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteString Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseox As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long




Dim NombreVentana As String, TexoRm As String, TexoOriginal As String, Direccion As Long'variables para utilzar con la memoria
Public Sub Started(Nom As String, t As String, d As String, p As Long)'funcion que inicia la secuenia
NombreVentana = Nom'nombre de la ventana a buscar o parte de ella
TexoRm = t'texto a introducir
TexoOriginal = d'texto original
Direccion = p'direccionn de memoria
   Call EnumWindows(AddressOf EnumCallback, 0)'almacena  los nombres obtenidos de ventanas e jecucion
End Sub
 
 

Private Function EnumCallback(ByVal A_hwnd As Long, ByVal param As Long) As Long
              Dim Size_buffer As Long, buffer As String * 256
Dim str As String
Size_buffer = GetWindowText(A_hwnd, buffer, Len(buffer))

If InStr(1, Left$(buffer, Size_buffer), NombreVentana) > 0 Then

   
   str = ReadMem(A_hwnd, Direccion, LenB(TexoOriginal), TexoRm)
   

Exit Function
End If

   EnumCallback = 1
End Function
 

Private Function ReadMem(hWnd As Long, Ox As Long, Bytes As Long, Optional Rempla As String) As String

   On Error Resume Next
   Dim Id As Long, sHandle As Long, bytValue As Long, i As Long, Text As String
   
 
   GetWindowThreadProcessId hWnd, Id


   sHandle = OpenProcess(ProAcceall, False, Id)
   
   If (sHandle = 0) Then
   
        Exit Function
   End If
   If Ox = 0 Then Exit Function
   
   For i = 1 To Bytes Step 2

      ReadProcessMemory sHandle, Ox + i - 1, bytValue, 1, 0&
   
      ReadMem = ReadMem & Chr$(bytValue)
   Next
 
   If LenB(Rempla) <> 0 Then
   
       WriteString sHandle, Ox, StrPtr(Rempla), LenB(Rempla), 0&
   End If

   CloseHandle sHandle
End Function



si se puede hacer en vb. solo tienes que tener el control de los puertos com y crear tus drivers. es mejor en asm pero no vas a tener buena interfaz.

http://es.scribd.com/doc/492504/VISUAL-BASICCONTROL-DE-PUERTOS-

what is your goal, you  put more information
Example :

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()

' Use a block of memory as an intermediary step to copy
' the contents of array s() to array t(). Yes, you could copy them directly,
' but this demonstrates a few different memory functions.
Dim s(0 To 255) As Integer, t(0 To 255) As Integer ' arrays to copy from/to
Dim c As Integer, retval As Long ' counter variable & return value
Dim hMem As Long, pMem As Long ' handle and pointer to memory block

' Initialize the source array s()'s data
For c = 0 To 255
s(c) = 2 * c ' each element equals double its index
Next c

' Allocate a moveable block of memory (returns a handle) (Integer type = 2 bytes)
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, 256 * 2)
' Lock the memory block, returning a pointer to it
pMem = GlobalLock(hMem)
' Copy the entire contents of s() to the memory block
' Note that pMem is ByVal because we want its contents, not a pointer to it
CopyMemory ByVal pMem, s(0), 255 * 2
' Copy the contents of the memory block to t() (we could have just copied s() to t())
CopyMemory t(0), ByVal pMem, 256 * 2
' Unlock the memory block, destroying the pointer and freeing resources
x = GlobalUnlock(hMem)
' Free the memory block (de-allocate it)
x = GlobalFree(hMem)

' Verify that t() = s(), which it should
For c = 0 To 255
If s(c) <> t(c) Then Debug.Print "Copy attempt failed."
List1.AddItem t(c)

Next


End Sub
'''
module

Código (vb) [Seleccionar] Expandir

Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long


nada es imposible , si tu esposo tiene la id de la navegacion o la cokie  entra sin ningún problema  , nis pass ni usser 

Hola como estoy enfermo no puedo hacer nada estoy en la  pc jaja, me puse a boludear con winsock y vi como 3 ejemplos de winsock32 ,  y decidí aprender mas de las apis y me puse a jugar  tengo este codigo, pero tengo problema en dejarlo statico en memoria para que llame a la funciones correspondientes (depaso dejamos el surce si lo termino con exito)
* se conecta con exito, y envia datos con exito , el problema es  hacer la funcion de descarga,

Código (vb) [Seleccionar] Expandir

Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As SOCKADDR, ByVal namelen As Long) As Long
Private Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
Private Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
Private Const SOCK_STREAM As Long = 1
Private Const AF_INET As Long = 2
Private Const IPPROTO_TCP As Long = 6
Private Called As Long
Private Callad As Long
Public SocketHandle As Long
Public Len_Bytes_Enviados As Long
Public Status As Long
Public m_ObjectHost As Object

Private Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Private Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * 257
szSystemStatus As String * 129
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Const GWL_WNDPROC As Long = (-4)

Public Function Form_Gethw(ObjectHost As Object)

Dim StartupData As WSADataType


   Set m_ObjectHost = ObjectHost

 
       If Not WSAStartup(&H101, StartupData) Then
           bIsInit = True
           hWin = CreateWindowEx(0&, "STATIC", "SOCKET_WINDOW", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)
           PrevProc = SetWindowLong(hWin, GWL_WNDPROC, AddressOf Socket_Evento)
       Else
           bIsInit = False
       End If
End Function


Public Function WsConnect(ByVal Host As String, ByVal Port As Long) As Long
Dim s As Long, Sockin As SOCKADDR

Sockin.sin_family = 2
Sockin.sin_port = htons(Port)
Sockin.sin_addr = inet_addr(Host$)
s = Socket(2, 1, 6)
If Connect(s, Sockin, 16) <> 0 Then
MsgBox "error al conectar"
Exit Function
End If


SocketHandle = s
'Call Enviar0("HOLA COMO ANDAS ANDAS LAURITA")
End Function

Public Function Enviar0(Data As String)
Dim Temp0$, Data0() As Byte
Select Case VarType(Data)
Case 8209
Data0 = Data
Case 8
Data0 = StrConv(Data, vbFromUnicode)
Case Else
Data0 = CStr(Data)
Data0 = StrConv(Data, vbFromUnicode)
End Select
Len_Bytes_Enviados = Send(SocketHandle, Data0(0), Len(Data), 0)
End Function

Private Function Socket_Evento(ByVal hWnd As Long, ByVal uMsg As Long, ByVal SocketHandle As Long, ByVal Evento As Long) As Long

Select Case Evento
Case &H10& 'conectado
Call m_ObjectHost.Scoket0_Conectado

Case &H20& 'cerrado
Call m_ObjectHost.Scoket0_Cerrado
Case &H1& 'descarga
Dim DataTemp As String, Ret As Long, rBuff As String

Do
rBuff = String(1024, 0)
Ret = recv(SocketHandle, ByVal rBuff, Len(rBuff), 0)
If Ret > 0 Then DataTemp = DataTemp + Left$(rBuff, Ret)
Loop Until Ret <= 0
If LenB(DataTemp) > 0 Then
Call m_ObjectHost.Scoket0_Descarga(DataTemp)
End If
End Select

End Function
Public Sub terminate()
DestroyWindow Called
Call WSACleanup
End Sub

el problema esta ak, en Socket_Evento , no recibe la llamada de SetWindowLong, me podrian echar una manito

hola, si lo que tu quieres es con un shape y label mostrar el la cantidad de mana y en la otra de vida utiliza CopyMemory

Código (vb) [Seleccionar] Expandir

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"  (pDst As Any,pSrc As Any, ByVal ByteLen As Long)

ejemplo de enlace: http://programmer-collection.blogspot.com.ar/2008/12/vb6-copymemory-and-array-copying.html

otro: si lo que tu quieres es copiar, editar partes de la memoria utiliza esto http://foro.elhacker.net/programacion_visual_basic/vb6asm_alternativa_copymemoryrtlmovememorycopybytes-t300862.0.html

export no documentado de SHELL32.

habra otras ??? recién me entero de estas ajajajja   gracias por compartir

mira  con el FOR EACH  estas recorriendo un Array de datos, yo te aconsegaria que uses arrays de datos   y utilices el listview para la visualización de ella.

te dejo un ejemplo para que no estes tan perdido.

Código (vb) [Seleccionar] Expandir

Dim Array() As String ,cadena As Variant 'modifique la variable,  variant y no a string
ReDim Array(1) ' redimensiono 2 posiciones

Array(0) = "Rembolso"
Array(1) = "I'm sexy and kanowit"

For Each cadena In Array
MsgBox(cadena )
Next
nota: estas en .net ?

AL llegar a la tierra me hago una pelicula jajajajja