Stoic Sounds 元はExtroseが運営する個人サイト名

プロフィール

顔写真(V)

Extrose
2002年頃から電脳海にいる。 制作ペースは激減したものの今でも現役の作曲者(自称)であり、機会があればBMSも作る。 が、最近はVを被ってゲーム実況に勤しんでいる。 興味があるものになんでも手を出すのでかなりの趣味を抱えている。

柊 雷夜
ユーチューブ地方で見かけるVのすがた (↑)。 たまに VRChat にも出る。 VRoid Studio 製。

リリース

個人活動

読み物

Stepmania パッケージ「Panzer Force」 - PF5thについていた独自プログラムについて Part.1

なんとなく語ってみよう

インスパイア元がある

D-Music Garden という、DTXMania 向けのパッケージにて、スコアとかプレイ状況を基に曲を解禁する、というプログラムが付属していた
今はもう公開されていない様子、曲だけは Youtube にて確認できる

ちなみに DTXMania は BMS の GFdm版みたいなもの

画面
画面

クライアント側

        Dim Thr As Threading.Thread
        LogWrite("アプリケーション起動")
        Me.Hide()
        frmSplash.Show()
        frmSplash.Activate()
        LogWrite("スプラッシュスクリーン表示")
        ChDrive(Application.ExecutablePath)
        ChDir(System.IO.Path.GetDirectoryName(Application.ExecutablePath))
        LogWrite("カレントパス変更 : " & Application.ExecutablePath)
        Me.Text = ProgramTitle

        'フリーズか動作しているかを判断できるようにする為、別スレッドで命令実行。
        'スプラッシュスクリーンにプログレスバーのMarqueeを設置しているので分かるようになっている。
        Thr = New Threading.Thread(New Threading.ThreadStart(AddressOf LoadConf))
        Thr.Start()
        While (Thr.ThreadState <> Threading.ThreadState.Stopped) : Application.DoEvents() : End While
        LogWrite("config.iniロード")

        Thr = New Threading.Thread(New Threading.ThreadStart(AddressOf GetDateFromServer))
        Thr.Start()
        While (Thr.ThreadState <> Threading.ThreadState.Stopped) : Application.DoEvents() : End While
        LogWrite("サーバーから時刻取得処理完了")


        Thr = New Threading.Thread(New Threading.ThreadStart(AddressOf SystemInit))
        Thr.Start()
        While (Thr.ThreadState <> Threading.ThreadState.Stopped) : Application.DoEvents() : End While
        LogWrite("初期化完了")

        'stepmania.ini書き換え用
        ChangeStepmaniaIni()

        'FormThreadInvoked.vb : スレッドからだとコントロールを操作できないらしいので、別メソッドで実施。
        '                       ただし、ViewInitは丸ごと移動。(全体がフォーム操作の為。)
        SetControlValue()

        Label1.Text = "プレイ回数：" & ScoreTotal.Totalplay.ToString & vbCrLf & _
                      "RP：" & RP.ToString & vbCrLf & _
                      "スコア合計(値)：" & ScoreTotal.Score.ToString & vbCrLf & _
                      "スコア合計(パーセント合算)：" & ScoreTotal.Percent.ToString
        LogWrite("ラベル変更")
        If System.IO.File.Exists(".\..\update.txt") Then
            Dim Sr As New System.IO.StreamReader(".\..\update.txt", System.Text.Encoding.GetEncoding(932))
            While (Sr.EndOfStream = False)
                TextBox1.Text = TextBox1.Text & Sr.ReadLine & vbCrLf
            End While
            Sr.Close()
        End If
        LogWrite("アップデート内容[update.txt]のロード完了")
        frmSplash.Hide()
        LogWrite("スプラッシュスクリーン消去")
        Me.Show()
        Me.Activate()
        LogWrite("メインフォーム表示")

よくもまあここまで
IRはサーバーの接続していたので、サーバーへの接続も最初に処理していた
今はサーバーは無いので、プログラム持っている人は起動しても繋がらない

VBではこういうのを同期処理するとプログラムがフリーズしたような動作になるのだが、
その問題に取り組んでマルチスレッド化をしていたという

画面

初期処理が終わったら画面に状況とか、アップデート内容とかを出していた 

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IRSend.Click
        LogWrite("IR送信開始")
        If xUserID.Text = "" Or xUserPW.Text = "" Then
            LogWrite("中断 [IDまたはPWが空白]")
            MsgBox("ID、または、パスワードが空白です。任意の文字を入力してください。", MsgBoxStyle.Critical)
            Exit Sub
        End If
        'If xUserID.Text = xUserPW.Text Then
        'Select Case xUserID.Text
        '   Case "extrose"
        'UnlockEx_Extrose()
        'Exit Sub
        '    Case "deplorer"
        'UnlockEx_Deplorer()
        'Exit Sub
        '    Case "xenothium"
        'UnlockEx_xenothium()
        'Exit Sub
        '    Case "taqumi"
        'UnlockEx_taqumi()
        'Exit Sub
        '    Case "gmtn"
        'UnlockEx_gmtn()
        'Exit Sub
        'End Select
        'MsgBox("IDと同一のパスワードは使用できません。", MsgBoxStyle.Critical)
        'Exit Sub
        'End If

        NetworkMakeSendmessage.UserID = xUserID.Text
        NetworkMakeSendmessage.UserPW = xUserPW.Text
        Try
            LogWrite("送信開始")
            NetworkMakeSendmessage.MakedataAndSendNew()
        Catch ex As Exception
            LogWrite("接続に失敗 詳細は下記に記載")
            LogWrite(ex.Message)
            MsgBox("IRへの送信に失敗しました。ネットワークの接続を確認するか、サーバーの稼動状況を確認してください。", MsgBoxStyle.Critical)
        End Try
    End Sub

