Hatena::Groupvb6

VB6メモ

[VB] [個人メモ] [仕事メモ] [アイデア] [Rubyの魔神]
[VB6クラス]
|

2016-06-10

VBS テキストファイル読書きクラス

Option Explicit

Main()


sub Main()

	dim tf
	dim s

	set tf = new ClsTxtFile

	tf.FileOpen "C:\Temp\test.txt","W"
	tf.Print "line1"
	tf.Print "line2"
	tf.FileClose

	tf.FileOpen "C:\Temp\test.txt","R"
	do while tf.Input(s) = True
		msgbox(s)
	loop
	tf.FileClose

	msgbox("ReadAll")

	tf.FileOpen "C:\Temp\test.txt","A"
	tf.Print "line3"
	tf.Print "line4"
	tf.FileClose

	tf.FileOpen "C:\Temp\test.txt","R"
	tf.ReadAll
	for each s in tf.Lines.Item
		msgbox(s)
	next
	tf.FileClose

end sub


class ClsTxtFile

	dim objFso
	dim objFile
	public Lines


	'Scripting.FileSystemObjectはファイル操作をするオブジェクトです。
	'OpenTextFileでファイルを開きます。
	'第1パラメータ→ 必ず指定します。
	'第2パラメータ→ 1:読み取り専用、2:書き込み専用、8:ファイルの最後に書き込み
	'第3パラメータ→ True(規定値):新しいファイルを作成する、False:新しいファイルを作成しない
	'第4パラメータ→ 0(規定値):ASCII ファイルとして開く、-1:Unicode ファイルとして開く、-2:システムの既定値で開く
	'ReadLineでテキストファイルを読み込みます。
	'Closeでファイルをクローズします。
	public function FileOpen(filename,mode)
		Set objFso = CreateObject("Scripting.FileSystemObject")
		Set Lines = new ArrayList

		select case ucase(mode)
			case "W"
				Set objFile = objFso.OpenTextFile(filename, 2, True)
			case "A"
				Set objFile = objFso.OpenTextFile(filename, 8, True)
			case "R"
				Set objFile = objFso.OpenTextFile(filename, 1, False)
		end select
	
	end function

	public sub Print(s)

		If Err.Number > 0 Then
		    WScript.Echo "Open Error"
		Else
		    objFile.WriteLine s
		End If

	end sub

	public function Input(s)

		If Err.Number > 0 Then
		    WScript.Echo "Open Error"
		Else
			if objFile.AtEndOfStream = True then
				Input = false
			else
				Input = True
		        s =  objFile.ReadLine
			end if
		End If

	end function

	public sub ReadAll

		If Err.Number > 0 Then
		    WScript.Echo "Open Error"
		Else
			Lines.Clear
		    Do Until objFile.AtEndOfStream
		        Lines.add objFile.ReadLine
		    Loop
		End If

	end sub

	public function FileClose
		objFile.Close
		Set objFile = Nothing
		Set objFso = Nothing
		Set Lines = Nothing
	end function

end class

'動的配列版ArrayList
class ArrayList

	private m_Item()
	private m_count

	public sub Add(x)
		ReDim Preserve m_item(m_count)
		If IsObject(x) Then
			set m_item(m_count) = x
		else
			m_item(m_count) = x
		end if
		m_count = m_count + 1
	end sub

	public function Count
		Count = m_count
	end function

	public function Clear
		m_count=0
		Erase m_item
	end function

	public function Item
		Item = m_Item
	end function

	public function Items(n)
		If IsObject(m_Item(n)) Then
			set Items = m_Item(n)
		else
			Items = m_Item(n)
		end if
	end function

end class


2016-06-06

VBS 文字コード変換

http://blog.goo.ne.jp/fukuriko/e/a40eb03d587d572f1389b24d17c60526


Function Encode(strUni,cset) 
    Set objStm = CreateObject("ADODB.Stream")
    objStm.Open
    objStm.Type = 2
    objStm.Charset = cset
    objStm.WriteText strUni 
    objStm.Position = 0
    objStm.Type = 1
    Select Case UCase(cset)
      Case "UNICODE", "UTF-16"
        objStm.Position = 2
      Case "UTF-8"
        objStm.Position = 3
    End Select
    Encode = objStm.Read()


    objStm.Close
    Set objStm = Nothing
End Function

【使用例】

' 変数str は Shift_JIS に変換された "あういうえお" が代入される

str = Encode("あいうえお","Shift_JIS")



UTF-8 読み書き

http://neos21.hatenablog.com/entry/2016/03/25/074343

' 読み込みファイルの指定 (相対パスなのでこのスクリプトと同じフォルダに置いておくこと)
Dim input
Set input = CreateObject("ADODB.Stream")
input.Type = 2    ' 1:バイナリ・2:テキスト
input.Charset = "UTF-8"    ' 文字コード指定
input.Open    ' Stream オブジェクトを開く
input.LoadFromFile "inputText.txt"    ' ファイルを読み込む

' 書き出しファイルの指定 (今回は新規作成する)
Dim output
Set output = CreateObject("ADODB.Stream")
output.Type = 2
output.Charset = "UTF-8"
output.Open

' 読み込みファイルから1行ずつ読み込み、書き出しファイルに書き出すのを最終行まで繰り返す
Dim records
Do Until input.EOS
  Dim lineStr
  lineStr = input.ReadText(-2)    ' -1:全行読み込み・-2:一行読み込み
  output.WriteText lineStr, 1    ' 0:文字列のみ書き込み・1:文字列 + 改行を書き込み
