Mensajes

No entiendo mucho como decis vos, pero ya casi lo tengo listo, no abria que guarad las imagenes para compararlas y es rapido, pero bueno un poco por falta de experiencia tengo que pintar cada cuadro en un picture para poder obtener los bits, que si obiamente tomara esto desde la pantalla misma seria un paso menos y por lo tanto menos procesador, pero bueno para arrancar va a tirar bien, dentro un rato lo termino

Perfecto,yo por mi parte voy a intentar comparar los cuadros, creo que en un principio para no complicar la cosa seria mejor tomar como referencia un monitor de 17 pulgadas que creo si no me equivoco deve ser lo mas estandar. por lo que voy a dividir este monitor en 8 partes  el ancho y en 6 el alto, por lo tanto seria un total de 48 cuadros a comparar, una ves que tenga esto posteo el codigo.

Saludos

PD: para comprimir creo que seria mejor usar un modulo de stos en lo que estuvimos ablando aca, lo de las lineas de comando no creo que sea buena idea por el tema que no sabriamos cuando la imagen fue comprimida ya que visual basic no recive retornos.

[GDI Plus]

Si lo que se quiere hacer es algo asi como un escritorio remoto, es decir enviar toma tras toma, la mejor y diria unica forma es tal como dice cobein, mandar primero la imagen entera y despues mandar las modificaciones que ayan, fijencen en como trabajan los Escritorios remotos profecionales , envian la primera toma(claro en distintas calidades y despues la van mejorando) , y luego parten la pantala en varios trosos iguales, y si alguno de esos trosos cambia los envia, entonces asi se acelera mucho mas la cosa. (si quieren podemos intentar hacer uno yo me engancho). claro esta no es nada facil.

Este es el ejemplo utilizando GDI Plus de capturar y guardar la imagen en formato .png

En un formulario con un picture1 y un Command1

Código [Seleccionar] Expandir


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()
Dim Antes As Long
Antes = GetTickCount

Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Picture1.Move 0, 0, Screen.Width, Screen.Height
StretchBlt Picture1.hdc, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, Screen.Width, Screen.Height, vbSrcCopy
If GdipInitialized Then SavePictureAsPNG Picture1.image, "C:\Pruevas.png"

MsgBox "Tiempo: " & GetTickCount - Antes
End Sub

Private Sub Form_Load()
   
    GdipInitialized = False
   
    ' GDI+ initialisieren
    If Execute(StartUpGDIPlus(GdiPlusVersion)) = OK Then
        GdipInitialized = True
    Else
        MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error"
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    ' ist GDI+ Initialisiert
    If GdipInitialized = True Then
       
        ' GDI+ beenden
        Call Execute(ShutDownGDIPlus)
    End If
End Sub



y en un modulo bas

Código [Seleccionar] Expandir


'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

Option Explicit

' ----==== GDI+ Konstanten ====----
Public Const GdiPlusVersion As Long = 1
Private Const mimePNG As String = "image/png"

' ----==== Sonstige Typen ====----
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7)  As Byte
End Type

Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hgdiObj As Long
    hPalOrXYExt As Long
End Type

' ----==== GDI+ Typen ====----
Private Type ImageCodecInfo
    Clsid As GUID
    FormatID As GUID
    CodecNamePtr As Long
    DllNamePtr As Long
    FormatDescriptionPtr As Long
    FilenameExtensionPtr As Long
    MimeTypePtr As Long
    flags As Long
    Version As Long
    SigCount As Long
    SigSize As Long
    SigPatternPtr As Long
    SigMaskPtr As Long
End Type

Private Type GdiplusStartupOutput
    NotificationHook As Long
    NotificationUnhook As Long
End Type

Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

' ----==== GDI+ Enumerationen ====----
' GDI+ Status
Public Enum Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

' ----==== GDI+ API Deklarationen ====----
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal FileName As Long, ByRef Bitmap As Long) As Status

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hPal As Long, _
    ByRef Bitmap As Long) As Status

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
    (ByVal Bitmap As Long, ByRef hbmReturn As Long, _
    ByVal background As Long) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Status

Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
    (ByVal numEncoders As Long, ByVal Size As Long, _
    ByRef Encoders As Any) As Status

Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
    (ByRef numEncoders As Long, ByRef Size As Long) As Status

Private Declare Function GdiplusShutdown Lib "gdiplus" _
    (ByVal token As Long) As Status

Private Declare Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
    Optional ByRef lpOutput As Any) As Status

Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
    (ByVal image As Long, ByVal FileName As Long, _
    ByRef clsidEncoder As GUID, _
    ByRef encoderParams As Any) As Status

' ----==== OLE API Deklarationen ====----
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
    (lpPictDesc As PICTDESC, riid As IID, _
    ByVal fOwn As Boolean, lplpvObj As Object)

