‘VBScript’ タグのついている投稿

WSH用の便利関数

整理のために古いディスクを漁っていたら、汎用的に使えそうなWSH(VBScript)の関数群が出てきたのでメモ。

機能はファイルコピー、テンポラリディレクトリの取得、ファイルリストの取得、テキストファイルの中身を配列に読み込む、ファイルとディレクトリの存在確認、正規表現のマッチ。当時のことはよく覚えていないけど、とりあえずPHPライクに便利関数が欲しかったんだと思います。

Function FileCopy(src,dst,overwrite)
	
	Dim objFS, objWshShell
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	
	objFS.CopyFile src,dst,overwrite
	
End Function

Function GetTemporaryDirectory
	
	Dim objWshShell
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	
	GetTemporaryDirectory = objWshShell.ExpandEnvironmentStrings("%TEMP%")
	
End Function

Function GetFileList(dir, reg)
	
	Dim objFS, objFolder
	Dim fileCol,tmpFile,fileNames
	Dim i
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFS.GetFolder(dir)
	Set fileCol = objFolder.Files
	
	fileNames = Array(1)
	i = 0
	For Each tmpFile in fileCol
		If RegMatch(reg, tmpFile.name, False) Then
			fileNames(i) = tmpFile.name
			i = i + 1
			Redim Preserve fileNames(i)
		End If
	Next
	
	GetFileList = fileNames
	
End Function

Function FileReadArray(filename)
	
	Const ForReading = 1, ForWriting = 2
	
	Dim objFS, objFileStream
	Dim lines
	Dim i
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	Set objFileStream = objFS.OpenTextFile(filename, ForReading)
	
	lines = Array(1)
	i = 0
	Do While objFileStream.AtEndOfStream <> True
		lines(i) = objFileStream.ReadLine
		i = i + 1
		Redim Preserve lines(i)
	Loop
	
	FileReadArray = lines
	
End Function

Function FileExists(filepath)
	
	Dim objFS
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	
	FileExists = objFS.FileExists(filepath)
	
End Function

Function DirectoryExists(dir)
	
	Dim objFS
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	
	DirectoryExists = objFS.FolderExists(dir)
	
End Function

Function SetRegistry(strName, anyValue ,strType)
	
	Dim objWshShell
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	
	objWshShell.RegWrite strName, anyValue, strType
	
End Function

Function RegMatch(pattern, string, ignoreCase)
	
	Dim regEx, Matches
	Set regEx = New RegExp
	regEx.Pattern = pattern
	regEx.IgnoreCase = ignoreCase
	regEx.Global = True
	Set Matches = regEx.Execute(string)
	
	If Matches.Count = 0 Then
		RegMatch = False
	Else
		RegMatch = True
	End If
	
End Function