ShiftJISの固定長ファイルを読み込む
VBScriptでShiftJISの固定長ファイルを読み込むテンプレ。
例によって cmd.vbs と wow64.vbs を同じフォルダへ入れておく。
サンプルでは text.txt を fixedlength.vbs にドロップすると、1レコードずつmsgboxします。
test.txt
123ほげ1 ふが1 456ほげ2 ふが2 789ほげ3 ふが3
fixedlength.vbs
option explicit dim wsh,fso const ForReading = 1 const ForWriting = 2 const ForAppending = 8 set wsh = CreateObject("WScript.Shell") set fso = CreateObject("Scripting.FileSystemObject") include "cmd.vbs" include "wow64.vbs" call init call main call fini set wsh = nothing set fso = nothing WScript.Quit '----------------------------------------------------------------- sub init() end sub sub main() dim i for i = 0 to WScript.Arguments.Count - 1 call func(WScript.Arguments(i)) next end sub sub func(arg) dim ifile, defs, record defs = array(3,10,10,2) 'レコード定義 set ifile = fso.OpenTextFile(arg, ForReading, False) do until ifile.AtEndOfStream record = readRecord(ifile, defs) if UBound(record) > 0 then msgbox join(record, vbCrLf) end if loop ifile.Close set ifile = nothing end sub sub fini() end sub sub include(filename) filename = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), filename) ExecuteGlobal fso.OpenTextFile(filename, ForReading, False).ReadAll() end sub ' 固定長ファイルから1レコード分読み込み、配列に分割して返す ' ifile 固定長ファイル ' defs カラム長配列 ' @return 1レコード分の配列 function readRecord(ifile, defs) dim arr,i,s,l,c redim arr(UBound(defs)) for i = 0 to UBound(defs) s = "" l = 0 do while l < defs(i) if ifile.AtEndOfStream then exit function end if c = ifile.Read(1) l = l + lenj(c) s = s & c loop arr(i) = s next readRecord = arr end function ' ShiftJIS相当関数群 --- ' 文字列の切り出し function midj(s, position, length) dim i,c,pos pos = 1 for i = 1 to len(s) c = mid(s, i, 1) if pos >= position then midj = midj + c end if pos = pos + lenj(c) if pos >= position + length then exit function end if next end function ' 1文字の長さ function lenj(c) if(asc(c) >= 1 and asc(c) <= 255) then lenj = 1 else lenj = 2 end if end function ' 右桁埋め(文字列の空白埋めなど) function rpadj(s, length, padding) rpadj = midj(s & string(length, padding), 1, length) end function ' 左桁埋め(数値のゼロ埋めなど) function lpadj(s, length, padding) lpadj = strreverse(rpadj(strreverse(s), length, padding)) end function