' ----==== Kernel API Deklarationen ====----
Private Declare Function lstrcpyW Lib "kernel32" _
    (lpString1 As Any, lpString2 As Any) As Long

Private Declare Function lstrlenW Lib "kernel32" _
    (lpString As Any) As Long

' ----==== Variablen ====----
Dim GdipToken As Long
Public GdipInitialized As Boolean

'------------------------------------------------------
' Funktion     : Execute
' Beschreibung : Gibt im Fehlerfall die entsprechende
'                GDI+ Fehlermeldung aus
' Übergabewert : GDI+ Status
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function Execute(ByVal lReturn As Status) As Status
    Dim lCurErr As Status
    If lReturn = Status.OK Then
        lCurErr = Status.OK
    Else
        lCurErr = lReturn
        MsgBox GdiErrorString(lReturn) & " GDI+ Error:" _
        & lReturn, vbOKOnly, "GDI Error"
    End If
    Execute = lCurErr
End Function

'------------------------------------------------------
' Funktion     : GdiErrorString
' Beschreibung : Umwandlung der GDI+ Statuscodes in Stringcodes
' Übergabewert : GDI+ Status
' Rückgabewert : Fehlercode als String
'------------------------------------------------------
Private Function GdiErrorString(ByVal lError As Status) As String
    Dim s As String
   
    Select Case lError
    Case GenericError:              s = "Generic Error."
    Case InvalidParameter:          s = "Invalid Parameter."
    Case OutOfMemory:               s = "Out Of Memory."
    Case ObjectBusy:                s = "Object Busy."
    Case InsufficientBuffer:        s = "Insufficient Buffer."
    Case NotImplemented:            s = "Not Implemented."
    Case Win32Error:                s = "Win32 Error."
    Case WrongState:                s = "Wrong State."
    Case Aborted:                   s = "Aborted."
    Case FileNotFound:              s = "File Not Found."
    Case ValueOverflow:             s = "Value Overflow."
    Case AccessDenied:              s = "Access Denied."
    Case UnknownImageFormat:        s = "Unknown Image Format."
    Case FontFamilyNotFound:        s = "FontFamily Not Found."
    Case FontStyleNotFound:         s = "FontStyle Not Found."
    Case NotTrueTypeFont:           s = "Not TrueType Font."
    Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
    Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
    Case PropertyNotFound:          s = "Property Not Found."
    Case PropertyNotSupported:      s = "Property Not Supported."
    Case Else:                      s = "Unknown GDI+ Error."
    End Select
   
    GdiErrorString = s
End Function

'------------------------------------------------------
' Funktion     : GetEncoderClsid
' Beschreibung : Ermittelt die Clsid des Encoders
' Übergabewert : mimeType = mimeType des Encoders
'                pClsid = CLSID des Encoders (in/out)
' Rückgabewert : True = Ermitteln erfolgreich
'                False = Ermitteln fehlgeschlagen
'------------------------------------------------------
Private Function GetEncoderClsid(mimeType As String, _
    pClsid As GUID) As Boolean
   
    Dim Num As Long
    Dim Size As Long
    Dim pImageCodecInfo() As ImageCodecInfo
    Dim j As Long
    Dim buffer As String
   
    Call GdipGetImageEncodersSize(Num, Size)
    If (Size = 0) Then
        ' fehlgeschlagen
        GetEncoderClsid = False
        Exit Function
    End If
   
    ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1)
   
    Call GdipGetImageEncoders(Num, Size, pImageCodecInfo(0))
   
    For j = 0 To Num - 1
       
        buffer = _
        Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr))
       
        Call lstrcpyW(ByVal StrPtr(buffer), _
        ByVal pImageCodecInfo(j).MimeTypePtr)
       
        If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then
            pClsid = pImageCodecInfo(j).Clsid
            Erase pImageCodecInfo
            ' erfolgreich
            GetEncoderClsid = True
            Exit Function
        End If
    Next j
   
    Erase pImageCodecInfo
    ' fehlgeschlagen
    GetEncoderClsid = False
End Function

'------------------------------------------------------
' Funktion     : HandleToPicture
' Beschreibung : Umwandeln eines Bitmap Handle
'                in ein StdPicture Objekt
' Übergabewert : hGDIHandle = Bitmap Handle
'                ObjectType = Bitmaptyp
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function HandleToPicture(ByVal hGDIHandle As Long, _
    ByVal ObjectType As PictureTypeConstants, _
    Optional ByVal hPal As Long = 0) As StdPicture
   
    Dim tPictDesc As PICTDESC
    Dim IID_IPicture As IID
    Dim oPicture As IPicture
   
    ' Initialisiert die PICTDESC Structur
    With tPictDesc
        .cbSizeOfStruct = Len(tPictDesc)
        .picType = ObjectType
        .hgdiObj = hGDIHandle
        .hPalOrXYExt = hPal
    End With
   
    ' Initialisiert das IPicture Interface ID
    With IID_IPicture
        .Data1 = &H7BF80981
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
   
    ' Erzeugen des Objekts
    OleCreatePictureIndirect tPictDesc, IID_IPicture, _
    True, oPicture
   
    ' Rückgabe des Pictureobjekts
    Set HandleToPicture = oPicture
   
