Archive for the ‘WSH’ Category.
【WSH】Outlook Expressのメールルールをバックアップする
vbscriptを利用してOutlook Expressのメールルールをバックアップする例です。
このスクリプトはバックアップファイル(レジストリファイル)の保存先、ファイル名を引数で渡します。
例:
(script名) c:\test.reg
バックアップしたファイルは、ダブルクリックすることでインポートが可能です。
ここでの注意点として、OSを再インストールする度にGUIDが変わってしまいます。
バックアップした時とインポートする時の状況が違う時は、バックアップしたファイルをメモ帳などで開き、
GUIDを置き換える必要があります。
例:
バックアップ元のGUID {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
インポート先のGUID {zzzzzzzz-zzzz-zzzz-zzzz-zzzzzzzzzzzz}
1.インポート先のGUIDを調べる。
2.バックアップ元のファイルを開き、{xxx～}を置き換える。
メモ帳の場合は「検索する文字列」にバックアップ元のGUIDを、「置換後の文字列」にインポート先のGUIDを入れましょう。
また、このスクリプトでは、reg.exeというファイルを利用しています。Windows XPから標準でインストールされているものになります。
Windows 2000ではreg.exeが入っていないため、使えません…
Option Explicit
'#######################################################
'# Global-Configration #
'#######################################################
Const OpenTextFileForReading = 1
Const OpenTextFileForWriting = 2
Const OpenTextFileForAppending = 8
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'*************************
' Call Main Program
'*************************
Main()
'*************************
' Start Main Program
'*************************
Sub Main()
'#######################################################
'# Local-Configration #
'#######################################################
Dim OBJ_WshShell 'WSH Shell Object
Dim OBJ_FSO 'File System Object
Dim OBJ_Folders 'Folder Object
Dim OBJ_Args 'Argument Object
Dim COL_Folders 'Collection Object
Dim STR_FileName 'String Object
Dim STR_StoreOwner 'String Object
Dim STR_RulePath 'String Object
Dim STR_LogFolder 'String Object
Dim STR_LogFile 'String Object
Dim STR_Temp 'String Object
Dim i
Set OBJ_WshShell = WScript.CreateObject("WScript.Shell")
Set OBJ_FSO = WScript.CreateObject("Scripting.FileSystemObject")
Set OBJ_Args = WScript.Arguments
'引数チェック
If OBJ_Args.Count = 1 Then
STR_FileName = OBJ_Args(0)
If Right(LCase(STR_FileName), 4) = ".reg" Then
Else
STR_FileName = STR_FileName & ".reg"
End If
If OBJ_FSO.FileExists(STR_FileName) Then
WScript.Echo "エラー:出力先に同名のファイルが存在します。処理を続行出来ません。"
WScript.Quit 1
End If
Else
WScript.Echo "エラー:引数の数が不正です。処理を続行出来ません。プログラムを中止します。"
WScript.Quit 1
End If
'【Get Mail Store Owner & Mail Store Path】
STR_StoreOwner = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\Last User ID")
If Err.Number <> 0 Then
WScript.Echo "エラー:処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。"
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
STR_RulePath = """HKEY_CURRENT_USER" & "\Identities\" & STR_StoreOwner & "\Software\Microsoft\Outlook Express\5.0\Rules"""
If Err.Number <> 0 Then
WScript.Echo "エラー:処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。"
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
'レジストリのExport
OBJ_WshShell.Run "reg.exe export " & STR_RulePath & " " & STR_FileName, 0, True
If Err.Number = 0 Then
WScript.Echo "レジストリのバックアップは正常に完了しました。出力したファイルは " & STR_FileName & " です。"
WScript.Quit 0
Else
WScript.Echo "エラー:レジストリのバックアップに失敗しました。"
WScript.Quit 1
End If
End Sub
【WSH】Outlook Expressのメールファイルのサイズを出力する
vbscriptにてOutlook Exressのメールファイル(.dbx)の一覧とサイズを出力する例です。
Option Explicit
'On Error Resume Next
'#######################################################
'# Global-Configration #
'#######################################################
Const OpenTextFileForReading = 1
Const OpenTextFileForWriting = 2
Const OpenTextFileForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
'*************************
' Call Main Program
'*************************
Main()
'*************************
' Start Main Program
'*************************
Sub Main()
'#######################################################
'# Local-Configration #
'#######################################################
Dim OBJ_WshShell 'WSH Shell Object
Dim OBJ_FSO 'File System Object
Dim OBJ_Folders 'Folder Object
Dim COL_Folders 'Collection Object
Dim STR_FileName 'String Object
Dim STR_StoreOwner 'String Object
Dim STR_StorePath 'String Object
Dim STR_LogFolder 'String Object
Dim STR_LogFile 'String Object
Dim STR_Temp 'String Object
Dim i
Set OBJ_WshShell = WScript.CreateObject("WScript.Shell")
Set OBJ_FSO = WScript.CreateObject("Scripting.FileSystemObject")
'【Get Mail Store Owner & Mail Store Path】
STR_StoreOwner = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\Last User ID")
If Err.Number <> 0 Then
STR_Work = MsgBox("処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。" & vbCrLf & "Error Code: RegRead Error-001" ,vbOkOnly + vbCritical,"エラーが発生しました")
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
STR_StorePath = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\" & STR_StoreOwner & "\Software\Microsoft\Outlook Express\5.0\Store root")
If Err.Number <> 0 Then
STR_Work = MsgBox("処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。" & vbCrLf & "Error Code: RegRead Error-002" ,vbOkOnly + vbCritical,"エラーが発生しました")
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
WScript.Echo "No,ファイル名,ファイルサイズ(MB)"
'【Get MailBox Folder & File-Size】
Set OBJ_Folders = OBJ_FSO.GetFolder(STR_StorePath)
Set COL_Folders = OBJ_Folders.Files
i = 1
For Each STR_FileName In COL_Folders
If LCase(Right(STR_FileName,4)) = ".dbx" Then
WScript.Echo i & "," & STR_FileName & "," & Round(STR_FileName.Size / 1000000,1)
i = i + 1
End If
Next
End Sub
【WSH】起動時間・起動してからの経過時間を表示する
WSHを使用して、OSの起動時間と起動してからの経過時間を表示する例です。
WMIで各値を取得するのですが、UTCで値が返ってきますので、このサイトで紹介した
UTCを変換する関数を利用しています。
Option Explicit
Call Uptime()
'===========================================================================
Sub Uptime()
Dim OBJ_WMIService
Dim OBJ_Item
Dim COL_Item
Dim STR_Computer
Dim STR_NameSpace
Dim STR_BootUpTime
Dim STR_LocalTime
Dim STR_Work
Dim STR_Day
Dim STR_Hour
Dim STR_Min
STR_Computer = "."
STR_NameSpace = "/root/cimv2"
Set OBJ_WMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & STR_Computer & STR_NameSpace)
If Err.Number <> 0 Then
WScript.Echo "Error=" & Err.Number
WScript.Echo "ERROR Code=" & Err.Number & " Description=" & Err.Description
Err.Clear
Exit Sub
End If
Set COL_Item = OBJ_WMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each OBJ_Item In COL_Item
STR_BootUpTime = OBJ_Item.LastBootUpTime
STR_LocalTime = OBJ_Item.LocalDateTime
Next
STR_BootUpTime = ConvertUTCToDate(STR_BootUpTime)
STR_LocalTime = ConvertUTCToDate(STR_LocalTime)
STR_Work = DateDIff("n", STR_BootUpTime, STR_LocalTime)
STR_Day = Fix((STR_Work / 60 ) / 24)
STR_Hour = (STR_Work / 60) Mod 24
STR_Min = STR_Work Mod 60
WScript.Echo "起動時刻: " & STR_BootUpTime
WScript.Echo "経過時間: " & STR_Day & " 日 " & STR_Hour & " 時間 " & STR_Min & " 分"
End Sub
'===========================================================================
Function ConvertUTCToDate(STR_DateTime)
ConvertUTCToDate = CDate(Mid(STR_DateTime, 5, 2) & "/" & _
Mid(STR_DateTime, 7, 2) & "/" & Left(STR_DateTime, 4) & " " & _
Mid(STR_DateTime, 9, 2) & ":" & _
Mid(STR_DateTime, 11, 2) & ":" & _
Mid(STR_DateTime, 13, 2))
End Function
【WSH】メールを送信する
WSHを利用してメールを送信する例です。
今時のメール送信はSMTP Authなどが実装されている例が多いのですが、
今回の例は、SMTP Authには対応していません。(別途、紹介します)
パラメータは以下の通り。
Send_Msg “SMTPモード”,”SMTPサーバ”,”SMTPポート”,”送信元メールアドレス”,”宛先メールアドレス”,”CC宛先”,”BCC宛先”,”件名”,”本文”
Dim STR_SmtpHost
Dim STR_SmtpPort
Dim STR_MsgFrom
Dim STR_MsgTo
Dim STR_MsgCc
Dim STR_MsgBcc
Dim STR_MsgSubject
Dim STR_MsgBody
STR_SmtpHost = "xxx"
STR_SmtpPort = "xx"
STR_MsgFrom = "xxx@xxx.com"
STR_MsgTo = "xxx@yyy.com"
STR_MsgCc = ""
STR_MsgBcc = ""
STR_MsgSubject = "aaaa"
STR_MsgBody = "bbb"
Call Send_Msg(STR_SmtpHost, STR_SmtpPort, STR_MsgFrom, STR_MsgTo, STR_MsgCc, STR_MsgBcc, STR_MsgSubject, STR_MsgBody)
Function Send_Msg(STR_SmtpHost, STR_SmtpPort, STR_MsgFrom, STR_MsgTo, STR_MsgCc, STR_MsgBcc, STR_MsgSubject, STR_MsgBody)
Set OBJ_EMail = CreateObject("CDO.Message")
OBJ_EMail.From = STR_MsgFrom
OBJ_EMail.Subject = STR_MsgSubject
OBJ_EMail.TextBody = STR_MsgBody
OBJ_EMail.To = STR_MsgTo
OBJ_EMail.Cc = STR_MsgCc
OBJ_EMail.Bcc = STR_MsgBcc
OBJ_EMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
OBJ_EMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = STR_SmtpHost
OBJ_EMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = STR_SmtpPort
OBJ_EMail.Configuration.Fields.Update
OBJ_EMail.Send
Set OBJ_EMail = Nothing
End Function
【WSH】Systemアカウントでコマンドプロンプトを起動する
以前にSystemアカウントでプログラムを起動する投稿をしましたが、
WSHにて書いてみました。(以外にあっさりでしたが…)
今回のコードはとりあえず、コマンドプロンプトを起動します。
コマンドプロンプトさえ起動すれば、そこで実行するコマンドは全てSystemアカウントで実行されます。
Option Explicit
Dim OBJ_WshShell 'WSH Shell Object
Dim STR_Time 'String Object
Set OBJ_WshShell = WScript.CreateObject("WScript.Shell")
STR_Time = DateAdd("n", 1 , Time())
OBJ_WshShell.run "at " & STR_Time & " /interactive" & " cmd /K",0
Scriptのダウンロードは こちら です。
【WSH】ZIP圧縮(Shell)
Shellを利用し、WindowsXP、Vistaでファイル圧縮を行います。
例では、”C:\test.txt” を”C:\test.zip” に圧縮しています。
Option Explicit
MakeZip "C:\test.txt", "C:\test.zip"
Sub MakeZip(STR_TargetFile ,STR_SaveFile)
Dim OBJ_FSO
Dim OBJ_ZIP
Dim OBJ_Shell
Dim ARR_Hex
Dim STR_Temp
Dim i
Set OBJ_FSO = CreateObject("Scripting.FileSystemObject")
ARR_Hex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(ARR_Hex)
STR_Temp = STR_Temp & Chr(ARR_Hex(i))
Next
Set OBJ_Zip = OBJ_FSO.CreateTextFile(STR_SaveFile, True)
OBJ_Zip.Write STR_Temp
OBJ_Zip.Close
Set OBJ_Shell = CreateObject("Shell.Application")
OBJ_Shell.NameSpace(STR_SaveFile).CopyHere(STR_TargetFile)
WScript.Sleep 3000
Set OBJ_Shell = Nothing
End Sub
Scriptのダウンロードは こちら です。
【WSH】Winhttpでhttpリクエストを行う(Binary)
Winhttpでhttpリクエストを行い、Cドライブ直下に”test.gif”というファイルにリクエスト結果を保存する例です。
Option Explicit
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
Const adTypeBinary = 1 'Binary
Const adTypeText = 2 'Text
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
HTTPDownload "http://dragon-ark.com/wp-content/uploads/2008/12/20081231_1-300x166.gif" , "c:\test.gif"
Sub HTTPDownload(ByVal STR_URL, ByVal STR_Path )
Dim OBJ_ADO
Dim OBJ_HTTP
Dim STR_Temp
Set OBJ_ADO = CreateObject("ADODB.Stream")
OBJ_ADO.Type = adTypeBinary
OBJ_ADO.Open
OBJ_ADO.Position = 0
Set OBJ_HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
OBJ_HTTP.Open "GET", STR_URL, False
OBJ_HTTP.Send
STR_Temp = OBJ_HTTP.ResponseBody
OBJ_ADO.Write STR_Temp
OBJ_ADO.SaveToFile STR_Path, adSaveCreateNotExist
OBJ_ADO.Close
End Sub
Scriptのダウンロードは こちら です。
【WSH】Winhttpでhttpリクエストを行う(Text)
Winhttpでhttpリクエストを行い、Cドライブ直下に”test.txt”というファイルにリクエスト結果を保存する例です。
Option Explicit
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
HTTPDownload "http://google.co.jp/index.html" , "c:\text.txt"
Sub HTTPDownload(ByVal STR_URL, ByVal STR_Path )
Dim OBJ_File
Dim OBJ_FSO
Dim OBJ_HTTP
Set OBJ_FSO = CreateObject("Scripting.FileSystemObject")
Set OBJ_File = OBJ_FSO.OpenTextFile(STR_Path, OpenFileForWriting, True)
Set OBJ_HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
OBJ_HTTP.Open "GET", STR_URL, False
OBJ_HTTP.Send
OBJ_File.Write OBJ_HTTP.ResponseText
OBJ_File.Close( )
End Sub
Scriptのダウンロードは こちら です。
【WSH】IEを起動し、ページを表示する
IEを起動し、googleを開く例です。
Option Explicit
Dim OBJ_Shell
Set OBJ_Shell = CreateObject("Shell.Application")
OBJ_Shell.Windows.Item.Navigate "<a href="http://www.google.co.jp/">http://www.google.co.jp/</a>"
Scriptのダウンロードは こちら です。
