2016年01月27日

フォルダのアクセス権取得


---------------------------
■ファイル名:test.vbs
---------------------------
Option Explicit

Function getFolderAccessMask(ByVal searchFolder)

'--------------------------------------------------------
'定数
'--------------------------------------------------------

Const FullAccess = 2032127
Const Read = 1179817
Const Write = 1180095
Const Update = 1245631
Const SubFolderAndFileSpecialAccess = -536805376
Const SubFolderAndFileFullAccess = 268435456

Const FullAccessJpn = "フルコントロール(All)"
Const ReadJpn = "読み取り(RX)"
Const WriteJpn = "書き込み(RWX)"
Const UpdateJpn = "変更(RWXD)"
Const SubFolderAndFileSpecialAccessJpn = "サブフォルダーとファイルに対する特殊なアクセス権"
Const SubFolderAndFileFullAccessJpn = "サブフォルダとファイルに対するフルコントロール"

'--------------------------------------------------------
'前処理
'--------------------------------------------------------

Dim wmiFileSecSetting
Dim wmiSecurityDescriptor
Dim retValue

Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_LogicalFileSecuritySetting='" & searchFolder & "'")
retValue = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)

'--------------------------------------------------------
'NTFSのアクセスコントロール情報取得
'--------------------------------------------------------

Dim DACL
Dim wmiAce
Dim wmiTrustee
Dim strSID
Dim strACL
Dim i
Dim accessMask

retValue = ""
DACL = wmiSecurityDescriptor.DACL
For each wmiAce in DACL
Set wmiTrustee = wmiAce.Trustee
strSID = ""
For i = 0 To UBound(wmiTrustee.SID) - 1
strSID = strSID & wmiTrustee.SID(i) & ","
Next
strSID = strSID & wmiTrustee.SID(i)

'アクセスマスクの取得
accessMask = wmiAce.accessMask

'アクセスマスクをアクセス権表示文字列に変換
strACL = ""
Select Case accessMask
Case FullAccess
'フルコントロール(All)
strACL = FullAccessJpn
Case Read
'読み取り(RX)
strACL = ReadJpn
Case Write
'書き込み(RWX)
strACL = WriteJpn
Case Update
'変更(RWXD)
strACL = UpdateJpn
Case SubFolderAndFileSpecialAccess
'サブフォルダーとファイルに対する特殊なアクセス権
strACL = SubFolderAndFileSpecialAccessJpn
Case SubFolderAndFileFullAccess
'サブフォルダとファイルに対するフルコントロール
strACL = SubFolderAndFileFullAccessJpn
Case Else
strACL = accessMask
End Select

'アクセスコントロール情報を取得
If Len(Trim(retValue)) <> 0 Then
retValue = retValue & VbCrLf
End If
retValue = retValue & """" & wmiTrustee.Domain & """"
retValue = retValue & ","
retValue = retValue & """" & wmiTrustee.Name & """"
retValue = retValue & ","
'retValue = retValue & """" & strsid & """"
'retValue = retValue & ","
'retValue = retValue & """" & wmiTrustee.Sidstring & """"
'retValue = retValue & ","
retValue = retValue & """" & strACL & """"
'retValue = retValue & ","
'retValue = retValue & """" & accessMask & """"
Next

'--------------------------------------------------------
'後処理
'--------------------------------------------------------

'オブジェクトの破棄
Set wmiAce = Nothing
Set wmiTrustee = Nothing
Set wmiFileSecSetting = Nothing
Set wmiSecurityDescriptor = Nothing

'戻り値
getFolderAccessMask = retValue

End Function

'*********************************************
' メインの処理
'*********************************************

'Const FileHeader = "Domain,Name,SID,Sidstring,ACL,accessMask"
Const FileHeader = "Domain,Name,ACL"

Dim searchFolder
Dim retValue

'対象のフォルダ
searchFolder = "C:\test"

'NTFSのアクセスコントロール情報を取得
retValue = getFolderAccessMask(searchFolder)

'アクセスコントロール情報を出力
WScript.Echo FileHeader & VbCrLf & retValue

---------------------------
■実行例
---------------------------