End Function

'------------------------------------------------------
' Funktion     : LoadPicturePlus
' Beschreibung : Lädt ein Bilddatei per GDI+
' Übergabewert : Pfad\Dateiname der Bilddatei
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Public Function LoadPicturePlus( _
    ByVal sFileName As String) As StdPicture
   
    Dim lBitmap As Long
    Dim hBitmap As Long
   
    ' Öffnet die Bilddatei in lBitmap
    If Execute(GdipCreateBitmapFromFile(StrPtr(sFileName), _
    lBitmap)) = OK Then
       
        ' Handle der Bitmap ermitteln lBitmap -> hBitmap
        If Execute(GdipCreateHBITMAPFromBitmap(lBitmap, _
        hBitmap, 0)) = OK Then
           
            ' Erzeugen des StdPicture Objekts von hBitmap
            Set LoadPicturePlus = HandleToPicture(hBitmap, _
            vbPicTypeBitmap)
        End If
       
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
       
    End If
End Function

'------------------------------------------------------
' Funktion     : SavePictureAsPNG
' Beschreibung : Speichert ein StdPicture Objekt
'                per GDI+ als PNG
' Übergabewert : Pic = StdPicture Objekt
'                FileName = Pfad\Dateiname.png
' Rückgabewert : True = speichern erfolgreich
'                False = speichern fehlgeschlagen
'------------------------------------------------------
Public Function SavePictureAsPNG(ByVal Pic As StdPicture, _
    ByVal sFileName As String) As Boolean
   
    Dim lBitmap As Long
    Dim tPicEncoder As GUID
   
    ' Erzeugt eine GDI+ Bitmap vom
    ' StdPicture Handle -> lBitmap
    If Execute(GdipCreateBitmapFromHBITMAP( _
    Pic.Handle, 0, lBitmap)) = OK Then
       
        ' Ermitteln der CLSID vom mimeType Encoder
        If GetEncoderClsid(mimePNG, tPicEncoder) = True Then
           
            ' Speichert lBitmap als PNG
            If Execute(GdipSaveImageToFile(lBitmap, _
            StrPtr(sFileName), tPicEncoder, ByVal 0)) = OK Then
               
                ' speichern erfolgreich
                SavePictureAsPNG = True
            Else
                ' speichern nicht erfolgreich
                SavePictureAsPNG = False
            End If
        Else
            ' speichern nicht erfolgreich
            SavePictureAsPNG = False
            MsgBox "Konnte keinen passenden Encoder ermitteln.", _
            vbOKOnly, "Encoder Error"
        End If
       
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
       
    End If
End Function

'------------------------------------------------------
' Funktion     : StartUpGDIPlus
' Beschreibung : Initialisiert GDI+ Instanz
' Übergabewert : GDI+ Version
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
    ' Initialisieren der GDI+ Instanz
    Dim tGdipStartupInput As GDIPlusStartupInput
    Dim tGdipStartupOutput As GdiplusStartupOutput
   
    tGdipStartupInput.GdiPlusVersion = GdipVersion
    StartUpGDIPlus = GdiplusStartup(GdipToken, _
    tGdipStartupInput, tGdipStartupOutput)
End Function

'------------------------------------------------------
' Funktion     : ShutDownGDIPlus
' Beschreibung : Beendet die GDI+ Instanz
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function ShutDownGDIPlus() As Status
    ' Beendet GDI+ Instanz
    ShutDownGDIPlus = GdiplusShutdown(GdipToken)
    GdipInitialized = False
End Function




la velocidad es practicamente inotable, y el peso de la captura final es aproximadamente de 80.000 bytes un poco mas que la de jpg, pero con mayor calidad (casi sin perdidas) y mas velocidad

Saludos

una forma mas rapida es guardandola con formato .png pero ya vas a depender de
GDI ++

si quieres te paso un modulo para guardar las imagenes en ese formato (pero tene en cuenta que la pc que lo ejecute deve tener gdi plus instalado , en xp ya viene por defecto)

Saludos

A que le llamas deshabilitar , a que no se vean , a que no se le puedan hacer click osea disabel, o a que directamente no se carguen , a que no se carguen lo veo medio jodido pero a que no se vean o no se le puedan hacer click si se puede.


Saludos

[no digo que este mal, nunca viene de mas]

