Simulate Keystrokes using Win32 API (SendInput)?

Recently, I was modifying the old softphone source code (written in VB6) and encountered error using ‘SendKeys’ function. Sometimes, it sends multiple keystrokes for the same char resulting in application errors. Thought of using WinAPI’s to simulate keystrokes and got this one..works really well…

 

Const KEYEVENTF_KEYUP = &H2
Const INPUT_MOUSE = 0
Const INPUT_KEYBOARD = 1
Const INPUT_HARDWARE = 2
Private Type MOUSEINPUT
    dx As Long
    dy As Long
    mouseData As Long
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
End Type

Private Type HARDWAREINPUT
    uMsg As Long
    wParamL As Integer
    wParamH As Integer
End Type

Private Type GENERALINPUT
    dwType As Long
    xi(0 To 23) As Byte
End Type

Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Sub SendKey(bKey As Byte)

Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
      

       KInput.wVk = bKey 'the key we're going to press
       KInput.dwFlags = 0 'press the key

       'copy the structure into the input array 's buffer.
       GInput(0).dwType = INPUT_KEYBOARD ' keyboard input
       CopyMemory GInput(0).xi(0), KInput, Len(KInput)

'do the same as above, but for releasing ' the key

        KInput.wVk = bKey ' the key we're going to realease
        KInput.dwFlags = KEYEVENTF_KEYUP ' release the key
        GInput(1).dwType = INPUT_KEYBOARD ' keyboard input
       CopyMemory GInput(1).xi(0), KInput, Len(KInput)
        'send the input now
        Call SendInput(2, GInput(0), Len(GInput(0)))
End Sub

To simulate “H” Keystroke, just call SendKey(CByte(asc(“H”))

How to multiple selected items from List Box (VB6)?

Ever wondered how to remove multiple selected items from list box in VB6? Trick here is loop through listbox in REVERSE.

Here is the sample and enjoy :-)

Dim intCount As Integer

For intCount = (lstSample.ListCount -1 1) To 0 Step -1

If lstSample.Selected(intCount) Then

lstSample.RemoveItem intCount

End If

Next

Delete Old log files using VB6

VB6 Snippet to delete old log files

Private Sub deleteOldFiles()

Dim sFileName As String
Dim sFileSplit() As String
Dim sFileSpec As String
Dim sDir As String
Dim iCount As Integer
Dim iCtr As Integer
Dim dCompDate As Date
Dim dFileDate As Date

On Error GoTo errHandler

sFileSpec = App.Path & "\logs\*.log"
sFileName = Dir(sFileSpec)

dCompDate = Format(Now, "mm/dd/yyyy")

Do
    If sFileName = "" Then Exit Do
        If InStr(sFileSpec, "\") > 0 Then
            sFileSplit = Split(sFileSpec, "\")
            iCount = UBound(sFileSplit) - 1
                For iCtr = 0 To iCount
                    sDir = sDir & sFileSplit(iCtr) & "\"
                Next
            sFileName = sDir & sFileName
        End If
        dFileDate = Format(FileDateTime(sFileName), "mm/dd/yyyy")
        If DateDiff("d", dFileDate, dCompDate) >= 3 Then
         'Get File Attributes
          If GetAttr(sFileName) = 33 Then
             SetAttr sFileName, 32
          End If
         Kill sFileName
        End If
    sFileName = Dir
    sDir = ""
Loop

Exit Sub

errHandler:

MsgBox Err.Number & ":" & Err.Description

End Sub

Write log using VB6

Function to write log file using Visual Basic 6

Private Sub writeLog(strMessage As String)

Dim hFile As Long
Dim sFolder As String
Dim sFile As String
Dim sDestination As String
Dim sLog As String

On Error GoTo errHandler

hFile = FreeFile()
sFolder = App.Path & "\logs"
sFile = sFolder & "\Softphone.log"

sLog = Format(Now(), "yyyy-mm-dd HH:nn:ss") & "." & Right(Format(Timer(), "0.000"), 3)
sLog = sLog & vbTab & strMessage

If lLineNumber > 60000 Then 'Approx 5 MB
    lLineNumber = 1
    sDestination = sFolder & "\Softphone_" & Format(Now(), "yyyymmdd_HHnnss") & ".log"
    FileCopy sFile, sDestination
    Kill sFile
Else
    lLineNumber = lLineNumber + 1
End If

Open sFile For Append As #hFile
    Print #hFile, sLog
Close hFile

Exit Sub

errHandler:

If Err.Number = 76 Then 'If folder not exists, create it
    MkDir sFolder
    Resume
End If
MsgBox Err.Number & ":" & Err.Description

End Sub