Commit: 2 - macro (svn)

windowsのステップを記録しJavaScriptにする。

Commit MetaInfo

• Revision: 2 (tree)
• Time: 2018-04-22 18:00:07
• Author: bellyoshi

Log Message

Change Summary

• modified: protoMacro/protoMacro/Form1.Designer.vb
• modified: protoMacro/protoMacro/Form1.resx
• modified: protoMacro/protoMacro/Form1.vb
• added: protoMacro/protoMacro/MouseEmulator.dll
• added: protoMacro/protoMacro/MouseHookClass.vb
• modified: protoMacro/protoMacro/protoMacro.vbproj

Incremental Difference

--- protoMacro/protoMacro/Form1.Designer.vb	(revision 1)
+++ protoMacro/protoMacro/Form1.Designer.vb	(revision 2)
@@ -1,9 +1,9 @@
-<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
+<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
 Partial Class Form1
     Inherits System.Windows.Forms.Form
 
     'フォームがコンポーネントの一覧をクリーンアップするために dispose をオーバーライドします。
-    <System.Diagnostics.DebuggerNonUserCode()> _
+    <System.Diagnostics.DebuggerNonUserCode()>
     Protected Overrides Sub Dispose(ByVal disposing As Boolean)
         Try
             If disposing AndAlso components IsNot Nothing Then
@@ -20,36 +20,49 @@
     'メモ: 以下のプロシージャは Windows フォーム デザイナーで必要です。
     'Windows フォーム デザイナーを使用して変更できます。  
     'コード エディターを使って変更しないでください。
-    <System.Diagnostics.DebuggerStepThrough()> _
+    <System.Diagnostics.DebuggerStepThrough()>
     Private Sub InitializeComponent()
+        Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Form1))
         Me.TextBox1 = New System.Windows.Forms.TextBox()
         Me.btnPlay = New System.Windows.Forms.Button()
+        Me.btnRec = New System.Windows.Forms.Button()
         Me.SuspendLayout()
         '
         'TextBox1
         '
         Me.TextBox1.Dock = System.Windows.Forms.DockStyle.Bottom
-        Me.TextBox1.Location = New System.Drawing.Point(0, 59)
+        Me.TextBox1.Location = New System.Drawing.Point(0, 53)
         Me.TextBox1.Multiline = True
         Me.TextBox1.Name = "TextBox1"
-        Me.TextBox1.Size = New System.Drawing.Size(282, 194)
+        Me.TextBox1.Size = New System.Drawing.Size(798, 459)
         Me.TextBox1.TabIndex = 0
-        Me.TextBox1.Text = "WScript.Echo(""hello world"")"
+        Me.TextBox1.Text = resources.GetString("TextBox1.Text")
         '
         'btnPlay
         '
-        Me.btnPlay.Location = New System.Drawing.Point(100, 21)
+        Me.btnPlay.Font = New System.Drawing.Font("MS UI Gothic", 13.8!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(128, Byte))
+        Me.btnPlay.Location = New System.Drawing.Point(124, 12)
         Me.btnPlay.Name = "btnPlay"
-        Me.btnPlay.Size = New System.Drawing.Size(75, 23)
+        Me.btnPlay.Size = New System.Drawing.Size(38, 35)
         Me.btnPlay.TabIndex = 1
-        Me.btnPlay.Text = "再生"
+        Me.btnPlay.Text = "▶"
         Me.btnPlay.UseVisualStyleBackColor = True
         '
+        'btnRec
+        '
+        Me.btnRec.Location = New System.Drawing.Point(79, 12)
+        Me.btnRec.Name = "btnRec"
+        Me.btnRec.Size = New System.Drawing.Size(39, 35)
+        Me.btnRec.TabIndex = 2
+        Me.btnRec.Text = "●"
+        Me.btnRec.UseVisualStyleBackColor = True
+        '
         'Form1
         '
         Me.AutoScaleDimensions = New System.Drawing.SizeF(8.0!, 15.0!)
         Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
-        Me.ClientSize = New System.Drawing.Size(282, 253)
+        Me.ClientSize = New System.Drawing.Size(798, 512)
+        Me.Controls.Add(Me.btnRec)
         Me.Controls.Add(Me.btnPlay)
         Me.Controls.Add(Me.TextBox1)
         Me.Name = "Form1"
