◆ [VBScript] Delphi TStringList風のリストクラス
こんばんワイン。どーもボキです。

VBScriptは、文字列処理が得意だ。
Split や UBound を利用すれば、CSVファイルの処理も簡単に実現できる。

テキストファイルの処理をさらに簡単にするため、DelphiのTStringList風のクラスを作ってみた。
このクラスを使ったソースを実行すると、下画像のような実行結果となる。
a0021757_0191419.gif
Set List = New TList

' カンマ区切りで文字列を格納
List.Text(",") = "0,1,2,3,11,22,33"

' Index=1を""12.3""に更新"
List.Items(1) = "12.3"

' Index=0に4.56を挿入"
r = List.Insert(0, 4.56)

' List.Count, List(.Item)で格納値を取得
For i = 0 to List.Count-1
WScript.Echo vbTAB & "List("&i&") = "&List(i)
Next

' 文字列でソート"
List.Sort

' 数値でソート"
List.Numeric = True
List.Sort

' ファイル保存"
DPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") &"\" ' デスクトップパス
s = Replace(Now,"
/","")
List.Save(DPath & Mid(s,3,InStr(s,"
")-3) & ".csv")




Numeric = True (数値モード) の場合も、数値変換できない文字列の格納は可能。
また、数値モードでは、実数はDouble、整数はLongに変換する。

Delphi TStringList型のプロパティ「ValueFromIndex」や「Values」も実装してみたが、
INIファイルを処理する以外、これらの用途はないだろうな。
' -----------------------------------------------------------------------
' Delphi TStringList風 文字列処理クラス
Class TList
Dim FobjFS, FData, FIndex, FNumeric

' データを格納
Public Function Add(Value)
FIndex = FIndex +1
Redim Preserve FData(FIndex)
FData(FIndex) = convStrToNumber(Value)
Add = FIndex
End Function

' 格納データを消去
Public Sub Clear
FIndex = -1
Redim FData(0)
FNumeric = False
End Sub

' 指定インデックスを削除する
Public Function Delete(Index)
Dim i
Delete = False
If (Index < 0) Or (Index > FIndex) Then Exit Function

For i = Index To FIndex -1
FData(i) = FData(i+1)
Next
FIndex = FIndex -1
Redim Preserve FData(FIndex)
Delete = True
End Function

' 指定値のインデックスを求める
Public Function IndexOf(Value)
Dim i
IndexOf = -1
For i = 0 To FIndex: Do
If CStr(FData(i)) <> CStr(Value) Then Exit Do

IndexOf = i
Exit Function
Loop Until 1: Next
End Function

' 指定インデックスに値を挿入する
Public Function Insert(Index, Value)
Dim i,idx

Insert = -1
If (Index < 0) Or (Index > FIndex) Then Exit Function

FIndex = FIndex +1
Redim Preserve FData(FIndex)
For i = Index +1 To FIndex
idx = FIndex +(Index +1) -i
FData(idx) = FData(idx -1)
Next
FData(Index) = Value
Insert = FIndex +1
End Function

' 指定ファイルを読み込む
Function Load(FPath)
Dim file
Clear
Load = False
If Not FobjFS.FileExists(FPath) Then Exit Function

Set file = FobjFS.OpenTextFile(FPath, 1)
FData = Split(file.ReadAll, vbCRLF, -1, vbTextCompare)
file.Close
FIndex = UBound(FData)
convAll
Load = True
End Function

' 指定ファイルに書き出す
Function Save(FPath)
Dim file,i
Save = False
If FIndex < 0 Then Exit Function
If Not FobjFS.FolderExists(objFS.GetParentFolderName(FPath)) Then Exit Function

Set file = FobjFS.OpenTextFile(FPath, 2, True)
For i = 0 To FIndex
file.WriteLine FData(i)
Next
file.Close
Save = True
End Function

' 格納データを昇順ソートする
Sub Sort
Call quickSort(FData, 0, FIndex)
End Sub

' プロパティ データ数
Public Property Get Count
Count = FIndex +1
End Property

' ■デフォルトプロパティ Items 指定インデックスのデータを取得
Public Default Property Get Items(Index)
If (Index < 0) Or (Index > FIndex) Then Exit Property

Items = FData(Index)
End Property

' プロパティ Items 指定インデックスにデータを格納
Public Property Let Items(Index, Value)
If (Index < 0) Or (Index > FIndex) Then Exit Property

FData(Index) = Value
End Property

' プロパティ CommaText 指定文字区切りでデータを取得
Public Property Get CommaText
CommaText = Text(",")
End Property

' プロパティ CoomaText 指定文字区切りでデータを格納
Public Property Let CommaText(Value)
Text(",") = Value
End Property

' プロパティ Text 指定文字区切りでデータを取得
Public Property Get Text(sSeparater)
Text = Join(FData, sSeparater)
End Property

' プロパティ Text 指定文字区切りでデータを格納
Public Property Let Text(sSeparater,Value)
FData = Split(Value, sSeparater)
FIndex = UBound(FData)
convAll
End Property

' プロパティ 数値モード設定値を更新
Public Property Let Numeric(Value)
FNumeric = Value
convAll
End Property

' プロパティ 数値モード設定値を取得
Public Property Get Numeric
Numeric = FNumeric
End Property

' プロパティ 指定インデックスのデータがKey=Valueの場合、Valueを取得
Public Property Get ValueFromIndex(Index)
If (Index < 0) Or (Index > FIndex) Then Exit Property
ValueFromIndex = getValue(FData(Index))
End Property

' プロパティ 指定インデックスのデータがKey=Valueの場合、Valueを取得
Public Property Let ValueFromIndex(Index,Value)
Dim s,i
If (Index < 0) Or (Index > FIndex) Then Exit Property

s = FData(Index)
i = InStr(s,"=")
If i Then s = Left(s,i-1) Else s = ""
FData(Index) = s &"="& Value
End Property

' プロパティ Key=Value形式の行を探索しValueを取得
Public Property Get Values(Str)
Dim i,s

For i = 0 To FIndex
If InStr(FData(i),Str) = 1 Then Exit For
Next
If i > FIndex Then Exit Property

s = FData(i)
Values = getValue(s)
End Property

' プロパティ Key=Value形式で格納
Public Property Let Values(Str,Value)
Dim i,s

s = Str &"="
For i = 0 To FIndex
If InStr(FData(i),s) = 1 Then Exit For
Next
s = Str &"="& Value
If i > FIndex Then Add(s) Else Items i,s
End Property
' -------------------------------------------------------------------
' コンストラクタ
Private Sub Class_Initialize()
Set FobjFS = CreateObject("Scripting.FileSystemObject")
Clear
End Sub

' デストラクタ
Private Sub Class_Terminate()
Set FobjFS = Nothing
End Sub

' 数値モードならば、引数を数値に変換する
Private Function convStrToNumber(Value)
Dim r
r = Value
If FNumeric And IsNumeric(r) Then
If InStr(r,".") <> 0 Then
r = CDbl(r)
Else
r = CLng(r)
End If
End If
convStrToNumber = r
End Function

' 数値モードならば、全データを数値に変換する
Private Function convAll
Dim i
If Not FNumeric Then Exit Function

For i = 0 To FIndex
FData(i) = convStrToNumber(FData(i))
Next
End Function

Private Function getValue(Str)
If InStr(Str,"=") = 0 Then Exit Function
getValue = Right(Str, Len(Str) - InStr(Str,"="))
End Function

' クイックソート本体(再帰)
Private Sub quickSort(ByRef Arr, i0, i1)
Dim val, i, j, tmp
If FNumeric Then
val = convStrToNumber(Arr(i0))
Else
val = LCase(Arr(i0))
End If
i=i0: j=i1
Do
If FNumeric Then
While Arr(i) < val: i=i+1: Wend
While Arr(j) > val: j=j-1: Wend
Else
While LCase(Arr(i)) < val: i=i+1: Wend
While LCase(Arr(j)) > val: j=j-1: Wend
End If
If i >= j Then Exit Do

tmp=Arr(i): Arr(i)=Arr(j): Arr(j)=tmp ' 入れ替え
i=i+1: j=j-1
Loop
If i0 < i-1 Then Call quickSort(Arr, i0, i-1)
If j+1 < i1 Then Call quickSort(Arr, j+1, i1 )
End Sub
End Class
' -----------------------------------------------------------------------

[PR]
by yozda | 2012-06-20 00:21 | プログラミング | Trackback | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/15600218
トラックバックする(会員専用) [ヘルプ]
<< PICKBOY 0.6mm厚のピック [苦言] ハゲ丸くんは今日もハ... >>