Loop

' 書き出しファイルの保存
output.SaveToFile "outputText.txt", 2    '1:指定ファイルがなければ新規作成・2:ファイルがある場合は上書き

' Stream を閉じる
input.Close
output.Close

2016-06-03

VBS 正規表現

http://d.hatena.ne.jp/cloned/20090205

正規表現を使ってパターンに一致するか調べる

Newを使ってRegExpオブジェクトを取得する。パターンはRegExpオブジェクトのPatternプロパティに代入する。

Dim re
Set re = New RegExp
re.Pattern = "^A.*$"
If re.Test("ABC") Then
    WScript.Echo "matched"
End If
大文字小文字を無視する場合はIgnoreCaseにTrueを代入する。

re.IgnoreCase = True
最初の一致のみではなく、文字列全体を検索対象にする場合にはGlobalにTrueを代入する。

re.Global = True
正規表現を使って一致する文字列を取得する

RegExpオブジェクトのExecuteを使う。

Dim re, matches
Set re = New RegExp
re.Pattern = "^A.*$"
Set matches = re.Execute("ABC")
If matches.Count > 0 Then
    WScript.Echo matches(0)
End If
出力結果は「ABC」となる。

正規表現を使ってキャプチャした文字列を取得する

Itemプロパティを利用してSubMatchesを取得する。

Dim re, matches
Set re = New RegExp
re.Pattern = "^([A-F]+)_([A-F]+).+"
Set matches = re.Execute("ABC_DEF_GHI")
If matches.Count > 0 Then
    WScript.Echo matches.Item(0).SubMatches.Item(0)
    WScript.Echo matches.Item(0).SubMatches.Item(1)
End If
出力結果は「ABC」「DEF」となる。

正規表現を使って文字列を置換する

RegExpオブジェクトのReplaceを使う。

Dim re, matches
Set re = New RegExp
re.Pattern = "^ABC_"
WScript.Echo re.Replace("ABC_DEF_GHI", "XXX_")
出力結果は「XXX_DEF_GHI」となる。

正規表現を使って文字列を置換する(後方参照)

RegExpオブジェクトのReplaceを使って置換文字列中に$数字の形式で参照する。

Dim re, matches
Set re = New RegExp
re.Pattern = "^([A-Z]{2})(.*)"
WScript.Echo re.Replace("ABCDE", "XX$2")
出力結果は「XXCDE」となる。

2016-06-02

VBS動的配列を使ったArrayList

Option Explicit

dim a



set a = new ArrayList

dim t1:set t1 = new test:t1.msg="1"
a.add(t1)
dim t2:set t2 = new test:t2.msg="2"
a.add(t2)
dim t3:set t3 = new test:t3.msg="3"
a.add(t3)
msgbox(a.Count)

dim item

for each item in a.item
	item.say
next

a.clear
msgbox("clear")
for each item in a.item
	item.say
next

a.add(t1)
a.add(t2)
a.add(t3)
msgbox(a.Count)


for each item in a.item
	item.say
next


a.Items(1).msg="say"
a.Items(1).say

class test
	public msg
	public sub say
		msgbox(msg)
	end sub
end class



'動的配列版
class ArrayList

	private m_Item()
	private m_count

	public sub Add(x)
		ReDim Preserve m_item(m_count)
		If IsObject(x) Then
			set m_item(m_count) = x
		else
			m_item(m_count) = x
		end if
		m_count = m_count + 1
	end sub

	public function Count
		Count = m_count
	end function

	public function Clear
		m_count=0
		Erase m_item
	end function

	public function Item
		Item = m_Item
	end function

	public function Items(n)
		If IsObject(m_Item(n)) Then
			set Items = m_Item(n)
		else
			Items = m_Item(n)
		end if
	end function

end class


2016-05-20

VBS フォルダの再帰的検索

http://d.hatena.ne.jp/end0tknr/20120118/1326889962

Option Explicit


dim ff

set ff = new ClsFiles

ff.getFile("C:\temp")
dim item
for each item in ff.FileList
	WScript.echo item
next


class ClsFiles

	public FileList
	Dim objFSO          ' FileSystemObject

	Private Sub Class_Initialize()
		Set FileList = CreateObject("System.Collections.ArrayList")
		Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	End Sub


	public sub getFile(path)
		FindFolder objFSO.getFolder(path)
	end sub

	' フォルダ検索関数
	Sub FindFolder(ByVal objParentFolder)

		Dim objFile
		Dim resultLine
		For Each objFile In objParentFolder.Files
			FileList.add objFile.ParentFolder & "\" & objFile.Name
		    'FIND_RESULT_FILE_OBJ.Write(objFile.ParentFolder & "\" & objFile.Name & ",")
		    'FIND_RESULT_FILE_OBJ.Write(objFile.Size & ",") 'byte
		    'FIND_RESULT_FILE_OBJ.Write(objFile.DateLastModified & ",")
		    'FIND_RESULT_FILE_OBJ.Write(Fix(Date() - objFile.DateLastModified) & ",")
		    'FIND_RESULT_FILE_OBJ.Write(objFile.DateLastAccessed & ",")
		    'FIND_RESULT_FILE_OBJ.Write(Fix(Date() - objFile.DateLastAccessed))
		    'FIND_RESULT_FILE_OBJ.WriteLine("")
		Next

		Dim objSubFolder    ' サブフォルダ
		For Each objSubFolder In objParentFolder.SubFolders
		    FindFolder objSubFolder
		Next

	End Sub

end class

|