読者です 読者をやめる 読者になる 読者になる

Future Convergence PRJ.

主にプログラミング関連で調べたことのメモ(趣味プログラムなので動作は保証しません)

スクフェス 自動ランキング取得(VB.NET)~画面キャプチャver.

スクフェスをPCでプレイする2~キーボードマッピングの追加 - Future Convergence PRJ.まで設定されていることを前提として、順位画面を自動でキャプチャするプログラムのメモ。


ソースは以下の通り。プログラムからキー入力して画面キャプチャ撮るだけの簡単なものなので、通信エラーなどのイレギュラーには一切対応できない。動かす前にBlue Stacksからスクフェスを起動してホーム画面まで行ってることが条件、起動してないと空振りします。このプログラムと同じ原理で、頑張れば一応は自動演奏させることも可能、大変だけど。

画像だとデータとして扱いにくいので、最終的にはパケットキャプチャから通信内容みて順位を取得する予定(⇒スクフェス 自動ランキング取得(VB.NET)~パケット取得ver. - Future Convergence PRJ.)。本当はBlue Stacksの操作を一切せず通信だけで順位取得したいけど、通信内容にブラックボックス部分があって無理っぽい。

Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Module LoveLiveEventRankCapture

    Private Const VK_HOME As Byte = AscW("H")
    Private Const VK_EVENT_PAGE As Byte = AscW("V")
    Private Const VK_RANK_PAGE As Byte = AscW("R")
    Private Const VK_RANK_CHANGE As Byte = AscW("J")
    Private Const VK_RANK_1 As Byte = AscW("S")
    Private Const VK_RANK_9000 As Byte = AscW("A")
    Private Const VK_RANK_45000 As Byte = AscW("B")

    Private Const CAPTURE_SAVE_DIR As String = "C:\test\"

    Sub Main()

        Dim bmp As New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
        Dim grap As Graphics = Graphics.FromImage(bmp)

        '一度自身のプロセスをアクティブにする
        '(これしないとタスクスケジューラで起動時にBlueStacksをアクティブにしてもこのプロセスのコンソールが前にかぶさる)
        Dim myPs As Process = Process.GetCurrentProcess
        Interaction.AppActivate(myPs.Id)
        Threading.Thread.Sleep(1000)

        'Blue Stacksのプロセスをアクティブにする
        Dim ps() As Process = Process.GetProcessesByName("HD-Frontend")
        If ps.Length > 0 Then
            ActiveWindow(ps(0).MainWindowHandle)
            Interaction.AppActivate(ps(0).Id)
        End If
        Threading.Thread.Sleep(5000)

        'ホームに移動
        TapKey(VK_HOME)
        Threading.Thread.Sleep(2000)
        'イベントページに移動
        TapKey(VK_EVENT_PAGE)
        Threading.Thread.Sleep(5000)
        'ランキングページに移動
        TapKey(VK_RANK_PAGE)
        Threading.Thread.Sleep(5000)
        '9000位のランキングに変更
        TapKey(VK_RANK_CHANGE)
        Threading.Thread.Sleep(5000)
        TapKey(VK_RANK_9000)
        Threading.Thread.Sleep(5000)
        '画面を保存する
        grap.CopyFromScreen(New Point(0, 0), New Point(0, 0), bmp.Size)
        bmp.Save(CAPTURE_SAVE_DIR & DateTime.Now.ToString("yyyyMMddhhmmss") & "_9000位.png", Imaging.ImageFormat.Png)
        '45000位のランキングに変更
        TapKey(VK_RANK_CHANGE)
        Threading.Thread.Sleep(5000)
        TapKey(VK_RANK_45000)
        Threading.Thread.Sleep(5000)
        '画面を保存する
        grap.CopyFromScreen(New Point(0, 0), New Point(0, 0), bmp.Size)
        bmp.Save(CAPTURE_SAVE_DIR & DateTime.Now.ToString("yyyyMMddhhmmss") & "_45000位.png", Imaging.ImageFormat.Png)
        Threading.Thread.Sleep(5000)

        grap.Dispose()

    End Sub

    'キーボードを押して離す
    Sub TapKey(ByVal key As Byte)
        win32api.keybd_event(key, 0, 0, 0)
        win32api.keybd_event(key, 0, 2, 0)
    End Sub

    Private Sub ActiveWindow(ByVal hWnd As IntPtr)
        SwitchToThisWindow(hWnd, True)
    End Sub

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Sub SwitchToThisWindow(ByVal hWnd As IntPtr, ByVal fAltTab As Boolean)
    End Sub

End Module

Class win32api
    Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
End Class