'---------------------------------------------------------------------- ' File: gplracemerge.vbs ' Version: 1.2 ' Desc: GPLRA で Export した、複数の REPORT の Race.html から、 ' レース結果(だけ)をマージして出力する。 ' Usage: 1. マージしたいレース結果のファイルをまとめて racemerge.vbs に ' ドロップする。以下の (a), (b), (c) をドロップできます。 ' (a)GPLRA で Export した REPORT の Race.html があるフォルダ ' (b)GPLRA で Export した REPORT の Race.html そのもの ' (c)GPLRA で Export した REPORT の Race.html から ' 順位出力内容を RACE RESULT (After n laps) の行からコピペ ' したテキストファイル ' 2. マージ結果は gplracemerge.vbs と同じフォルダに out.txt ' というテキストファイルで出力されます。 ' *テキストで以下の内容を周回数・タイム順に出力します。 ' 総合順位(サーバ内順位)、ドライバー名、チーム、車番、 ' 国籍、周回数、タイム、トップとの差、Problem ' *ドロップされたファイルがトラック/周回数が同じレース結果か ' どうか、本スクリプトでは考慮していません。 ' レースタイムの短い順、周回数の多い順、に並べるだけです。 ' Author: shutaro 2008/04/11 ' History: 1.0 2008/04/11 initial release ' 1.1 内部処理呼び出し小変更 ' リザルト格納配列の拡大 ' 1.2 2008/05/29 Diff修正, 結果からProblemは削除 '---------------------------------------------------------------------- Option Explicit Dim argv, shell, fso Dim stream Dim rec(200,60) 'rec(lapcount, record) -- MAX 200 LAPS x 60 DRIVERS!!! Dim reccount(200) Dim argc Dim LapsSet, racelaps Set shell = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set argv = WScript.Arguments argc = argv.Count LapsSet = False If argc > 0 Then Call GetFiles() Call SortRec() Else Call Usage() End If '---------------------------------------------------------------------- Sub Usage() Wscript.Echo("レース結果のファイルをドロップしてね") End Sub '---------------------------------------------------------------------- Sub GetFiles() Dim strPath, i i = 0 Do While(i < argc) If (fso.FileExists(argv(i))) Then strPath = argv(i) Else strPath = fso.BuildPath(argv(i), "Race.html") End If If (fso.FileExists(strPath)) Then Call GetFile(strPath) End If i = i + 1 Loop End Sub '---------------------------------------------------------------------- Sub GetFile(ByVal filepath) Dim strLine, strTrack, strTmp, i Set stream = fso.OpenTextFile(filepath) strLine = stream.ReadLine Do Until stream.AtEndOfStream If Left(strLine, 12) = "RACE RESULTS" Then If LapsSet = False Then strTmp = Mid(strLine, Len("RACE RESULTS (After ") + 1) strTmp = Left(strTmp, InStr(strTmp, "laps") - 2) racelaps = CInt(strTmp) For i = 0 To 200 '走破周回数ごとの、何名分記録を格納したかのカウンタクリア reccount(i) = 0 Next LapsSet = True End If Call GetResult() Exit Do End If strLine = stream.ReadLine Loop End Sub '---------------------------------------------------------------------- Sub GetResult() Dim strLine '読み飛ばし strLine = stream.ReadLine strLine = stream.ReadLine strLine = stream.ReadLine Do Until stream.AtEndOfStream Call StoreRec(strLine) strLine = stream.ReadLine If (Len(strLine) = 0) Then Exit Do End If Loop If (Len(strLine) > 0) Then Call StoreRec(strLine) End If End Sub '---------------------------------------------------------------------- Sub StoreRec(ByVal src) Dim pos, no, driver, team, nation, laps, time, diff, prob Dim lapcount pos = Left(src, 2) no = Mid(src, 5, 2) driver = Mid(src, 8,31) team = Mid(src, 40, 8) nation = Mid(src, 49,3) laps = Mid(src, 53,4) time = Mid(src, 58, 11) diff = Mid(src, 70, 10) prob = Mid(src, 80) lapcount = CInt(Trim(laps)) reccount(lapcount) = reccount(lapcount) + 1 'その周回数分として格納する記録をカウントアップ ' rec(lapcount, reccount(lapcount) - 1) = src ' 11 31 8 2 3 4 2 10 * rec(lapcount, reccount(lapcount) - 1) = time + driver + team + no + nation + laps + pos + diff + prob End Sub '---------------------------------------------------------------------- Sub SortRec() Dim sort, output Dim temp, buf, recs, laps, i, path Dim arr, first, toptime, min, sec, msec, toplaps, mytime, mydiff buf = "" For laps = 200 To 0 Step -1 If (reccount(laps) > 0) Then Set sort = shell.Exec("sort") For recs = 0 To reccount(laps) - 1 sort.StdIn.WriteLine rec(laps, recs) Next sort.StdIn.Close Do While sort.Status = 0 WScript.Sleep 500 Loop temp = sort.StdOut.ReadAll() 'lapsごとに出力 buf = buf + temp End If Next arr = Split(buf, Chr(10)) set output = fso.GetFile(Wscript.ScriptFullName) path = fso.BuildPath(fso.GetParentFolderName(output), "out.txt") Set output = fso.CreateTextFile(path) first = True For i = LBound(arr) To UBound(arr) If (arr(i) <> "") Then temp = arr(i) If (first = True) Then 'トップのタイムを保管＜Diff計算用 min = CInt(Trim(Left(temp, 3))) sec = CInt(Mid(temp, 5, 2)) msec = CInt(Mid(temp, 8, 3)) toptime = min * 60 + sec + (msec / 1000) toplaps = Mid(temp, 56, 4) Call PutHeader(output, toplaps) first = False End If buf = "" buf = buf + Right(" " + FormatNumber(i+1,0,0,0,0), 2) 'pos overall buf = buf + "(" + Mid(temp, 60, 2) + ") " 'pos server buf = buf + Mid(temp, 12, 31) + " " 'driver buf = buf + Mid(temp, 43, 8) + " " 'team buf = buf + Mid(temp, 51, 2) + " " 'no buf = buf + Mid(temp, 53, 3) + " " 'nation buf = buf + Mid(temp, 56, 4) + " " 'laps buf = buf + Left(temp, 11) + " " 'race time If (first = false) Then If ((Left(temp, 11) <> "DidNotStart") And (Mid(temp, 56, 4) = toplaps))Then min = CInt(Trim(Left(temp, 3))) sec = CInt(Mid(temp, 5, 2)) msec = CInt(Mid(temp, 8, 3)) mytime = (min * 60 + sec + (msec / 1000)) mydiff = mytime - toptime If (mytime = toptime) Then buf = buf + Space(10) + " " Else min = Fix(mydiff / 60) sec = Fix(mydiff) Mod 60 msec= ((mydiff * 1000) Mod 1000) / 1000 If (min > 0) Then buf = buf + Right(" " + CStr(min), 2) + "m" buf = buf + Right("0" + CStr(sec), 2) + "." Else buf = buf + Space(3) buf = buf + Right(" " + CStr(sec), 2) + "." End If buf = buf + Right(FormatNumber(msec, 3, -1, 0, 0), 3) + "s " End If Else 'lap マイナス出力 buf = buf + Right(Space(3) + CStr(toplaps - CInt(Trim(Mid(temp, 56, 4)))), 3) + " lap(s) " End If Else buf = buf + Space(10) + " " End If 'buf = buf + Mid(temp, 73) 'prob buf = buf + Chr(10) + Chr(13) output.Write(buf) End If Next output.Close shell.Run("""" & path & """") End Sub Sub PutHeader(output, ByVal laps) output.WriteLine("RACE RESULTS (After " + CStr(laps) + " laps)") output.WriteLine("") output.WriteLine("Pos Driver Team No Nat Laps Race Time Diff ") ' Problem") End Sub