@@ -61,4 +74,5 @@
 
     Friend WithEvents TextBox1 As TextBox
     Friend WithEvents btnPlay As Button
+    Friend WithEvents btnRec As Button
 End Class

--- protoMacro/protoMacro/Form1.vb	(revision 1)
+++ protoMacro/protoMacro/Form1.vb	(revision 2)
@@ -1,4 +1,11 @@
-Public Class Form1
+Imports System.ComponentModel
+
+Public Class Form1
+
+    Private isRec As Boolean = False
+
+    Private WithEvents MouseHook As New MouseHookClass
+
     Private Sub btnPlay_Click(sender As Object, e As EventArgs) Handles btnPlay.Click
         Dim jsfilename As String
         'ファイル名がない場合はuntitle.jsに保存する。
@@ -8,7 +15,59 @@
         End Using
 
         'untitle.jsを実行する
-        Dim p As Process = System.Diagnostics.Process.Start(jsfilename)
+        Dim p = System.Diagnostics.Process.Start(jsfilename)
 
     End Sub
+
+    Private Sub btnRec_Click(sender As Object, e As EventArgs) Handles btnRec.Click
+        isRec = Not isRec
+        btnRecView()
+        If isRec Then
+            MouseHook.MouseHookStart()
+        Else
+            MouseHook.MouseHookEnd()
+        End If
+    End Sub
+
+    Private Sub btnRecView()
+        If isRec Then
+            btnRec.Text = "■"
+        Else
+            btnRec.Text = "●"
+        End If
+        btnPlay.Enabled = Not isRec
+    End Sub
+
+    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
+        btnRecView()
+        TextBox1.SelectionLength = 0
+    End Sub
+
+    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
+        If MouseHook.Hooked = True Then
+            MouseHook.MouseHookEnd()
+        End If
+    End Sub
+
+    Private Sub MouseHook_MouseHook(sender As Object, e As MouseHookClass.MouseHookEventArgs) Handles MouseHook.MouseHook
+        'カレットの位置を取得
+        Dim selectPos As Integer = TextBox1.SelectionStart
+        InsertMouseMove(e.Point.x, e.Point.y, e.Message)
+        'カーソルを戻す
+        Me.TextBox1.SelectionStart = selectPos
+
+    End Sub
+
+    Private Sub InsertMouseMove(x As Integer, y As Integer, message As MouseHookClass.MouseMessage)
+        Dim code As String = String.Empty
+        If message = MouseHookClass.MouseMessage.Move Then
+            code = $" sh.Run(""rundll32.exe MouseEmulator.dll, _SetMouseXY@16 {x}, {y}"");"
+        End If
+
+        TextBox1.SelectedText = code
+    End Sub
+
+    Private Sub Button1_Click(sender As Object, e As EventArgs)
+
+    End Sub
 End Class