>cscript test.vbs //Nologo
Domain,Name,ACL
"BUILTIN","Administrators","フルコントロール(All)"
"BUILTIN","Administrators","サブフォルダとファイルに対するフルコントロール"
"NT AUTHORITY","SYSTEM","フルコントロール(All)"
"NT AUTHORITY","SYSTEM","サブフォルダとファイルに対するフルコントロール"
"BUILTIN","Users","読み取り(RX)"
"NT AUTHORITY","Authenticated Users","変更(RWXD)"
"NT AUTHORITY","Authenticated Users","サブフォルダーとファイルに対する特殊なアクセス権"

posted by rururu at 00:52| Comment(0) | TrackBack(0) | VBScript

2013年11月25日

VBScript/DOSの課題(昔作ったやつ)


■課題
・batファイル側の処理
・batファイルの先頭と後ろで、処理開始と処理終了後メッセージをログと画面に出力
(日付と時間も)
・ログは「C:\temp\kadai.log」に出力。最初は上書き。以降は追記で出力する。
・batファイルからVBScriptファイルを呼び出す。
VBScriptの標準出力と標準エラー出力をログファイルに追記(呼び出し時に指定)。
・VBScriptファイル呼出し後に%ERRORLEVELE%を参照し、0以外の場合は、
処理が異常終了したことをログに出力。0の場合は正常終了したことをログに出力。

■ソース(datetime.bat)
@echo off
set DATE_TMP=%DATE:/=%
set TIME_TMP=%TIME: =0%
set YYYY=%DATE_TMP:~0,4%
set YY=%DATE_TMP:~2,2%
set MM=%DATE_TMP:~4,2%
set DD=%DATE_TMP:~6,2%
set HH=%TIME_TMP:~0,2%
set MI=%TIME_TMP:~3,2%
set SS=%TIME_TMP:~6,2%
set SSS=%TIME_TMP:~9,2%
set DATETIME=%YYYY%%MM%%DD%%HH%%MI%%SS%%SSS%
set TIME_TMP=
set DATE_TMP=

■ソース(kadai.bat)
@echo off

rem 初期設定
set LOG_OUTPUT=C:\temp\kadai.log
set EXEC_VBS_FILE=C:\temp\kadai.vbs
set EXTRACT_FILE=C:\temp\kadai.zip
set DATETIME_BAT=C:\temp\datetime.bat
set START_MSG=***** ファイル解凍処理:開始 *****
set NORMAL_END_MSG=***** ファイル解凍処理:正常終了 *****
set ABNORMAL_END_MSG=***** ファイル解凍処理:異常終了 *****
set NORMAL_RETURNCODE=0
set ABNORMAL_RETURNCODE=-1

rem 処理開始メッセージ
call %DATETIME_BAT%
echo %START_MSG% %DATE% %TIME%
echo %START_MSG% %DATE% %TIME% > %LOG_OUTPUT%

