|
601
|
Programación / Programación Visual Basic / Re: alguien sabe como puedo capturar la pantalla, mas rapido o mejor???
|
en: 4 Septiembre 2007, 05:54 am
|
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
|
|
|
602
|
Programación / Programación Visual Basic / Re: alguien sabe como puedo capturar la pantalla, mas rapido o mejor???
|
en: 4 Septiembre 2007, 04:53 am
|
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.
|
|
|
603
|
Programación / Programación Visual Basic / Re: alguien sabe como puedo capturar la pantalla, mas rapido o mejor???
|
en: 3 Septiembre 2007, 19:41 pm
|
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 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 '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
|
|
|
606
|
Programación / Programación Visual Basic / Re: enviar datos de visual basic a una pagina web
|
en: 31 Agosto 2007, 01:59 am
|
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... 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.htmlSigo 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
|
|
|
607
|
Programación / Programación Visual Basic / Re: enviar datos de visual basic a una pagina web
|
en: 30 Agosto 2007, 04:50 am
|
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
|
|
|
608
|
Programación / Programación Visual Basic / Re: visual basic 6 HTTP request
|
en: 28 Agosto 2007, 02:14 am
|
jaja hay un monton de errores bien mientras estaba por responerte ya te pusieron algunos. pero mia bien esto PrimeroStrtrequest = strrequestno son iguales, consejo pone siempre Option Explicit y no vas a tener estos problemas SegundoPrivate Sub WS_DataArrival(ByVal bytesTotal As Long)nunca iva a llegar nada porque tu control se llama winsock1 no WSTercero al terminar la cabesera como lla te digeron Debes terminar con vbCrLf & vbCrLf Cuarto para enviar la peticion Debes ponerlo en el evento Winsock1_Connectel ejemplo buscando la palabra "hola" 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
|
|
|
|
|
|
|