'人鳳CSV整形クリップコピー Ver.2.0.0 '「人鳳」の出力CSVを、2ちゃんに貼り付けやすい形にするスクリプトです 'CSVの形式は「順位」「名前」「3得+」の3項目のみ対応しています 'Windows Vista 以降に対応してます Option Explicit Dim objWshShell Dim objFileSystem Dim objStream Dim strLine Dim arrFields Dim intLineCount '読み込み行位置 Dim intFieldSpace2 '「得点」の前につけるスペースの数 Dim strOutputText '出力文字列 Dim strClipTempPath 'クリップボードへコピーするテンポラリーファイルのパス Dim objClipTempFileHandle dim objCharWideNarrow '半角全角変換 If WScript.Arguments.Count = 0 Then Msgbox "CSVファイルをドロップして下さい。プログラムを終了します。", , "エラー" WScript.Quit End If 'CSVファイルを読み込み『「順位」「名前」「3得+」』形式の行を整形 Set objFileSystem = CreateObject("Scripting.FileSystemObject") Set objStream = objFileSystem.OpenTextFile(WScript.Arguments(0)) set objCharWideNarrow = New CharWideNarrow intLineCount = 0 Do Until objStream.AtEndOfStream strLine = objStream.ReadLine intLineCount = intLineCount + 1 arrFields = Split(strLine,",") If intLineCount = 1 Then '1行目の場合は見出しを出力する strOutputText = strOutputText _ & "順位   得点   プレーヤ名" & vbCrLf _ & "――――――――――――――――" & vbCrLf Else '順位を整形(CSVは1行目が見出し行となっている為"<="とする) If intLineCount <= 10 Then strOutputText = strOutputText & objCharWideNarrow.ToWideAll(arrFields(0),0) & "  " Else If intLineCount <= 100 Then strOutputText = strOutputText & objCharWideNarrow.ToWideAll(arrFields(0),0) & " " Else strOutputText = strOutputText & objCharWideNarrow.ToWideAll(arrFields(0),0) & " " End If End If '「点数」の前に付加するスペースを計算 intFieldSpace2 = 4 - len(arrFields(2)) strOutputText = strOutputText _ & objCharWideNarrow.ToWideAll(Space(intFieldSpace2) & arrFields(2),0) _ & ".0 " _ & arrFields(1) _ & vbCrLf End If Loop '半角スペース2文字を全角スペース1文字に変換 strOutputText = Replace(strOutputText, " ", " ") '「3得+」を「合計」に変換 strOutputText = Replace(strOutputText, "3得+", "合計") '結果をクリップボードへコピー 'VBSファイルフォルダに拡張子をtmpにしたファイルを作成しテキストを出力する strClipTempPath = Replace(WScript.ScriptFullName, "vbs", "tmp") Set objClipTempFileHandle = objFileSystem.OpenTextFile( strClipTempPath, 2, True ) objClipTempFileHandle.Write( strOutputText ) Call objClipTempFileHandle.Close() '出力したファイルの内容を"clip.exe"を使用しクリップボードにコピーする Set objWshShell = WScript.CreateObject("WScript.Shell") objWshShell.Run "cmd.exe /c clip < " & strClipTempPath, 0, TRUE 'tmpファイルを削除する objFileSystem.DeleteFile strClipTempPath, True objStream.Close Set objStream = Nothing Set objFileSystem = Nothing '文字列のバイト数算出 Function LenBEX(ByVal strText) Dim byteCount Dim index Dim strChr byteCount = 0 For index = 0 To Len(strText) - 1 strChr = Mid(strText, index + 1, 1) If (Asc(strChr) And &HFF00) = 0 Then byteCount = byteCount + 1 Else byteCount = byteCount + 2 End If Next LenBEX = byteCount End Function '文字変換クラス CharWideNarrow 'http://blog.livedoor.jp/midorityo/archives/51064633.html Class CharWideNarrow Dim widedicASCII, widedicANK, narrowdicASCII, narrowdicANK Dim x Private Sub Class_Initialize() 'コンストラクタ Set widedicASCII = CreateObject("Scripting.Dictionary") Set widedicANK = CreateObject("Scripting.Dictionary") Set narrowdicASCII = CreateObject("Scripting.Dictionary") Set narrowdicANK = CreateObject("Scripting.Dictionary") With narrowdicANK '表の作成 .Add "゜", "゚" .Add "゛", "゙" .Add "ヶ", "ケ" .Add "ヵ", "カ" .Add "ヴ", "ヴ" .Add "ン", "ン" .Add "ヲ", "ヲ" .Add "ヱ", "ウェ" .Add "ヰ", "ウィ" .Add "ワ", "ワ" .Add "ヮ", "ワ" .Add "ロ", "ロ" .Add "レ", "レ" .Add "ル", "ル" .Add "リ", "リ" .Add "ラ", "ラ" .Add "ヨ", "ヨ" .Add "ョ", "ョ" .Add "ユ", "ユ" .Add "ュ", "ュ" .Add "ヤ", "ヤ" .Add "ャ", "ャ" .Add "モ", "モ" .Add "メ", "メ" .Add "ム", "ム" .Add "ミ", "ミ" .Add "マ", "マ" .Add "ポ", "ポ" .Add "ボ", "ボ" .Add "ホ", "ホ" .Add "ペ", "ペ" .Add "ベ", "ベ" .Add "ヘ", "ヘ" .Add "プ", "プ" .Add "ブ", "ブ" .Add "フ", "フ" .Add "ピ", "ピ" .Add "ビ", "ビ" .Add "ヒ", "ヒ" .Add "パ", "パ" .Add "バ", "バ" .Add "ハ", "ハ" .Add "ノ", "ノ" .Add "ネ", "ネ" .Add "ヌ", "ヌ" .Add "ニ", "ニ" .Add "ナ", "ナ" .Add "ド", "ド" .Add "ト", "ト" .Add "デ", "デ" .Add "テ", "テ" .Add "ヅ", "ヅ" .Add "ツ", "ツ" .Add "ッ", "ッ" .Add "ヂ", "ヂ" .Add "チ", "チ" .Add "ダ", "ダ" .Add "タ", "タ" .Add "ゾ", "ゾ" .Add "ソ", "ソ" .Add "ゼ", "ゼ" .Add "セ", "セ" .Add "ズ", "ズ" .Add "ス", "ス" .Add "ジ", "ジ" .Add "シ", "シ" .Add "ザ", "ザ" .Add "サ", "サ" .Add "ゴ", "ゴ" .Add "コ", "コ" .Add "ゲ", "ゲ" .Add "ケ", "ケ" .Add "グ", "グ" .Add "ク", "ク" .Add "ギ", "ギ" .Add "キ", "キ" .Add "ガ", "ガ" .Add "カ", "カ" .Add "オ", "オ" .Add "ォ", "ォ" .Add "エ", "エ" .Add "ェ", "ェ" .Add "ウ", "ウ" .Add "ゥ", "ゥ" .Add "イ", "イ" .Add "ィ", "ィ" .Add "ア", "ア" .Add "ァ", "ァ" .Add "ー", "ー" .Add "・", "・" .Add "、", "、" .Add "」", "」" .Add "「", "「" .Add "。", "。" '逆引き表の作成 For Each x In .Keys If widedicANK.Exists( .Item(x) ) = False Then widedicANK.Add .Item(x), x End If Next End With With narrowdicASCII '表の作成 .Add "〜", "~" .Add "}", "}" .Add "|", "|" .Add "{", "{" .Add "z", "z" .Add "y", "y" .Add "x", "x" .Add "w", "w" .Add "v", "v" .Add "u", "u" .Add "t", "t" .Add "s", "s" .Add "r", "r" .Add "q", "q" .Add "p", "p" .Add "o", "o" .Add "n", "n" .Add "m", "m" .Add "l", "l" .Add "k", "k" .Add "j", "j" .Add "i", "i" .Add "h", "h" .Add "g", "g" .Add "f", "f" .Add "e", "e" .Add "d", "d" .Add "c", "c" .Add "b", "b" .Add "a", "a" .Add "‘", "`" .Add "_", "_" .Add "^", "^" .Add "]", "]" .Add "¥", "\" .Add "[", "[" .Add "Z", "Z" .Add "Y", "Y" .Add "X", "X" .Add "W", "W" .Add "V", "V" .Add "U", "U" .Add "T", "T" .Add "S", "S" .Add "R", "R" .Add "Q", "Q" .Add "P", "P" .Add "O", "O" .Add "N", "N" .Add "M", "M" .Add "L", "L" .Add "K", "K" .Add "J", "J" .Add "I", "I" .Add "H", "H" .Add "G", "G" .Add "F", "F" .Add "E", "E" .Add "D", "D" .Add "C", "C" .Add "B", "B" .Add "A", "A" .Add "@", "@" .Add "?", "?" .Add ">", ">" .Add "=", "=" .Add "<", "<" .Add ";", ";" .Add ":", ":" .Add "9", "9" .Add "8", "8" .Add "7", "7" .Add "6", "6" .Add "5", "5" .Add "4", "4" .Add "3", "3" .Add "2", "2" .Add "1", "1" .Add "0", "0" .Add "/", "/" .Add ".", "." .Add "−", "-" .Add ",", "," .Add "+", "+" .Add "*", "*" .Add ")", ")" .Add "(", "(" .Add "’", "'" .Add "&", "&" .Add "%", "%" .Add "$", "$" .Add "#", "#" .Add "”", """" .Add "!", "!" .Add " ", " " '逆引き表の作成 For Each x In .Keys widedicASCII.Add .Item(x), x Next End With End Sub Private Sub Class_Terminated() 'デストラクタ Set widedicASCII = Nothing Set widedicANK = Nothing Set narrowdicASCII = Nothing Set narrowdicANK = Nothing End Sub Function ToNarrowAll( byref str ) Dim rtn, max_, char_, trns_ Dim i rtn = "" max_ = len( str ) For i = 1 to max_ char_ = Mid( str,i,1 ) If narrowdicASCII.Exists( char_ ) Then trns_ = narrowdicASCII.Item( char_ ) Else If narrowdicANK.Exists( char_ ) Then trns_ = narrowdicANK.Item( char_ ) Else trns_ = char_ End If End If rtn = rtn & trns_ Next ToNarrowAll = rtn End Function Function ToNarrowASCII( byref str ) Dim rtn, max_, char_, trns_ Dim i rtn = "" max_ = len( str ) For i = 1 to max_ char_ = Mid( str,i,1 ) If narrowdicASCII.Exists( char_ ) Then trns_ = narrowdicASCII.Item( char_ ) Else trns_ = char_ End If rtn = rtn & trns_ Next ToNarrowASCII = rtn End Function Function ToNarrowKANA( byref str ) Dim rtn, max_, char_, trns_ Dim i rtn = "" max_ = len( str ) For i = 1 to max_ char_ = Mid( str,i,1 ) If narrowdicANK.Exists( char_ ) Then trns_ = narrowdicANK.Item( char_ ) Else trns_ = char_ End If rtn = rtn & trns_ Next ToNarrowKANA = rtn End Function Function ToWideAll( byref str , byval option_ ) Dim rtn, max_, char_, trns_, next_c, flg_nextc_trns Dim i rtn = "" max_ = len( str ) - 1 flg_nextc_trns = False For i = 1 to max_ If flg_nextc_trns = True Then flg_nextc_trns = False Else char_ = Mid( str, i , 1 ) next_c = Mid( str, i+1 , 1 ) Select Case next_c Case "゚" , "゙" If widedicANK.Exists( char_ & next_c ) Then char_ = char_ & next_c flg_nextc_trns = True End If Case "ィ" , "ェ" If Option_ Then If widedicANK.Exists( char_ & next_c ) Then char_ = char_ & next_c flg_nextc_trns = True End If End If Case Else End Select If widedicASCII.Exists( char_ ) Then trns_ = widedicASCII.Item( char_ ) Else If widedicANK.Exists( char_ ) Then trns_ = widedicANK.Item( char_ ) Else trns_ = char_ End If End If rtn = rtn & trns_ End If Next If flg_nextc_trns = False Then char_ = Right( str, 1 ) If widedicASCII.Exists( char_ ) Then trns_ = widedicASCII.Item( char_ ) Else If widedicANK.Exists( char_ ) Then trns_ = widedicANK.Item( char_ ) Else trns_ = char_ End If End If rtn = rtn & trns_ End If ToWideAll = rtn End Function Function ToWideASCII( byref str ) Dim rtn, max_, char_, trns_ Dim i rtn = "" max_ = len( str ) For i = 1 to max_ char_ = Mid( str,i, 1 ) If widedicASCII.Exists( char_ ) Then trns_ = widedicASCII.Item( char_ ) Else trns_ = char_ End If rtn = rtn & trns_ Next ToWideASCII = rtn End Function Function ToWideKANA( byref str , byval option_ ) Dim rtn, max_, char_, trns_, next_c, flg_nextc_trns Dim i rtn = "" max_ = len( str ) - 1 flg_nextc_trns = False For i = 1 to max_ If flg_nextc_trns = True Then flg_nextc_trns = False Else char_ = Mid( str, i , 1 ) next_c = Mid( str, i+1 , 1 ) Select Case next_c Case "゚" , "゙" If widedicANK.Exists( char_ & next_c ) Then char_ = char_ & next_c flg_nextc_trns = True End If Case "ィ" , "ェ" If option_ Then If widedicANK.Exists( char_ & next_c ) Then char_ = char_ & next_c flg_nextc_trns = True End If End If Case Else End Select If widedicANK.Exists( char_ ) Then trns_ = widedicANK.Item( char_ ) Else trns_ = char_ End If rtn = rtn & trns_ End If Next If flg_nextc_trns = False Then char_ = Right( str, 1 ) If widedicANK.Exists( char_ ) Then trns_ = widedicANK.Item( char_ ) Else trns_ = char_ End If rtn = rtn & trns_ End If ToWideKANA = rtn End Function End Class