大暴露(笑)
スタッフ用プログラムにはIDがそれなら解禁する、という仕組みを用意してあった

IRは実際にネットワークに接続して通信する
サーバー側は後述 

        For I As Integer = 0 To SkinData.Count - 1 Step 1
            If SkinData(I).Param = SkinParam Then
                If File.Exists(".\..\data\other\" & SkinData(I).ID & ".csa") Then
                    PFA.Unarchive(".\..\data\other\" & SkinData(I).ID & ".csa")
                Else
                    MsgBox("ファイル """ & SkinData(I).ID & ".csa"" からデータを読み出すことができません。置き換えは行われません。", MsgBoxStyle.Critical)
                End If
            End If
        Next
        For I As Integer = 0 To BGMData.Count - 1 Step 1
            If BGMData(I).Param = BgmParam Then
                If File.Exists(".\..\data\other\" & BGMData(I).ID & ".csa") Then
                    PFA.Unarchive(".\..\data\other\" & BGMData(I).ID & ".csa")
                Else
                    MsgBox("ファイル """ & BGMData(I).ID & ".csa"" からデータを読み出すことができません。置き換えは行われません。", MsgBoxStyle.Critical)
                End If
            End If
        Next
        MsgBox("スキンを変更しました。", MsgBoxStyle.Information)

こちらはスキンチェンジの様子
同フォルダにある data/other にある csa アーカイブを解凍する

xenothiumからは「csaファイルって何者なん？解析しようとしてもできなかった(当時)」と言われたことがあるので、じゃあその仕組みを公開 


    Private Const SplitChar As String = Chr(24) & Chr(40) & Chr(24) & Chr(90) & Chr(19) & Chr(33) & Chr(47) & Chr(121)

    'Mode=0 : ファイルが存在していない場合でも解凍  / Mode=1 : ファイルが存在していない場合、解凍しない
    Private Structure ByteLine
        Dim Fn As Byte()
        Dim Bt As Byte()
        Dim Md As Byte()
    End Structure
    Dim Bl(200) As ByteLine
    
    Public Sub Archive(ByVal Source As String(), ByVal UnarchivePass As String(), ByVal Mode As String(), ByVal Destination As String)

        'Blの再定義
        ReDim Bl(UBound(Source))

        'Blへバイト単位で情報を格納
        For I As Integer = 0 To UBound(Source) Step 1
            If File.Exists(Source(I)) = False Then Exit For
            Dim Gb As New FileStream(Source(I), FileMode.Open, FileAccess.Read)
            ReDim Bl(I).Bt(CInt(Gb.Length) - 1)
            Gb.Read(Bl(I).Bt, 0, Bl(I).Bt.Length)
            Gb.Close()
            Bl(I).Fn = Encoding.UTF8.GetBytes(UnarchivePass(I))
            Bl(I).Md = Encoding.UTF8.GetBytes(Mode(I))
        Next

        '文字変換
        For I As Integer = 0 To UBound(Bl) Step 1
            If Bl(I).Fn Is Nothing Then Exit For
            Bl(I).Bt = EncodeCode(Bl(I).Bt)
            Bl(I).Fn = EncodeCode(Bl(I).Fn)
            Bl(I).Md = EncodeCode(Bl(I).Md)
        Next

        '書き出し
        Dim Scb() As Byte = EncodeCode(Encoding.UTF8.GetBytes(SplitChar))

        Dim Sw As New FileStream(Destination, FileMode.Create, FileAccess.Write)
        For I As Integer = 0 To UBound(Bl) Step 1
            If Bl(I).Fn Is Nothing Then Exit For
            Sw.Write(Scb, 0, Scb.Length)
            Sw.Write(Bl(I).Md, 0, Bl(I).Md.Length)
            Sw.Write(Scb, 0, Scb.Length)
            Sw.Write(Bl(I).Fn, 0, Bl(I).Fn.Length)
            Sw.Write(Scb, 0, Scb.Length)
            Sw.Write(Bl(I).Bt, 0, Bl(I).Bt.Length)
        Next
        Sw.Write(Scb, 0, Scb.Length)
        Sw.Close()
    End Sub

    Private Function EncodeCode(ByVal Str As Byte()) As Byte()
        Dim Cl As Byte() = Str
        For I As Integer = 0 To UBound(Cl) Step 1
            Dim T As Integer = Cl(I)
            T += 57
            T = T Mod 256
            Cl(I) = CByte(T)
        Next I
        Return Cl
    End Function

Source はファイルのリスト
ファイルをバイト単位で読み込む構造を用意
ロジックに従い、最後はファイルに書き出す

こうしてみると単純なもので、ファイルを SplitChar で連結し、最後は全体を +57 しているのみ
シーザー暗号だかその辺と言うか
もし少しでもプログラムに精通しているなら、これを元にcsaファイルを分析できると思う

2011年頃はまだインターネットは平和な時期、この程度の暗号化でも、マイナーなプログラムならまあまあのプロテクトとなった様子
知っている限り解析はされなかった
今やるなら公開鍵暗号化方式で鍵はソースコードに置くとかだろうなあと思う

ちなみにこのクライアントプログラム側でアーカイブはできない
.vbソースコードを共通化しているだけだった

画面

で、スキンはこちら

フレームというのはプレイ画面のフレームのこと
多分4thmix の頃には曲別にフレームが変わるようにしてあったが、このプログラムで恒久的な変更ができる

画面

これがノーマル

画面

変更するとプレイ時のフレームが変わる

とまあまだまだいろいろ書けるなって思ったので、いったん区切る
気が向いたらPart.2を書こう