🐤⑪IPATGOXで照会・的中歴

2024年12月25日 04:38

'========================================================================================================
'
'   機能    指定されたIPATIDの購入状況を返す
'
'   引数    filepath：ipatgo.exeがあるパスを指定
'           IL      ：IPATログイン情報を指定
'           ST      ：購入状況情報の格納用
'
'   戻り値  0　　　 ：取得成功
'           0以外   ：取得失敗
'
'========================================================================================================
Function Get_Stat(ByVal filepath As String, ByRef IL As IpatLogin, ByRef St As StatInfo) As Long
Dim obj As New IWshRuntimeLibrary.WshShell
Dim value As String * 256

' statモードで取得実行
    If obj.Run(filepath & "ipatgo.exe" & " " & _
                    "stat" & " " & _
                    IL.InetID & " " & _
                    IL.UserNo & " " & _
                    IL.PassNo & " " & _
                    IL.ParsNo, _
                    0, True) <> 0 Then
        Get_Stat = -1   '取得失敗
        Exit Function
    End If

' 更新されたstat.iniから値を取得
    Call GetPrivateProfileString("stat", "date", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.date = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "time", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.Time = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "total_vote_amount", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.total_vote_amount = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "total_repayment", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.total_repayment = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "daily_vote_amount", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.daily_vote_amount = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "daily_repayment", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.daily_repayment = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "limit_vote_amount", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.limit_vote_amount = Left$(value, InStr(1, value, vbNullChar) - 1)
    Call GetPrivateProfileString("stat", "limit_vote_count", vbNullString, value, Len(value), (filepath & "stat.ini"))
    St.limit_vote_count = Left$(value, InStr(1, value, vbNullChar) - 1)
    
    Get_Stat = 0   '取得成功

End Function
Sub 手動ipatgo照会()
Hand = 1
ipatgo照会
Hand = 0
End Sub
Sub ipatgo照会()


OSドライブ
IPatログin
   

If Get_Stat(OsGo, iplg, stin) = 0 Then
    If Val(stin.daily_vote_amount) > 0 Then
        E = Int(Val(stin.daily_repayment) / Val(stin.daily_vote_amount) * 1000) / 10
    Else
        E = 0
    End If
    'MsgBox ("取得年月日：" & stin.date & vbCrLf & _
    '        "取得時刻：" & stin.time & vbCrLf & _
    '        "累計購入金額：" & stin.total_vote_amount & vbCrLf & _
    '        "累計払戻金額：" & stin.total_repayment & vbCrLf & _
    '        "1日分購入金額：" & stin.daily_vote_amount & vbCrLf & _
    '        "1日分払戻金額：" & stin.daily_repayment & vbCrLf & _
    '        "購入限度額：" & stin.limit_vote_amount & vbCrLf & _
    '        "購入可能件数：" & stin.limit_vote_count)
    St1 = stin.date & " " & stin.Time & " " & vbCrLf & _
        "1日分購入金額：" & stin.daily_vote_amount & vbCrLf & _
        "1日分払戻金額：" & stin.daily_repayment & vbCrLf & _
        "1日分損益：" & Val(stin.daily_repayment) - Val(stin.daily_vote_amount) & vbCrLf & _
        "損益/100：" & Int((Val(stin.daily_repayment) - Val(stin.daily_vote_amount)) / 10) / 10 & vbCrLf & vbCrLf & _
        "1日分回収率：" & E & "%"
    Else
    St1 = "購入状況照会に失敗しました 時間外取得出来ない(海外競馬取得出来ない？)"
    
End If

Debug.Print (St1)

If Hand = 1 Then
    MsgBox (St1 & vbCrLf & "土曜夜の海外投票分含まれる")
Else
'    Sheets("収支").Cells(YBet, 1) = stin.date & " " & stin.Time '日付
'
'    Sheets("収支").Cells(YBet, 5) = Val(stin.daily_repayment) - Val(stin.daily_vote_amount) '1日分損益
'
'    Sheets("収支").Cells(YBet, 7) = stin.daily_vote_amount '1日分購入金額
'    Sheets("収支").Cells(YBet, 8) = stin.daily_repayment '日分払戻金額
'    Sheets("収支").Cells(YBet, 9) = E '1日分回収率
End If
    
    
End Sub



'========================================================================================================
'
'   機能    指定されたIPATIDのhistory購入状況を返す
'
'   引数    filepath：ipatgo.exeがあるパスを指定
'           IL      ：IPATログイン情報を指定
'           ST      ：購入状況情報の格納用
'
'   戻り値  0　　　 ：取得成功
'           0以外   ：取得失敗
'
'========================================================================================================
Function Get_history(ByVal filepath As String, ByRef IL As IpatLogin, ByRef St As StatInfo) As Long
Dim obj As New IWshRuntimeLibrary.WshShell
Dim value As String * 256

'historyモードで取得実行?
    If obj.Run(filepath & "ipatgo.exe" & " " & _
                    "history" & " " & _
                    IL.InetID & " " & _
                    IL.UserNo & " " & _
                    IL.PassNo & " " & _
                    IL.ParsNo, _
                    0, True) <> 0 Then
        Get_history = -1   '取得失敗
        Exit Function
    End If

' 更新されたhistory.iniから値を取得?
    
    Get_history = 0   '取得成功

End Function
Sub 手動ipatgo当日的中履歴()
Hand = 1
ipatgo当日的中履歴
Hand = 0
End Sub
Sub ipatgo当日的中履歴()

OSドライブ
IPatログin


If Hand = 1 Then
    St1 = "当日的中投票内容" & date
End If


If Get_history(OsGo, iplg, stin) = 0 Then

    '的中判定のコード 1:確定前 5:的中 6:外れ 7:返還　※これ以外の未知のコードが戻り値となる場合があります
    
    'receipt.csv'投票履歴一覧ファイル(照会内容,受付番号,受付時刻,件数,払戻額)
    'result.csv'投票履歴結果内容ファイル(1受付番号,2件番号,3レース,4馬券投票方式,5組番,6組数,7投票金額,8的中判定)
    
    Open OsGo & "result.csv" For Input As #1  'ダイアログファイルＯＰＥＮ
    
    Do Until EOF(1)
        Input #1, Gg(1), Gg(2), Gg(3), Gg(4), Gg(5), Gg(6), Gg(7), Gg(8)
        If Gg(8) = "5" Then
            If Hand = 1 Then
                St1 = St1 & vbCrLf & "受付番号:" & Gg(1) & " " & Gg(3) & Gg(4) & Gg(5) & " " & Gg(7) & "円"
            End If
        End If
    Loop
    
    Close #1
    St2 = St1
    Debug.Print (St2)
Else
    If Hand = 1 Then
        St2 = "当日履歴に失敗しました" '投票履歴無しも失敗
        Debug.Print ("Sub ipatgo当日履歴" & St2)
        
        問題発生
    End If
End If

If Hand = 1 Then
    MsgBox (St2 & vbCrLf & "土曜夜の海外投票分含まれない")
Else
'    Sheets("収支").Cells(YBet, 6) = HitBet
'    Sheets("収支").Cells(YBet, 10) = St1
End If

End Sub
競馬でプログラムの作成
お疲れ様でした😎
いいなと思ったら応援しよう！

応援あれば、とっても嬉しいです😁