ラブびあ

ビール。ときどきラブ

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