| ' **********************************************
' 定義
' **********************************************
Set Fso = CreateObject( "Scripting.FileSystemObject" )
DelChar = Chr(0) ' 配列要素を削除するのに使用する文字
Sep = vbCrLf ' 配列データに含まれない文字列を使用
SORT_STRING_MAX = 1024 ' ソート用
' **********************************************
' 処理
' **********************************************
' 配列作成( または、クリア )
' aData が動的配列として定義されていれば、Redim aData(-1) でも同等
aData = Array()
' 配列追加
Call ArrayAdd( aData, "0001" )
Call ArrayAdd( aData, "0009" )
Call ArrayAdd( aData, "9999" )
Call ArrayAdd( aData, "0005" )
Call ArrayAdd( aData, "0002" )
Call ArrayDelete( aData, 2 )
Call ArrayInsert( aData, -1, "開始位置" )
Call ArrayInsert( aData, 3, "0005の後" )
' 配列列挙
For I = 0 to Ubound( aData )
WScript.Echo ( aData(I) )
Next
WScript.Echo _
" ----------------------------------------------"
' テキストファイル(CrLf)より読み込み
Call ArrayLoad( aData, "ArrayData.txt" )
' 配列列挙
For I = 0 to Ubound( aData )
WScript.Echo ( aData(I) )
Next
WScript.Echo _
" ----------------------------------------------"
' ソート( 第2引数を True にすると、逆ソート )
' ソート処理のみ、配列の実体が入れ替わります
aData = ArraySort( aData, False )
' 配列列挙
For I = 0 to Ubound( aData )
WScript.Echo ( aData(I) )
Next
' **********************************************
' 配列追加
' **********************************************
Function ArrayAdd( aTarget, strValue )
ReDim Preserve aTarget(Ubound(aTarget)+1)
aTarget( Ubound(aTarget) ) = strValue
End Function
' **********************************************
' 配列挿入
' **********************************************
Function ArrayInsert( aTarget, nIndex, strValue )
Dim strWork
if nIndex = -1 then
aTarget( 0 ) = strValue & Sep & aTarget( 0 )
else
aTarget( nIndex ) = _
aTarget( nIndex ) & Sep & strValue
end if
strWork = Join( aTarget, Sep )
aTarget = Split( strWork, Sep )
End Function
' **********************************************
' 配列要素削除
' **********************************************
Function ArrayDelete( aTarget, nIndex )
Dim strValue
aTarget( nIndex ) = DelChar
strValue = Join( aTarget, Sep )
strValue = Replace( strValue, DelChar & Sep, "" )
strValue = Replace( strValue, Sep & DelChar, "" )
aTarget = Split( strValue, Sep )
End Function
' **********************************************
' テキストフイルより読み込み
' **********************************************
Function ArrayLoad( aTarget, strPath )
Dim objHandle,strWork
Set objHandle = Fso.OpenTextFile( strPath, 1 )
aTarget = Split( objHandle.ReadAll, Sep )
objHandle.Close
if aTarget( Ubound( aTarget ) ) = "" then
Call ArrayDelete( aTarget, Ubound( aTarget ) )
end if
End Function
' **********************************************
' ソート
' **********************************************
Function ArraySort( aTarget, bDesc )
Dim Rs
Set Rs = CreateObject("ADODB.Recordset")
Rs.Fields.Append "ソート", 130, SORT_STRING_MAX
Rs.Open
For I = 0 to Ubound( aTarget )
Rs.AddNew
Rs.Fields("ソート").Value = aTarget(I)
Rs.Update
Next
if bDesc then
Rs.Sort = "ソート desc"
else
Rs.Sort = "ソート"
end if
Rs.MoveFirst
aTarget = Array()
Do while not Rs.EOF
Call ArrayAdd( aTarget, Rs.Fields("ソート").Value )
Rs.MoveNext
Loop
Rs.Close
ArraySort = aTarget
End Function
| |