Para aprender desde el fondo, no useis el winsock que es un ocx mas prefabricado.
Para hacer peticiones http usar las apis que os permiten mandar cabeceras, elegir el metodo, cookies, recibir la pagina y demas...

Código [Seleccionar] Expandir


Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer


http://articulos.conclase.net/jm/prog/cpp/wininethttp_2.html

Sigo sosteniendo que el api wininet es un simplificador de todo esto, tanto  en el protocolo http como el ftp, no quiero discutir mal por todo esto, es mi punto de vista, esta api es propia del iexplorer, incluso maneja el mismo canche, pero que quede claro que no es la forma nativa de hacer las cosas, esto no ayuda a entender el protoclo solo ayuda a entender a usar el api wininet (no digo que este mal, nunca viene de mas) , pero el tema es que si algun dia quieres hacer un server y no un cliente, no vas a entender como se hace porque solo aprendiste a usar un simplificador y nunca aprendiste el protocolo.

Saludos

[wininet]

Estoy completamente deacuerdo con HaDeS, la forma mas profesional de hacer estas cosas es de esta forma, porque? al utilizar las librerias del IE tanto sea por apis wininet o el mismo control webbrowser o el Inet (MSInet.ocx), quizas estas nos puedan simplificar un poco las cosas, pero  estamos perdiendo mucha informacion como ser las cabeseras y  el control de las cosas que pasan de por medio, otra es que quedamos parado hasta que estos controles o apis nos devuelvan una respuesta, tomen como ejemplo un cliente ftp echo con las apis del wininet, como veran nuestro programa se va a ir colgando por cada peticion que se envie, y porque con los programas ftp profecionales no pasa esto? pues por la sencilla razón de que utilizan este metodo (obio no en el protocolo fpt).
y bien muchas otras rasones mas, y si bien muchos dirian pero el control winsock no esta en todas las pc. y los demas si, pues si quieren hacer algo mas profesional aun no dependan de este ocx y utilizen las apis ws2_32.dll



Felizitaciones HaDeS por el Manual

una observacion
creo que esta linea seria mejor asi

If InStr(1, Datos, vbCrLf & vbCrLf) <> 0 And Flag = False Then
Flag =true

puse Flag en el general como una variable boolean porque me a pasado en ocasiones que la cabesera termina de llegar en el segundo paquete entonces esta condicion no se cumpliria And InStr(1, Datos, "HTTP/1.1 200 OK"

Saludos

[Primero]

jaja hay un monton de errores bien mientras estaba por responerte ya te pusieron algunos. pero mia bien esto


Primero

Strtrequest = strrequest

no son iguales, consejo pone siempre Option Explicit y no vas a tener estos problemas

Segundo

Private Sub WS_DataArrival(ByVal bytesTotal As Long)

nunca iva a llegar nada porque tu control se llama winsock1 no WS

Tercero

al terminar la cabesera como lla te digeron Debes terminar con vbCrLf & vbCrLf

Cuarto

para enviar la peticion Debes ponerlo en el evento Winsock1_Connect


el ejemplo buscando la palabra "hola"

Código [Seleccionar] Expandir


Option Explicit


Private Sub Command1_Click()
    Winsock1.Close
    Winsock1.Connect "www.google.com", 80
End Sub


Private Sub Winsock1_Connect()

Dim StrRequest As String

StrRequest = "GET /search?hl=es&q=hola&btnG=Buscar+con+Google&meta= HTTP/1.1" & vbCrLf & _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; es-ES; rv:1.8.1.6) Gecko/20070725 Firefox/2.0.0.6" & vbCrLf & _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf & _
"Accept-Language: es-es,es;q=0.8,en-us;q=0.5,en;q=0.3" & vbCrLf & _
"Accept -Encoding: gzip , deflate" & vbCrLf & _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf & _
"Keep-Alive: 300" & vbCrLf & _
"Connection: keep -alive" & vbCrLf & vbCrLf


Winsock1.SendData StrRequest

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
Winsock1.GetData datos
Text1.Text = Text1.Text + datos
End Sub


Hola no entendi bien la pregunta a que es lo que te refiers con mas detalles

Saludos

hola no lo avia provado pero si es cierto si le pones clic no anda ponele solo esto

WebBrowser1.Document.Forms(0).what.Value = "http://google.com"
WebBrowser1.Document.Forms(0).Submit

por si te sirve fijate que una forma mas directa de hacer lo que  queres es ir directamente a esta pagina

http://anonymouse.org/cgi-bin/anon-www.cgi/http://www.megaupload.com/?d=L4Q97W63

http://anonymouse.org/cgi-bin/anon-www.cgi/http://www.google.com/webhp?hl=en


por lo de mas que preguntateste te paso un ejemplo

http://ar.geocities.com/leandroascierto/Tagmodell_des_Webbrowsers.zip