getParam + test
- 2008-02-18
- 18:42
VBSを組むときに値を外出しにしたい
毎回組むのが面倒なので以下のファイルを作成
取得時は
dim param : Set param = CreateObject("Scripting.Dictionary")
error_msg = getParam([ファイル名], param)
使用時は
param("hoge")
以下ソース
-----------------------------------------------------------------------------------------------
'/**
' * @brief 指定ファイルを解析してパラメータ化する
' * @test 読込みファイルに「test=on」と書けば全パラメータを吐き出す
' * @param v_file_read...解析したいファイルの名前
' * @param r_ht...データを格納したいハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @retval エラーが発生したファイル名、行
' * @date 2008/02/15
' * @todo コメント行は配列化
' */
Option Explicit
' パラメータの取得
function getParam(ByVal v_file_read, ByRef r_ht)
dim error_msg : error_msg = ""
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 読取ファイルを開く
on error resume next
Dim oFileRead : Set oFileRead = wso.OpenTextFile(v_file_read, 1)
if (0 <> Err.Number) then
getParam = v_file_read
exit function
end if
' 全行解析
Do Until oFileRead.AtEndOfStream
dim line : line = oFileRead.ReadLine
' コメント行は解析しない
if (1 <> instr(line, "/")) and (1 <> instr(line, "'")) and (1 <> instr(line, ";")) and (1 <> instr(line, "#")) then
' パラメータと認識しないとパラメータ化しない
if (1 < instr(line, "=")) then
on error resume next
dim aryLine : aryLine = split(line, "=")
' キーは空白抜きの小文字
dim sKey : sKey = LCase(trim(aryLine(0)))
' 値は空白抜き
dim sValue : sValue = trim(aryLine(1))
' 値がとれない場合は空白とする
if (0 <> Err.Number) then
' エラー
error_msg = line
sValue = ""
end if
' キー追加
r_ht.add sKey, sValue
end if
end if
Loop
' 読取ファイルを閉じる
oFileRead.Close()
' テストコード
if ("on" = r_ht("test")) then
call test_getParam(v_file_read, r_ht)
end if
getParam = error_msg
end function
'/**
' * @brief ### Test ### 要素("Scripting.FileSystemObject")を全てファイルに吐き出す
' * @param v_file_write...解析したファイルの名前
' * @param v_ht...データを格納されたハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @date 2008/02/15
' */
sub test_getParam(ByVal v_file_write, ByVal v_ht)
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)
' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next
' 出力ファイルを閉じる
oFileWrite.Close()
end sub
毎回組むのが面倒なので以下のファイルを作成
取得時は
dim param : Set param = CreateObject("Scripting.Dictionary")
error_msg = getParam([ファイル名], param)
使用時は
param("hoge")
以下ソース
-----------------------------------------------------------------------------------------------
'/**
' * @brief 指定ファイルを解析してパラメータ化する
' * @test 読込みファイルに「test=on」と書けば全パラメータを吐き出す
' * @param v_file_read...解析したいファイルの名前
' * @param r_ht...データを格納したいハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @retval エラーが発生したファイル名、行
' * @date 2008/02/15
' * @todo コメント行は配列化
' */
Option Explicit
' パラメータの取得
function getParam(ByVal v_file_read, ByRef r_ht)
dim error_msg : error_msg = ""
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 読取ファイルを開く
on error resume next
Dim oFileRead : Set oFileRead = wso.OpenTextFile(v_file_read, 1)
if (0 <> Err.Number) then
getParam = v_file_read
exit function
end if
' 全行解析
Do Until oFileRead.AtEndOfStream
dim line : line = oFileRead.ReadLine
' コメント行は解析しない
if (1 <> instr(line, "/")) and (1 <> instr(line, "'")) and (1 <> instr(line, ";")) and (1 <> instr(line, "#")) then
' パラメータと認識しないとパラメータ化しない
if (1 < instr(line, "=")) then
on error resume next
dim aryLine : aryLine = split(line, "=")
' キーは空白抜きの小文字
dim sKey : sKey = LCase(trim(aryLine(0)))
' 値は空白抜き
dim sValue : sValue = trim(aryLine(1))
' 値がとれない場合は空白とする
if (0 <> Err.Number) then
' エラー
error_msg = line
sValue = ""
end if
' キー追加
r_ht.add sKey, sValue
end if
end if
Loop
' 読取ファイルを閉じる
oFileRead.Close()
' テストコード
if ("on" = r_ht("test")) then
call test_getParam(v_file_read, r_ht)
end if
getParam = error_msg
end function
'/**
' * @brief ### Test ### 要素("Scripting.FileSystemObject")を全てファイルに吐き出す
' * @param v_file_write...解析したファイルの名前
' * @param v_ht...データを格納されたハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @date 2008/02/15
' */
sub test_getParam(ByVal v_file_write, ByVal v_ht)
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)
' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next
' 出力ファイルを閉じる
oFileWrite.Close()
end sub
要素("Scripting.FileSystemObject")を全てファイルに吐き出す
- 2008-02-15
- 14:24
sub test_getParam(ByVal v_file_write, ByVal v_ht)
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)
' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next
' 出力ファイルを閉じる
oFileWrite.Close()
end sub
Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")
' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)
' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next
' 出力ファイルを閉じる
oFileWrite.Close()
end sub
ユーザーの作成と権限の追加
- 2008-02-14
- 11:31
rem **************************************************
rem ユーザーの作成と権限の追加
rem パスワードを無期限にするにはaddusers.exe を使う
rem **************************************************
rem "ユーザーID"
set ID=aa
rem "パスワード"
set PW=bb
rem "説明"
set CMT=aaaaa
rem "フルネーム"
set FN=AA
rem "ユーザー作成"
net user %ID% %PW% /add /comment:"%CMT%" /fullname:"%FN%" /expires:never
rem "権限の追加"
net localgroup administrators %ID% /add
pause
rem ユーザーの作成と権限の追加
rem パスワードを無期限にするにはaddusers.exe を使う
rem **************************************************
rem "ユーザーID"
set ID=aa
rem "パスワード"
set PW=bb
rem "説明"
set CMT=aaaaa
rem "フルネーム"
set FN=AA
rem "ユーザー作成"
net user %ID% %PW% /add /comment:"%CMT%" /fullname:"%FN%" /expires:never
rem "権限の追加"
net localgroup administrators %ID% /add
pause
セルの保存とオートフィルタの選択
- 2008-02-04
- 16:00
' 保存した横軸の値
Dim m_save_row As Integer
' 保存した縦軸の値
Dim m_save_col As Integer
' オートフィルターの切り替え
Sub modeAutoFilter()
Rows("1:1").Select
Selection.AutoFilter
End Sub
' 選択したセルの値でオートフィルターをかける
Sub selectAutoFilter()
Dim c As String
c = Selection.Cells
Dim row As Integer
col = Selection.Column
Selection.AutoFilter Field:=col, Criteria1:=c
End Sub
' 現在のセル位置を保存
Sub saveCellPos()
m_save_row = Selection.row
m_save_col = Selection.Column
End Sub
' 保存したセル位置へジャンプ
Sub selectCellPos()
If (m_save_row <> 0) Then
Cells(m_save_row, m_save_col).Select
Else
MsgBox ("nothing save data")
End If
End Sub
Dim m_save_row As Integer
' 保存した縦軸の値
Dim m_save_col As Integer
' オートフィルターの切り替え
Sub modeAutoFilter()
Rows("1:1").Select
Selection.AutoFilter
End Sub
' 選択したセルの値でオートフィルターをかける
Sub selectAutoFilter()
Dim c As String
c = Selection.Cells
Dim row As Integer
col = Selection.Column
Selection.AutoFilter Field:=col, Criteria1:=c
End Sub
' 現在のセル位置を保存
Sub saveCellPos()
m_save_row = Selection.row
m_save_col = Selection.Column
End Sub
' 保存したセル位置へジャンプ
Sub selectCellPos()
If (m_save_row <> 0) Then
Cells(m_save_row, m_save_col).Select
Else
MsgBox ("nothing save data")
End If
End Sub

