TenKeyCapture

Imports TenKeyShot.ClassMyCommon ''ClassMyConmonのプロパティ・メソッドを参照するためのImportsステートメント
Imports TenKeyShot.ClassConfig ''ClassConfigのプロパティ・メソッドを参照するためのImportsステートメント
Imports System.Runtime.InteropServices
Imports System.Text

''' <summary>メイン(スタートアップ)フォーム</summary>
Public Class FormMain
    Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
        (ByVal hwndParent As Integer, ByVal hwndChildAfter As Integer,
        ByVal lpszClass As String, ByVal lpszWindow As String) As Integer
    Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long '可視判定
    Public Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long 'キャプション取得
    Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 'オーナーフォームを指定してハンドル取得
    Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long '定数：オーナーフォームチェック用
    Public Const GW_OWNER = 4

    Public Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer

    <System.Runtime.InteropServices.DllImport("User32.dll")>
    Private Shared Function PrintWindow(ByVal hwnd As IntPtr, ByVal hDC As IntPtr, ByVal nFlags As Integer) As Boolean
    End Function

    Dim KeyboardHooker1 As New KeyboardHooker
    Shared Tcommand As String
    Public Shared CaptureProcess As Boolean = False
    Shared NowTime As Date = Now

    Private Sub FormMain_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        On Error Resume Next

        ''ウインドウポップアップ
        Me.Visible = True
        Me.WindowState = FormWindowState.Normal
        Me.TopMost = True

        Config.Save()

        Log.Put(TITLE + " 終了" + vbCrLf)
        Log.Save()

        AppClosingFlag = True

    End Sub

    ''' <summary>メイン(スタートアップ)フォームのロード</summary>
    ''' <param name="sender">イベントを発生させたオブジェクト</param>
    ''' <param name="e">イベントオプション</param>
    Private Sub FormMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ''多重起動チェック
        'Process.GetProcessesByName メソッド
        '指定したプロセス名を共有するリモートコンピュータ上の
        'すべてのプロセスリソースに関連付けます。
        Dim pn As String = Process.GetCurrentProcess.ProcessName 'Process.ProcessName プロパティ(プロセスの名前を取得します)
        If Process.GetProcessesByName(pn).GetUpperBound(0) > 0 Then
            ''多重起動しているならばエラーメッセージ表示して終了。
            MessageBox.Show("すでに起動しています。", TITLE + " エラーメッセージ",
                MessageBoxButtons.OK,
                MessageBoxIcon.Error)
            End
        End If

        frmMain = Me

        FormControlBoxCustomize(Me)

        Me.Text = TITLE + " " + VERSION

        Log = New ClassLog(TextBox4)

        NotifyIcon1.Text = TITLE + " " + VERSION
        NotifyIcon1.Visible = True

        Log.DebugPut("タスクトレイに登録しました。" + vbCrLf)
        Log.DebugPut("起動しました。" + vbCrLf)

        Button4.PerformClick()

        Config.Load()

        Popup()

        NowTime = Now

        System.IO.Directory.CreateDirectory(AppPath() & Format(NowTime, "yyMMdd") & "\")
    End Sub

    ''' <summary>「このプログラムについて」のボタンを押された時の処理</summary>
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        Log.Add("--------------------------------------------------------------------------" + vbCrLf)
        Log.Add(TITLE + " " + VERSION + vbCrLf)
        Log.Add(OPENING_MSG)
        Log.Add(vbCrLf)
        Log.DebugPut("DebugFlag=" + Format(Config.DebugFlag) + vbCrLf)
        Log.Add("--------------------------------------------------------------------------" + vbCrLf)
        Log.Put()
    End Sub

    ''' <summary>ログの表示クリアを行う</summary>
    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        Log.Clear()
    End Sub

    ''' <summary>プログラムの終了ボタンを押された。もしくはタスクトレイアイコンのメニューから Quit を選択された時の処理</summary>
    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click, QuitToolStripMenuItem.Click

        Log.Put("終了します。" + vbCrLf)
        Popup()
        AppClosingFlag = True
        WaitTickCount(1000)
        Me.Close() 'ここで　closingイベントが発生。
        End

    End Sub

    Private Sub Me_Resize() Handles Me.Resize
        '最小化時に、フォームを非表示にする
        If Me.WindowState = FormWindowState.Minimized Then
            Me.Visible = False

            ''トレイアイコンの状態を初期化する
            NotifyIcon1.Text = TITLE + " " + VERSION

        End If
    End Sub

    ''' <summary>メインウインドウのポップアップ</summary>
    ''' <remarks></remarks>
    Public Sub Popup()
        Me.Visible = True
        Me.WindowState = FormWindowState.Normal

        ''短時間かならずトップに表示。
        Me.TopMost = True
        WaitTickCount(100)
        Me.TopMost = False

        ''トレイアイコンの状態を初期化する
        NotifyIcon1.Text = TITLE + " " + VERSION

        ''最新ログを表示
        Log.Put()

    End Sub

    Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
        Popup()
    End Sub

    Private Sub MainToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MainToolStripMenuItem.Click
        Popup()
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        NowTime = Now
        Try
            'Log.Put("KeyCode = " & KeyCode)
            Select Case KeyCode
                Case 96
                    Tcommand = T0
                Case 97
                    Tcommand = T1
                Case 98
                    Tcommand = T2
                Case 99
                    Tcommand = T3
                Case 100
                    Tcommand = T4
                Case 101
                    Tcommand = T5
                Case 102
                    Tcommand = T6
                Case 103
                    Tcommand = T7
                Case 104
                    Tcommand = T8
                Case 105
                    Tcommand = T9
                Case 106
                    Tcommand = Tastah
                Case 107
                    Tcommand = Tplus
                Case 108
                    'なし
                Case 109
                    Tcommand = Tminus
                Case 110
                    Tcommand = Tdot
                Case 111
                    Tcommand = Tslash
            End Select
            If InStr(Tcommand, "[capture]") > 0 Then
                CaptureWindows()
            End If
            CSVsave()
            Beep()
        Catch

        End Try

        Timer1.Enabled = False

        WaitTickCount(50)
        CaptureProcess = False

    End Sub

    Private Sub CSVsave()
        Dim SaveString As String
        Using sw As New System.IO.StreamWriter(AppPath() & Format(NowTime, "yyMMdd") & "\" & Format(NowTime, "yyMMdd") & ".csv", True, System.Text.Encoding.GetEncoding("shift_jis"))
            If InStr(Tcommand, "[capture]") > 0 Then
                SaveString = Format(NowTime, "HH:mm:ss,") & Replace(Tcommand, "[capture]", "")
                sw.Write(vbCrLf & SaveString)
            Else
                SaveString = Tcommand
                sw.Write(SaveString)
            End If
        End Using
        Log.Put(SaveString)
    End Sub

    Private Sub CaptureWindows()

        System.IO.Directory.CreateDirectory(AppPath() & Format(NowTime, "yyMMMdd") & "\")
        'ウィンドウを列挙する
        EnumWindows(New EnumWindowsDelegate(AddressOf EnumWindowCallBack), IntPtr.Zero)

    End Sub

    Public Delegate Function EnumWindowsDelegate(hWnd As IntPtr,
        lparam As IntPtr) As Boolean

    <DllImport("user32.dll")>
    Public Shared Function EnumWindows(lpEnumFunc As EnumWindowsDelegate,
        lparam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function GetWindowText(hWnd As IntPtr,
        lpString As StringBuilder, nMaxCount As Integer) As Integer
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function GetWindowTextLength(hWnd As IntPtr) As Integer
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Private Shared Function GetClassName(hWnd As IntPtr,
        lpClassName As StringBuilder, nMaxCount As Integer) As Integer
    End Function

    <DllImport("user32")>
    Private Shared Function IsWindowVisible(ByVal hWnd As IntPtr) As Boolean
    End Function

    Private Shared Function EnumWindowCallBack(hWnd As IntPtr,
            lparam As IntPtr) As Boolean

        'visibleでないなら即リターン
        If (Not IsWindowVisible(hWnd)) Then
            Return True
        End If

        'ウィンドウのタイトルの長さが０以下なら即リターン
        Dim textLen As Integer = GetWindowTextLength(hWnd)
        If textLen <= 0 Then
            Return True
        End If

        'ウィンドウのタイトルを取得する
        Dim tsb As New StringBuilder(textLen + 1)
        GetWindowText(hWnd, tsb, tsb.Capacity)
        If (tsb.ToString().Length <= 0) Then
            Return True
        End If
        For Each str As String In ClassConfig.IgnoreWindowTitles
            If InStr(tsb.ToString, str) > 0 Then
                Log.Put("WindowTitle が " & str & " と一致したのでキャプチャ処理スキップ")
                Return True
            End If
        Next
        'ウィンドウのクラス名を取得する
        Dim csb As New StringBuilder(256)
        GetClassName(hWnd, csb, csb.Capacity)
        If (csb.ToString().Length <= 0) Then
            Return True
        End If

        Try
            Dim gWB As RECT
            If (Not hWnd.Equals(IntPtr.Zero)) Then
                GetWindowRect(hWnd, gWB)
                If (gWB.Right - gWB.Left) < 100 Or (gWB.Bottom - gWB.Top) < 100 Then
                    Return True
                End If
#if 0 then
                If gWB.Right < -100 Or gWB.Bottom < -100 Then
                    Return True
                End If
#end if
                'Log.Put("----------")
                'Log.Put("タイトル,ハンドル:" & tsb.ToString() & "_" & Hex(hWnd.ToInt64))
                'Log.Put("left,right,top,bottom:" & gWB.Left & "," & gWB.Right & "," & gWB.Top & "," & gWB.Bottom)

                Using img As New Bitmap(gWB.Right - gWB.Left, gWB.Bottom - gWB.Top)
                    Using memg As Graphics = Graphics.FromImage(img)
                        Dim dc As IntPtr = memg.GetHdc()

                        PrintWindow(hWnd, dc, 0)
                        memg.ReleaseHdc(dc)
                        If InStr(tsb.ToString, "mpc-hc") Then
                            img.Save(AppPath() & Format(NowTime, "yyMMdd") & "\" _
                                     & Format(NowTime, "yyMMdd_HHmmssfff") & "_" _
                                     & Split(Replace(Tcommand, "[capture]", ""), ",")(0) & "_" _
                                     & tsb.ToString() & "_" _
                                     & Microsoft.VisualBasic.Right("00000000" & Hex(hWnd.ToInt64), 8) _
                                     & ".jpg", Drawing.Imaging.ImageFormat.Jpeg)
                        Else
                            img.Save(AppPath() & Format(NowTime, "yyMMdd") & "\" _
                                     & Format(NowTime, "yyMMdd_HHmmssfff") & "_" _
                                     & Split(Replace(Tcommand, "[capture]", ""), ",")(0) & "_" _
                                     & tsb.ToString() & "_" _
                                     & Microsoft.VisualBasic.Right("00000000" & Hex(hWnd.ToInt64), 8) _
                                     & ".png", Drawing.Imaging.ImageFormat.Png)
                        End If
                    End Using
                End Using
            End If
        Catch
            'Log.Put("例外" & tsb.ToString)
        End Try

        Return True

    End Function

    Public Sub New()

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。

    End Sub

End Class