rem 標準出力と標準エラー出力を両方ともログファイルに出力
rem タイトルロゴを出さない(//nologo)
cscript %EXEC_VBS_FILE% %EXTRACT_FILE% //nologo >> %LOG_OUTPUT% 2>&1

rem 戻り値のチェック
set RC=%ERRORLEVEL%
if %ERRORLEVEL%==%ABNORMAL_RETURNCODE% goto ERROR_END

rem 正常終了処理
call %DATETIME_BAT%
echo %NORMAL_END_MSG% %DATE% %TIME%
echo %NORMAL_END_MSG% %DATE% %TIME% >> %LOG_OUTPUT%
pause
exit /b NORMAL_RETURNCODE

rem 異常終了処理
:ERROR_END
call %DATETIME_BAT%
echo %ABNORMAL_END_MSG%(%RC%) %DATE% %TIME%
echo %ABNORMAL_END_MSG%(%RC%) %DATE% %TIME% >> %LOG_OUTPUT%
pause
exit /b %ERRORLEVEL%

・VBScriptの処理
・引数は「解凍するzipファイル(パス名+ファイル名)」
・引数が1つではない場合は、処理終了。戻り値「-1」。WScript.Echoでエラーメッセージを
標準出力に出力する。
・引数が空文字(LenとTrimを使用)の場合は、処理終了。戻り値「-1」。WScript.Echoで
エラーメッセージを標準出力に出力する。
・引数のファイルが存在しない場合は、処理終了。戻り値「-1」。WScript.Echoでエラーメッ
セージを標準出力に出力する。
 ・フォルダ(C:\Temp\sample)が無い場合は作成する。
 ・フォルダ(C:\Temp\sample)がある場合は、フォルダ内のファイル/フォルダを削除する。
・引数のzipファイルをC:\Temp\sampleに解凍する。
・戻り値「0」で処理を終了。

■ソース(kadai.vbs)
Option Explicit

'―――――――――――――――――――――――――――――――――――――――――
'■定数
'―――――――――――――――――――――――――――――――――――――――――

Const START_MSG = "===== ファイル解凍処理(VBScript):開始 ====="
Const END_MSG = "===== ファイル解凍処理(VBScript):終了 ====="
Const NORMAL_END = 0
Const ABNORMAL_END = -1
Const ERROR_MSG_001 = "引数の数が正しくありません。"
Const ERROR_MSG_002 = "引数が指定されていません。"
Const ERROR_MSG_003 = "引数で指定されたファイルが存在しません。"
Const OUTPUT_PATH = "C:\temp\sample\"

'―――――――――――――――――――――――――――――――――――――――――
'■変数
'―――――――――――――――――――――――――――――――――――――――――

Dim strZipFile
Dim objFso
Dim objParam
Set objParam = WScript.Arguments

'―――――――――――――――――――――――――――――――――――――――――
'■開始メッセージ出力
'―――――――――――――――――――――――――――――――――――――――――

WScript.Echo START_MSG

'―――――――――――――――――――――――――――――――――――――――――
'■引数チェック
'―――――――――――――――――――――――――――――――――――――――――

'引数が1つではない場合、戻り値「-1」でスクリプト終了。
'WScript.Echoでエラーメッセージを出力

If objParam.Count <> 1 Then
WScript.Echo ERROR_MSG_001
WScript.Echo END_MSG
WScript.Quit ERROR_END
End If

'引数が空文字の場合、WScript.Echoでエラーメッセージを出力
'戻り値「-1」でスクリプト終了。

strZipFile = objParam(0)
If Len(Trim(strZipFile)) = 0 Then
WScript.Echo ERROR_MSG_002
WScript.Echo END_MSG
WScript.Quit ERROR_END
End If

'引数のファイルが存在しない場合は、WScript.Echoでエラーメッセージを出力
'戻り値「-1」でスクリプト終了。

Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(strZipFile) = False Then
Set objFso = Nothing
WScript.Echo ERROR_MSG_003
WScript.Echo END_MSG
WScript.Quit ERROR_END
End If
'オブジェクトの破棄
Set objFso = Nothing

'―――――――――――――――――――――――――――――――――――――――――
'■C:\temp\sampleフォルダは、無ければ作成
' 引数のzipファイルをC:\temp\sampleに解凍
'―――――――――――――――――――――――――――――――――――――――――

Call Extract(strZipFile, OUTPUT_PATH)

'―――――――――――――――――――――――――――――――――――――――――
'■終了メッセージ出力
' スクリプト終了。終了コード:0
'―――――――――――――――――――――――――――――――――――――――――

WScript.Echo END_MSG
WScript.Quit NORMAL_END

'―――――――――――――――――――――――――――――――――――――――――
'関数名:Extract・・・Zipファイル解凍処理
'引数 :ZipFile ・・・Zipファイル名(フルパス)
' :ExtractTo・・・Zipファイル解凍先フォルダ名(末尾に「\」)
'―――――――――――――――――――――――――――――――――――――――――

Sub Extract(ZipFile, ExtractTo)

Const FOF_SILENT = &H04 '進捗ダイアログを表示しない。
Const FOF_RENAMEONCOLLISION = &H08 'ファイルやフォルダ名が重複するときは「コピー 〜 」のようなファイル名にリネームする。
Const FOF_NOCONFIRMATION = &H10 '上書き確認ダイアログを表示しない([すべて上書き]と同じ)。
Const FOF_ALLOWUNDO = &H40 '操作の取り消し([編集]-[元に戻す]や{ctrl}+{z})を有効にする。
Const FOF_FILESONLY = &H80 'ワイルドカードが指定された場合のみ実行する。
Const FOF_SIMPLEPROGRESS = &H100 '進捗ダイアログは表示するがファイル名は表示しない。
Const FOF_NOCONFIRMMKDIR = &H200 'フォルダ作成確認ダイアログを表示しない(自動で作成)。
Const FOF_NOERRORUI = &H400 'コピーや移動ができなかった場合の実行時エラーを発生させない。
'ただし、対象のファイルを飛ばして処理を続けるわけではないことに注意。
Const FOF_NORECURSION = &H1000 'サブフォルダ内のファイルはコピーしない(ただし、フォルダは作成される)。

Dim objFso
Dim objShell
Dim FilesInZip
Dim objFolder

'解凍先フォルダが無い場合は作成
'解凍先フォルダがある場合は、フォルダ内のファイル/フォルダを削除
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
If objFso.FolderExists(ExtractTo) = True Then
Call DeleteFolder(ExtractTo)
Else
objFso.CreateFolder ExtractTo
End If

'Zipファイルを解凍して、全てのファイルを解凍先フォルダにコピー
Set objShell = WScript.CreateObject("Shell.Application")
Set FilesInZip = objShell.NameSpace(ZipFile).items
Set objFolder = objShell.NameSpace(ExtractTo)
If (Not objFolder Is Nothing) Then
objFolder.CopyHere FilesInZip, FOF_NOCONFIRMATION + FOF_SILENT
End If

'オブジェクトの破棄
Set objFso = Nothing
Set objFolder = Nothing
Set FilesInZip = Nothing
Set objShell = Nothing

End Sub

'―――――――――――――――――――――――――――――――――――――――――
'関数名:DeleteFolder・・・指定フォルダ内のファイル/フォルダ削除処理
'引数 :strFolder ・・・フォルダ名(フルパス)
'―――――――――――――――――――――――――――――――――――――――――

Sub DeleteFolder(strFolder)

Dim objFso
Dim objFolder
Dim file
Dim subfolder

Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(strFolder)

'ファイルを列挙
For Each file In objFolder.Files

'ファイル削除(読み取り専用も削除)
file.Delete true

Next

'サブフォルダを列挙
For Each subfolder In objFolder.SubFolders

'サブフォルダの中身を削除(再帰処理)
Call DeleteFolder(strFolder & "\" & subfolder.Name)

'フォルダ内のファイルとフォルダがなくなったらフォルダを削除(読み取り専用も削除)
If subfolder.Files.Count = 0 And subfolder.SubFolders.Count = 0 Then
subfolder.Delete true
End If

Next

End Sub
posted by rururu at 01:06| Comment(0) | TrackBack(0) | VBScript

フォルダ内の全ファイル名


VBScriptでフォルダ内の全ファイル名取得
http://okwave.jp/qa/q1561188.html
3.2 フォルダの中を探る
http://www.happy2-island.com/vbs/cafe02/capter00302.shtml
ファイルを取得する
http://www.happy2-island.com/vbs/cafe02/capter00212.shtml
ファイル数を取得する
http://www.happy2-island.com/vbs/cafe02/capter01401.shtml
【WSH】指定したフォルダのファイル一覧を取得する
http://dragon-ark.com/archives/115
ディレクトリ内のファイル一覧を取得する方法・Filesコレクション
http://win.just4fun.biz/WSH/%E3%83%87%E3%82%A3%E3%83%AC%E3%82%AF%E3%83%88%E3%83%AA%E5%86%85%E3%81%AE%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%81%A8%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E4%B8%80%E8%A6%A7%E3%82%92%E5%8F%96%E5%BE%97%E3%81%99%E3%82%8B%E6%96%B9%E6%B3%95%E3%83%BBFiles,%20Folders.html
フォルダ内のファイルリストを一発で出力だぜぃ
http://prolography.org/other/2010/08/04/416/
【VBS】指定したフォルダに保管されているファイルを取得する
http://blog.livedoor.jp/akf0/archives/51369357.html
ファイル一覧取得 サブディレクトリも検索する
http://d.hatena.ne.jp/john-frank/20070509/1178641222
posted by rururu at 00:54| Comment(0) | TrackBack(0) | VBScript

2010年12月28日

VBScriptで正規表現を使ってみました(1)


以下のスクリプトを実行すると、
実行前のテキストファイル内の「内藤」が「加藤」に置換されます。

■実行前
安藤 内藤 斉藤 阿藤 太郎 三郎
解凍 圧縮 書籍 HOME 次郎 五郎

■実行後
安藤 加藤 斉藤 阿藤 太郎 三郎
解凍 圧縮 書籍 HOME 次郎 五郎

■実行スクリプト
Dim objFS, ts, myStr, repStr, objRegExp

'置換対象のファイルを開き、データを全て変数に読み込む
Set objFS = CreateObject("Scripting.FileSystemObject")
Set ts = objFs.OpenTextFile("C:\EFG.txt",1)
myStr = ts.ReadAll

'置換後の文字列
repStr = "加藤"

'置換対象の文字列を検索し、変数に格納
Set objRegExp = New RegExp
With objRegExp
.Pattern = "内藤"
.IgnoreCase = True
.Global = True
.Multiline = True
newStr = .Replace(myStr,repStr)
End With
Set objRegExp = Nothing
ts.Close

'ファイルを開き、置換後の情報を上書きで書き込む
Set ts = objFS.OpenTextFile("C:\EFG.txt",2)
ts.Write newStr
'ファイルを閉じる
ts.Close

'終了処理
repStr = ""
myStr = ""
Set ts = Nothing
Set objFS = Nothing

MsgBox ("終了")
posted by rururu at 23:42| Comment(0) | TrackBack(0) | VBScript

2010年11月09日

VBScriptでZIPファイル解凍


Dim ZipFile, ExtractTo, fso, objShell, FilesInZip, objFolder

Const FOF_SILENT = &H04 '進捗ダイアログを表示しない。
Const FOF_RENAMEONCOLLISION = &H08 'ファイルやフォルダ名が重複するときは「コピー 〜 」のようなファイル名にリネームする。
Const FOF_NOCONFIRMATION = &H10 '上書き確認ダイアログを表示しない([すべて上書き]と同じ)。
Const FOF_ALLOWUNDO = &H40 '操作の取り消し([編集]-[元に戻す]や{ctrl}+{z})を有効にする。
Const FOF_FILESONLY = &H80 'ワイルドカードが指定された場合のみ実行する。
Const FOF_SIMPLEPROGRESS = &H100 '進捗ダイアログは表示するがファイル名は表示しない。
Const FOF_NOCONFIRMMKDIR = &H200 'フォルダ作成確認ダイアログを表示しない(自動で作成)。
Const FOF_NOERRORUI = &H400 'コピーや移動ができなかった場合の実行時エラーを発生させない。
'ただし、対象のファイルを飛ばして処理を続けるわけではないことに注意。
Const FOF_NORECURSION = &H1000 'サブフォルダ内のファイルはコピーしない(ただし、フォルダは作成される)。

'ZIPファイル
ZipFile = "C:\Users\test\Desktop\test.zip"
'解凍先
ExtractTo = "C:\Users\test\Desktop\"

'解凍先のフォルダが無い場合は作成する
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(ExtractTo) Then
fso.CreateFolder(ExtractTo)
End If

'ZIPファイルを解凍して、全てのファイルを解凍先フォルダにコピーする。
Set objShell = CreateObject("Shell.Application")
Set FilesInZip = objShell.NameSpace(ZipFile).items
Set objFolder = objShell.NameSpace(ExtractTo)
If (Not objFolder Is Nothing) Then
objFolder.CopyHere FilesInZip, FOF_NOCONFIRMATION + FOF_SILENT
End If

'オブジェクトの破棄
Set fso = Nothing
Set objFolder = Nothing
Set FilesInZip = Nothing
Set objShell = Nothing
posted by rururu at 01:56| Comment(0) | TrackBack(0) | VBScript

2010年10月09日

ADODB.Recordsetでソート


ADODB.Recordsetでソートを行うサンプルを作っていました。
いろいろな場面で使えると思います。

■サンプル
Dim rstFiles
Const adVarChar = 200
Const adInteger = 3
Const adDate = 7

Set rstFiles = CreateObject("ADODB.Recordset")

With rstFiles.Fields
.Append "beer", adVarChar,255
.Append "state", adVarChar,255
End With

With rstFiles
.Open
.AddNew()
.Fields("beer").Value = "ハイネケン  "
.Fields("state").Value = "販売中"
.Update()
.AddNew()
.Fields("beer").Value = "ギネスビール "
.Fields("state").Value = "販売中"
.Update()
.AddNew()
.Fields("beer").Value = "カールスバーグ"
.Fields("state").Value = "品切中"
.Update()
.AddNew()
.Fields("beer").Value = "コロナビール "
.Fields("state").Value = "入荷中"
.Update()

'昇順にする場合
.Sort = "beer ASC"
'降順にする場合
'.Sort = "beer DESC"
End With

rstFiles.MoveFirst '先頭行
Do While Not rstFiles.EOF
WScript.StdOut.WriteLine(rstFiles.Fields("beer").Value & " " & rstFiles.Fields("state").Value)
rstFiles.MoveNext
Loop
rstFiles.Close
Set rstFiles = Nothing

■実行結果
>cscript ado_sample.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

カールスバーグ 品切中
ギネスビール  販売中
コロナビール  入荷中
ハイネケン   販売中
posted by rururu at 01:38| Comment(0) | TrackBack(0) | VBScript

2010年01月19日

WMIを使ってサービスの情報を取得

VBScriptでWMIを使ってサービスの情報を取得する
サンプルを作成しました。

-----------------------------------------------------------------------------
Option Explicit

Dim i
Dim strPath
Dim sHead
Dim strComputer
Dim objWMIService
Dim colItems
Dim objItem

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Service",,48)

'スクリプトファイルが実行している場所のパスを取得
strPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

i = 0
sHead = "AcceptPause,AcceptStop,Caption,CheckPoint,CreationClassName," & _
"Description,DesktopInteract,DisplayName,ErrorControl,ExitCode," & _
"InstallDate,Name,PathName,ProcessId,ServiceSpecificExitCode," & _
"ServiceType,Started,StartMode,StartName,State," & _
"Status,SystemCreationClassName,SystemName,TagId,WaitHint"
For Each objItem in colItems
WriteLog sHead, _
ValueChange(objItem.AcceptPause) & "," & _
ValueChange(objItem.AcceptStop) & "," & _
ValueChange(objItem.Caption) & "," & _
ValueChange(objItem.CheckPoint) & "," & _
ValueChange(objItem.CreationClassName) & "," & _
ValueChange(objItem.Description) & "," & _
ValueChange(objItem.DesktopInteract) & "," & _
ValueChange(objItem.DisplayName) & "," & _
ValueChange(objItem.ErrorControl) & "," & _
ValueChange(objItem.ExitCode) & "," & _
ValueChange(objItem.InstallDate) & "," & _
ValueChange(objItem.Name) & "," & _
ValueChange(objItem.PathName) & "," & _
ValueChange(objItem.ProcessId) & "," & _
ValueChange(objItem.ServiceSpecificExitCode) & "," & _
ValueChange(objItem.ServiceType) & "," & _
ValueChange(objItem.Started) & "," & _
ValueChange(objItem.StartMode) & "," & _
ValueChange(objItem.StartName) & "," & _
ValueChange(objItem.State) & "," & _
ValueChange(objItem.Status) & "," & _
ValueChange(objItem.SystemCreationClassName) & "," & _
ValueChange(objItem.SystemName) & "," & _
ValueChange(objItem.TagId) & "," & _
ValueChange(objItem.WaitHint),i
i = i + 1
Next
'オブジェクトの破棄
Set colItems = Nothing
Set objItem = Nothing
Set objWMIService = Nothing

'処理終了メッセージ
WScript.Echo "処理が終了しました。"
'処理終了
WScript.Quit

Function ValueChange(strValue)
If IsNull(strValue) = False Then
strValue = Replace(strValue,VbTab," ")
strValue = Replace(strValue,",",",")
End If
ValueChange = strValue
End Function

'結果出力処理
Sub WriteLog(strHead,strMsg,blnFLG)
Const LOGFILENAME = "Win32_Service.csv"
Dim objFSO
Dim objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
If blnFLG = 0 Then
'ログファイルが存在する場合は削除
If objFSO.FileExists(strPath & LOGFILENAME) = True Then
objFSO.DeleteFile strPath & LOGFILENAME
End If
'ログファイルを作成
objFSO.CreateTextFile strPath & LOGFILENAME
End If
'追記で開く
Set objFile = objFSO.OpenTextFile(strPath & LOGFILENAME, 8)
If blnFLG = 0 Then
objFile.WriteLine strHead
objFile.WriteLine strMsg
Else
objFile.WriteLine strMsg
End If
'オブジェクトの破棄
Set objFile = Nothing
Set objFSO = Nothing
End Sub
posted by rururu at 00:25| Comment(0) | TrackBack(0) | VBScript

文字のバイト数取得の関数

VBScriptでは、LenBを使用すると半角全角に関係なく1文字を
2バイトでカウントしてしまうので、半角文字は1バイト/全角
文字は2バイトでカウントする関数を作成しました。

-----------------------------------------------------------------------------
Option Explicit

Dim strRecord

strRecord = "123456789テスト 東京都大田区"

WScript.Echo GetLen(strRecord)

Function GetLen(sObj)
Dim i
Dim iCode

GetLen = 0
For i = 1 To Len(sObj)
iCode = Asc(Mid(sObj, i, 1))
If (( iCode >= 0) And (iCode <= 255)) Then
GetLen = GetLen + 1
Else
GetLen = GetLen + 2
End If
Next

End Function
posted by rururu at 00:16| Comment(0) | TrackBack(0) | VBScript

WMIを使ってディスクの空き容量とサイズ を取得

VBScriptでWMIを使ってディスクの空き容量とサイズ
を取得するサンプルを作成しました。

-----------------------------------------------------------------------------
Option Explicit
'
' Windows XP SP2 の WMI に関する問題のトラブルシューティング方法
' http://support.microsoft.com/kb/875605/ja
' WMI が動作しない
' http://www.microsoft.com/japan/technet/scriptcenter/topics/help/wmi.mspx
' WMI スクリプト入門 : 第 1 部
' http://msdn.microsoft.com/ja-jp/library/ms974579.aspx
' WMI による Windows の管理
' http://technet.microsoft.com/ja-jp/library/bb742445.aspx

Dim Body
Dim objWMIService
Dim objSWbemObject
Dim objSWbemObjectCollection
Dim DeviceID
Dim Size
Dim FreeSpace

Set objWMIService = GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objSWbemObjectCollection = objWMIService.ExecQuery( _
"Select * from Win32_LogicalDisk Where DriveType = 3")
For Each objSWbemObject in objSWbemObjectCollection
'デバイスIDを取得
DeviceID = objSWbemObject.DeviceID
'ハードディスクのフルサイズを取得
Size = objSWbemObject.Size
'ハードディスクの空き領域を取得
FreeSpace = objSWbemObject.FreeSpace
'本文
Body = Body & DeviceID & " 空き容量:" & FormatNumber(FreeSpace / 1024 ^ 3, 1) _
& "GB" & " / " & FormatNumber(Size / 1024 ^ 3, 1) & "GB" & vbCrLf
Next
Set objSWbemObject = Nothing
Set objSWbemObjectCollection = Nothing
Set objWMIService = Nothing

WScript.Echo Body
posted by rururu at 00:13| Comment(0) | TrackBack(0) | VBScript

ADOを使ってCSVファイルのデータを取得

VBScriptでADOを使ってデータベースからデータを取得するように
CSVファイルのデータを取得するサンプルを作成しました。
使用したCSVファイルは「input.csv」です。

-----------------------------------------------------------------------------
Option Explicit

'定数宣言
Const INPUTFILENAME = "input.csv"

'変数宣言
Dim i
Dim objADO
Dim objRS
Dim strID
Dim strPath

'初期値
i = 0
strID = "150"

'スクリプトファイルが実行している場所のパスを取得
strPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

'ADOを使いCSVファイルを扱う準備
Set objADO = CreateObject("ADODB.Connection")
objADO.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & _
strPath & ";ReadOnly=1"

'SQLを実行して、対象データを抽出してファイルに出力
Set objRS = objADO.Execute("SELECT 社員ID,社員名," & _
"役職コード,役職名,部署 FROM " & _
INPUTFILENAME & " WHERE 役職コード=" & strID)
Do While Not objRS.EOF
WriteLog objRS("社員ID").Value & "," & _
objRS("社員名").Value & "," & _
objRS("役職コード").Value & "," & _
objRS("役職名").Value & "," & _
objRS("部署").Value, i
i = i + 1
objRS.MoveNext
Loop

'オブジェクトのクローズ&破棄
objRS.Close
Set objRs = Nothing
objADO.Close
Set objADO = Nothing

'処理終了メッセージ
WScript.Echo "処理が終了しました。"
'処理終了
WScript.Quit

'結果出力処理
Sub WriteLog(strMsg,blnFLG)
Const LOGFILENAME = "Report.log"
Dim objFSO
Dim objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
If blnFLG = 0 Then
'ログファイルが存在する場合は削除
If objFSO.FileExists(strPath & LOGFILENAME) = True Then
objFSO.DeleteFile strPath & LOGFILENAME
End If
'ログファイルを作成
objFSO.CreateTextFile strPath & LOGFILENAME
End If
'追記で開く
Set objFile = objFSO.OpenTextFile(strPath & LOGFILENAME, 8)
'メッセージを書き込み
objFile.WriteLine strMsg
'オブジェクトの破棄
Set objFile = Nothing
Set objFSO = Nothing
End Sub
posted by rururu at 00:07| Comment(0) | TrackBack(0) | VBScript