

タイトルの通り、radikoを録音するためにplayer.swfからswfextract.exeを用いてauthkey.pngを取得したいのですが、失敗してしまいます。

<https://gist.github.com/booska/8861693> を参考にしています。

[code]

    'rtmpdumpでRadikoを録音するWSH
    '
    ' 起動書式例(名前無し引数)  cscript RadikoRec.vbs TBS 1:32:00 "c:\Documents and Settings\user\My Documents\Radiko\" 菊地成孔の粋な夜電波
    ' 起動書式例(名前付き引数)  cscript RadikoRec.vbs /i:TBS /t:1:32:00 /d:"c:\Documents and Settings\user\My Documents\Radiko\" /o:菊地成孔の粋な夜電波
    '　　※詳しくは、コマンドラインの引数取得の箇所を参照のこと
    
    Option Explicit
    Dim i
    
    'タスクスケジューラで休止モードから復帰させた場合に、必要に応じてNet接続までのマージン確保（通常はコメントアウト）
    'WScript.Sleep(1000 * 5)    'スリープさせる秒数は環境により調整が必要
    
    'コマンドラインの引数を取得（名前付き引数が優先）
    Dim argStation,argRecTime,argDirectory,argOut,argSleep,argDebug,argSilent,argMail,argSendTo,argSMTP
    argStation = "QRR"              '引数１(i)：radiko.jp内の放送局のid
    argRecTime = "00:30:00"         '引数２(t)：録音時間をhh:mm:ssの形式で指定する。（前後のマージンを考慮して多く指定する）
    argDirectory = "rec\"               '引数３(d)：保存するホルダへのファイルパス　※例「c:\temp\radiko\」最後の「\」マークを忘れずに
    argOut = "out"              '引数４(o)：録音ファイル名
    argSleep = "no"             '引数５(s)：録音後にスリープさせるなら“yes”
    argDebug = "yes"                '引数(deb)：“yes”なら、動作の途中経過を逐次表示する
    argSilent = "yes"               '引数(cilent)："yes"なら、外部コマンドであるwgetやrtmpdumpの実行プロンプトを表示しない
    argMail = "no"                  '引数(mail)："yes"なら録音完了をメールで通知する。"att"なら録音ファイルを添付いたメールで送信する。なお大きなファイル添付は受信できない環境が多々有り、実用的ではないので注意のこと。
    argSendTo = ""              '引数(sendto)：メール通知する宛先　ex. hogehoge@hogehoge.jp
    argSMTP = ""                    '引数(smtp)："メールボックスがあるSMTPサーバー　ex. hogehoge.jp
    Dim aNamed, aUnnamed
    Set aNamed = WScript.Arguments.Named
    Set aUnnamed = WScript.Arguments.Unnamed
    If aUnnamed.Count > 0 Then
        For i = 0 To aUnnamed.Count - 1
            Select Case i
                Case 0
                    argStation = aUnnamed.Item(i)
                Case 1
                    argRecTime = aUnnamed.Item(i)
                Case 2
                    argDirectory = aUnnamed.Item(i)
                Case 3
                    argOut = aUnnamed.Item(i)
                Case 4
                    argSleep = aUnnamed.Item(i)
            End Select
        Next
    End If
    If aNamed.Exists("i") Then  argStation = aNamed.Item("i")
    If aNamed.Exists("t") Then  argRecTime = aNamed.Item("t")
    If aNamed.Exists("d") Then  argDirectory = aNamed.Item("d")
    If aNamed.Exists("o") Then  argOut = aNamed.Item("o")
    If aNamed.Exists("s") Then  argSleep = LCase(aNamed.Item("s"))
    If aNamed.Exists("deb") Then    argDebug = LCase(aNamed.Item("deb"))
    If aNamed.Exists("silent") Then argSilent = LCase(aNamed.Item("silent"))
    If aNamed.Exists("mail") Then   argMail = LCase(aNamed.Item("mail"))
    If aNamed.Exists("sendto") Then argSendTo = LCase(aNamed.Item("sendto"))
    If aNamed.Exists("smtp") Then   argSMTP = LCase(aNamed.Item("smtp"))
    
    'メール通知の引数チェック
    If argMail = "yes" or argMail = "att" Then
        If argSendTo = "" Then
            WScript.Echo "　注意：メール宛先が指定されていない為、メール通知をオフにしました。"
            argMail = "no"
        End If
        If argSMTP = "" Then
            WScript.Echo "　注意：メール送信先のSMTPサーバーが指定されていない為、メール通知をオフにしました。"
            argMail = "no"
        End If
    End If
    
    WScript.Echo "「" & argStation & "」の「" & argOut & "」を録音開始、録音時間は「" & argRecTime & "」"
    
    'シェル起動オブジェクトを生成
    Dim WSHShell,gShellStyle
    Set WSHShell = WScript.CreateObject("WScript.Shell")
    If argSilent = "yes" Then
        gShellStyle = 7
    Else
        gShellStyle = 10
    End IF
    
    'ファイルシステム用オブジェクトを生成（ラジコ独自認証でファイルを利用）
    Dim WSHFS
    Set WSHFS = CreateObject("Scripting.FileSystemObject")
    
    '引数で指定の録音時間を日時属性に変換
    dim gRecTime
    gRecTime = TimeValue(argRecTime)
    
    '録音終了日時を求める
    Dim gEndDate
    gEndDate = Now() + gRecTime
    
    'ワーク変数あれこれ
    Dim gAns        '戻り値を拾う
    Dim gWeekdays
    gWeekdays = Array("(日)", "(月)", "(火)", "(水)", "(木)", "(金)", "(土)")  '曜日のコンスタント値
    Dim lngWeekday      '今日の曜日インデックス
    Dim strNow          'ファイル名とする日時文字列
    Dim strSuffix           'ファイル名の接尾文字列
    Dim gRecSecond      '録音時間を総秒数に変換した値
    Dim strCmd          'rtmpdumpを起動するコマンドライン文字列
    Dim MaxRetry
    MaxRetry = 2            'リトライ回数制限値（リトライ回数がこれを超えたらギブアップ）　※常識的な回数以下にしないと、大迷惑になるので注意の事！
    Dim CtrRetry
    CtrRetry = 0            'リトライ回数カウンター
    Dim IntervalRetry
    IntervalRetry = 3       'リトライまでのインターバル基数で、このインターバル基数×リトライ回数で、リトライまでのインターバルを徐々に長して、少し長い通信途絶におけるリトライ無駄撃ちを軽減している。　※２未満の指定は大迷惑なので厳禁！
    Dim pFileName           '録音保存するファイル名
    Dim aryOutFiles()       '保存した録音ファイル名の配列、リトライがなければ１ファイルのみ
    Dim aryOutCtr           '録音したファイルカウントで、リトライがなければZero
    aryOutCtr = 0
    Do
        '録音秒数をrtmpdumpの引数形式(秒数)にする
        gRecTime = gEndDate - Now()
        gRecSecond = Hour(gRecTime) * 60 * 60 + Minute(gRecTime) * 60 + Second(gRecTime) + 20   '20秒ほどマージンを設けることで録音終了時の誤差でリトライにいってしまうことを防止する。
        '現在の曜日インデックスを求める
        lngWeekday = Weekday(Now) -1
        'ファイル名のプレフィックス（日時文字列）付きで編集
        strNow = Year(Now) & "年" & Right("0" & Month(Now), 2) & "月" & Right("0" & Day(Now), 2) & "日" & gWeekdays(lngWeekday) & Right("0" & Hour(Now), 2) & "時" & Right("0" & Minute(Now), 2) & "分 "
        If CtrRetry > 0 Then
            strSuffix = argOut & "~" & Right("000" & CtrRetry, 3)       '１分以内にリトライが発生するとファイル名が重複するのでリトライ回数もファイル名に含める
        Else
            strSuffix = argOut
        End If
        '起動するrtmpdumpのコマンドラインを編集
        pFileName = argDirectory & strNow & strSuffix & ".flv"
        strCmd = GetRadikoCmd(pFileName)
        If Left(strCmd, 5) = "error" Then
            WScript.Echo strCmd
        Else
            'rtmpdumpを起動して録音を開始する
            If argDebug = "yes" Then WScript.Echo strCmd
            WSHShell.Run strCmd,gShellStyle,True
        End If
        '録音したファイル名を記録
        if WSHFS.FileExists(pFileName) = True Then
            ReDim Preserve aryOutFiles(aryOutCtr)
            aryOutFiles(aryOutCtr) = pFileName
            aryOutCtr = aryOutCtr + 1
            WScript.Echo "warning : 録音ファイル名「" & pFileName & "」が出力されました。"
        Else
            WScript.Echo "warning : 録音ファイル名「" & pFileName & "」は出力されませんでした！"
        End If
        '録音終了の判断
        If Now() >= gEndDate Then Exit Do       '予定録音時間まで録音できたので完了
        CtrRetry = CtrRetry + 1
        If CtrRetry > MaxRetry Then
            gAns = MsgBox("abend : リトライ回数制限に達したので録音を中断！", 48, "☆録音ギブアップ☆")
            WScript.Quit(1)     'トライ回数制限を超えたら諦める
        End If
        WScript.Sleep(1000 * (IntervalRetry * CtrRetry))    'リトライ・インターバルを増やし行くのは通信途絶が長くなった場合に必要な配慮
        WScript.Echo "warning : " & Right("000" & CtrRetry, 3) & "回目のリトライが発生！"
    Loop
    If argMail = "yes" or argMail = "att" Then  call SendMail()     '録音完了をメールで通知する。
    
    'パソコンを休止にする。 ※全ての環境で動作するか、ちょっと怪しい
    If argSleep = "yes" Then
        WSHShell.Run "%windir%\System32\rundll32.exe powrprof.dll,SetSuspendState",,False
    End If
    WScript.Quit(0)
    
    'Radiko.jpの独自認証を行い、録音用のrtmpdumpのコマンドラインを生成する
    Function GetRadikoCmd(aOutPath)
    
        Dim playerurl,pSwfPlayer,pKeyFile,RtnCD,auth1_fms,auth2_fms
        playerurl = "http://radiko.jp/player/swf/player_4.0.0.00.swf"
        '同時複数起動でのファイル名バッティング対策で、重複しないテンポラリファイル名を生成する
        Dim pTmpName
        pTmpName = WSHFS.GetTempName()
        pSwfPlayer = "tmp\player_" & pTmpName & ".swf"
        pKeyFile = "tmp\authkey_" & pTmpName & ".png"
        auth1_fms = "tmp\auth1_fms_" & pTmpName
        auth2_fms = "tmp\auth2_fms_" & pTmpName
    
        '認証ステップ１：Radikoのswfプレイヤーをplayer.swfというファイル名でダウンロード
        RtnCD = WSHShell.run("bin\wget.exe -q -o """ & pSwfPlayer & """ """ & playerurl & """",gShellStyle,True)
        If RtnCD <> 0 Then
            GetRadikoCmd = "error 認証ステップ１：player.swfの取得失敗！"
            Exit Function
        Else
            If argDebug = "yes" Then WScript.Echo "認証ステップ１：player.swfの取得成功"
        End If
    
        '認証ステップ２：player.swfからauthkey.pngを抜き出す
        RtnCD = WSHShell.run("bin\swftools\swfextract.exe" & " -b 14 """ & pSwfPlayer & """ -o """ & pKeyFile & """",gShellStyle,True)
        If RtnCD <> 0 Then
            GetRadikoCmd = "error 認証ステップ２：authkey.pngの抜き出し失敗！"
            Exit Function
        Else
            If argDebug = "yes" Then WScript.Echo "認証ステップ２：authkey.pngの抜き出し成功"
        End If
    
        '認証ステップ３：auth1_fmsを取得
        RtnCD = WSHShell.run("bin\wget.exe -q" _
                & " --header=""pragma: no-cache""" _
                & " --header=""X-Radiko-App: pc_1""" _
                & " --header=""X-Radiko-App-Version: 2.0.1""" _
                & " --header=""X-Radiko-User: test-stream""" _
                & " --header=""X-Radiko-Device: pc""" _
                & " --post-data=""\r\n""" _
                & " --no-check-certificate" _
                & " --save-headers https://radiko.jp/v2/api/auth1_fms" _
                & " -O """ & auth1_fms & """",gShellStyle,True)
        If RtnCD <> 0 Then
            GetRadikoCmd = "error 認証ステップ３：auth1_fmsファイルの取得失敗！"
            Exit Function
        Else
            If argDebug = "yes" Then WScript.Echo "認証ステップ３：auth1_fmsファイルの取得成功"
        End If
    
        '認証ステップ４：auth1_fmsから、authtoken,length,offsetを読み取る
        Dim pFile
        Dim pLine
        Dim pAuthtoken,pLength,pOffset
        Set pFile = WSHFS.OpenTextFile(auth1_fms,1)
        Do While pFile.AtEndOfStream = False
            pLine = pFile.ReadLine
            If InStr(LCase(pLine),"x-radiko-authtoken=") <> 0 Then
                pAuthtoken = mid(pLine,InStr(pLine,"=")+1,len(pLine)-InStr(pLine,"="))
            ElseIf InStr(LCase(pLine),"x-radiko-keylength=") <> 0 Then
                pLength = mid(pLine,InStr(pLine,"=")+1,len(pLine)-InStr(pLine,"="))
            ElseIf InStr(LCase(pLine),"x-radiko-keyoffset=") <> 0 Then
                pOffset = mid(pLine,InStr(pLine,"=")+1,len(pLine)-InStr(pLine,"="))
            End If
        Loop
        pFile.Close
    
        If argDebug = "yes" Then WScript.Echo "認証ステップ４：x-radiko-authtoken=" & pAuthtoken & " ,x-radiko-keylength=" & pLength & " ,x-radiko-keyoffset=" & pOffset
    
        '認証ステップ５：authkey.pngのoffsetのlengthの内容から、base64の値であるpartialkeyを求める
        Dim pXmldom,pB64,pStream,partialkey
    
        Set pXmldom = CreateObject("Microsoft.XMLDOM")
        Set pB64 = pXmldom.CreateElement("work")
        pB64.DataType = "bin.base64"
    
        Set pStream = CreateObject("ADODB.Stream")
        pStream.Type = 1
        pStream.Open
        pStream.LoadFromFile pKeyFile
        pStream.position = pOffset
        pB64.NodeTypedValue = pStream.Read(pLength)
    
        partialkey = pB64.Text
        pStream.Close
        Set pStream = Nothing
    
        If argDebug = "yes" Then WScript.Echo "認証ステップ５：partialkey=" & partialkey
    
        '認証ステップ６：上記で求めたキーからauthtokenとpartialkeyをradikoに送り認証を成立させる
        Dim key
        RtnCD = WSHShell.run("bin\wget.exe -q" _
                & " --header=""pragma: no-cache""" _
                & " --header=""X-Radiko-App: pc_1""" _
                & " --header=""X-Radiko-App-Version: 2.0.1""" _
                & " --header=""X-Radiko-User: test-stream""" _
                & " --header=""X-Radiko-Device: pc""" _
                & " --header=""X-Radiko-Authtoken: " & pAuthtoken & """"_
                & " --header=""X-Radiko-Partialkey: " & partialkey & """"_
                & " --post-data=""\r\n""" _
                & " --no-check-certificate" _
                & " https://radiko.jp/v2/api/auth2_fms" _
                & " -O """ & auth2_fms & """",gShellStyle,True)
        If RtnCD <> 0 Then
            GetRadikoCmd = "error 認証ステップ６：authtokenとpartialkeyの失敗！"
            Exit Function
        Else
            If argDebug = "yes" Then WScript.Echo "認証ステップ６：authtokenとpartialkeyの送信成功"
        End If
    
        '録音の為のrtmpdumpのコマンドラインを返す
        GetRadikoCmd = "bin\rtmpdump.exe -v " _
            & " --stop " & gRecSecond _
            & " -r ""rtmpe://f-radiko.smartstream.ne.jp""" _
            & " --playpath ""simul-stream.stream""" _
            & " --app """ & argStation & "/_definst_""" _
            & " -W " & playerurl _
            & " -C S:"""" -C S:"""" -C S:"""" -C S:" & pAuthtoken _
            & " --live" _
            & " --flv """ & aOutPath & """"
    
        'テンポラリファイルを消す
        If argDebug <> "yes" Then
            WSHFS.DeleteFile pSwfPlayer, True
            WSHFS.DeleteFile pKeyFile, True
            WSHFS.DeleteFile auth1_fms, True
            WSHFS.DeleteFile auth2_fms, True
        End If
    
    End Function
    
    'メール通知（CDOでメール送信できる環境であることが前提、例えばHome Editionなどは使えないと思われる。ポート25が開いていないLANでも利用できない。）
    Function SendMail()
        Dim oMsg
        Dim pBody
        Dim pFileNm
        Dim oFile
        Set oMsg = CreateObject("CDO.Message")
        oMsg.From = argSendTo
        oMsg.To = argSendTo
        oMsg.Subject = "録音が完了しました。　放送局 : " & argStation & "　ファイル : " & argOut
        pBody = "録音が完了しました" & vbCrLf
        For Each pFileNm In aryOutFiles
            pBody = pBody & "録音ファイル名 : " & pFileNm & vbCrLf
            '録音したファイルを添付する（録音時間が長い場合に受信でるかは、送信先のSMTPサーバーの設定に依存する）
            If argMail = "att" Then
                Set oFile = WSHFS.GetFile(pFileNm)
                oMsg.AddAttachment(oFile.Path)      'フルパスじゃないと添付出来ない
            End If
        Next
        oMsg.TextBody = pBody
        oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = argSMTP
        oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        oMsg.Configuration.Fields.Update
        oMsg.Send
    End Function
    
[/code]

## 実行例

[code]

    PS C:\radiko> cscript radiko.vbs QRR 0:01:00 "rec\" qrrt
    Microsoft (R) Windows Script Host Version 5.8
    Copyright (C) Microsoft Corporation. All rights reserved.
    
    「QRR」の「qrrtest」を録音開始、録音時間は「0:01:00」
    認証ステップ１：player.swfの取得成功
    error 認証ステップ２：authkey.pngの抜き出し失敗！
    warning : 録音ファイル名「rec\2016年03月02日(水)12時06分 qrrtest.flv」は出力されませんでした！
    warning : 001回目のリトライが発生！
    認証ステップ１：player.swfの取得成功
    error 認証ステップ２：authkey.pngの抜き出し失敗！
    warning : 録音ファイル名「rec\2016年03月02日(水)12時06分 qrrtest~001.flv」は出力されませんでした！
    warning : 002回目のリトライが発生！
    認証ステップ１：player.swfの取得成功
    error 認証ステップ２：authkey.pngの抜き出し失敗！
    warning : 録音ファイル名「rec\2016年03月02日(水)12時06分 qrrtest~002.flv」は出力されませんでした！
    
[/code]

このように、authkey.pngの取得に失敗します。  
swfextract.exeは、bin/swftools/内にあります。

[code]

    RtnCD = WSHShell.run("bin\swftools\swfextract.exe" & " -b 14 """ & pSwfPlayer & """ -o """ & pKeyFile & """",gShellStyle,True)
    
[/code]

この部分で何かしら構文ミスがあるのか、そもそもswfextract.exeがちゃんと動いてないのか、原因が分からない状態です。

## 動作環境

windows8.1/64bit  
swftools-0.9.0  
Windows PowerShell

binフォルダ

[code]

    bin/
        swftools/swfextract.exe
        rtmpdump.exe
        wget.exe
        libeay32.dll
        libssl32.dll
    
[/code]


CC BY-SA 3.0
2016-03-02T03:41:07.847
22725
2016-03-02T09:39:51.630
2016-03-02T09:39:51.630
8000
14589
question
windows powershell vbs
radikoのplayer.swfからauthkey.pngを取得したい