--- protoMacro/protoMacro/MouseHookClass.vb	(nonexistent)
+++ protoMacro/protoMacro/MouseHookClass.vb	(revision 2)
@@ -0,0 +1,168 @@
+Imports System.Runtime.InteropServices
+Public Delegate Function CallBack(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
+
+Public Class MouseHookClass
+
+    Dim WH_MOUSE_LL As Integer = 14
+    Shared hHook As Integer = 0
+
+    Private hookproc As CallBack
+
+    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
+    Public Overloads Shared Function GetModuleHandle(lpModuleName As String) As IntPtr
+    End Function
+
+    'Import for the SetWindowsHookEx function.
+    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
+    Public Overloads Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As CallBack, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
+    End Function
+
+    'Import for the CallNextHookEx function.
+    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
+    Public Overloads Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
+    End Function
+    'Import for the UnhookWindowsHookEx function.
+    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
+    Public Overloads Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
+    End Function
+
+    'Point structure declaration.
+    <StructLayout(LayoutKind.Sequential)> Public Structure Point
+        Public x As Integer
+        Public y As Integer
+    End Structure
+
+    <StructLayout(LayoutKind.Sequential)>
+    Public Class MouseLLHookStruct
+        Public pt As Point
+        Public mouseData As Integer
+        Public flags As Integer
+        Public time As Integer
+        Public dwExtraInfo As Integer
+    End Class
+
+    'マウス操作の種類を表す。
+    Public Enum MouseMessage
+        'マウスカーソルが移動した。
+        Move = &H200
+        '左ボタンが押された。
+        LDown = &H201
+        '左ボタンが解放された。
+        LUp = &H202
+        '右ボタンが押された。
+        RDown = &H204
+        '左ボタンが解放された。
+        RUp = &H205
+        '中ボタンが押された。
+        MDown = &H207
+        '中ボタンが解放された。
+        MUp = &H208
+        'ホイールが回転した。
+        Wheel = &H20A
+        'Xボタンが押された。
+        XDown = &H20B
+        'Xボタンが解放された。
+        XUp = &H20C
+    End Enum
+
+
+    Public Event MouseHook(sender As Object, e As MouseHookEventArgs)
+    Public Class MouseHookEventArgs
+        Inherits EventArgs
+
+        Private _mousestatus As MouseLLHookStruct
+        Private _mousemessage As MouseMessage
+        Public Sub New(mousemessage As MouseMessage, mousestatus As MouseLLHookStruct)
+            _mousemessage = mousemessage
+            _mousestatus = mousestatus
+        End Sub
+
+        ''' <summary>
+        ''' マウスカーソルの位置（スクリーン座標）
+        ''' </summary>
+        Public ReadOnly Property Point As Point
+            Get
+                Return _mousestatus.pt
+            End Get
+        End Property
+
+        ''' <summary>
+        ''' マウスの状態
+        ''' </summary>
+        Public ReadOnly Property Message As MouseMessage
+            Get
+                Return _mousemessage
+            End Get
+        End Property
+    End Class
+
+
+    ''' <summary>
+    ''' 現在マウスをフックしているか返す
+    ''' </summary>
+    ''' <returns>False:フックしていない  True:フックしている</returns>
+    ''' <remarks></remarks>
+    Public ReadOnly Property Hooked As Boolean
+        Get
+            Return If(hHook = 0, False, True)
+        End Get
+    End Property
+
+    ''' <summary>
+    ''' マウスフックを開始する
+    ''' </summary>
+    ''' <returns>False:フックに失敗もしくはフック済み True:フックに成功</returns>
+    ''' <remarks></remarks>
+    Public Function MouseHookStart() As Boolean
+        If hHook.Equals(0) Then
+            'マウスフックを開始する
+            hookproc = AddressOf MouseLLHookProc
+            hHook = SetWindowsHookEx(WH_MOUSE_LL, hookproc, GetModuleHandle(CType(IntPtr.Zero, String)), 0)
+            If hHook.Equals(0) Then
+                Return False
+            Else
+                Return True
+            End If
+        Else
+            'マウスフックがすでに開始されている
+            Return False
+        End If
+
+    End Function
+
+    ''' <summary>
+    ''' マウスフックを終了する
+    ''' </summary>
+    ''' <returns>False:フック解除に失敗もしくはフックしていない True:フック解除に成功</returns>
+    ''' <remarks></remarks>
+    Public Function MouseHookEnd() As Boolean
+        If hHook.Equals(0) Then
+            'マウスフックが開始されていない
+            Return False
+        Else
+            'マウスフックを終了する
+            Dim ret As Boolean = UnhookWindowsHookEx(hHook)
+
+            If ret.Equals(False) Then
+                Return False
+            Else
+                hHook = 0
+                Return True
+            End If
+        End If
+
+    End Function
+
+    Private Function MouseLLHookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
+        Dim MyMouseHookStruct As New MouseLLHookStruct()
+
+        If nCode = 0 Then
+            MyMouseHookStruct = CType(Marshal.PtrToStructure(lParam, MyMouseHookStruct.GetType()), MouseLLHookStruct)
+            'イベントを発生させる
+            RaiseEvent MouseHook(Nothing, New MouseHookEventArgs(CType(wParam, MouseMessage), MyMouseHookStruct))
+        End If
+
+        Return CallNextHookEx(hHook, nCode, wParam, lParam)
+    End Function
+
+End Class
\ No newline at end of file