001. テキストファイル切り出し
'// 切り出したいテキストファイルをドラッグ&ドロップ
'// Arguments : (0)Imput File
Set objArgs = WScript.Arguments

Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

'// Change current directory
WshShell.CurrentDirectory = fso.GetParentFolderName(WScript.ScriptFullName)

'// Input read file
If objArgs.Count > 0 Then
    strReadFile = objArgs(0)
Else
    strReadFile = InputBox("ファイル名を入力して下さい", strTitle & " 1/3")
    If strReadFile = "" Then WScript.Quit
End If

intStart = InputBox("先頭行を入力して下さい", strTitle & " 2/3", 1) + 0
If intStart = "" Then WScript.Quit

intLines = InputBox("切り出す行数を入力して下さい", strTitle & " 3/3", 100) + 0
If intLines = "" Then WScript.Quit

strWriteFile = strReadFile & "+" & intStart & "~" & intLines & "行.txt"

Set objReadFile = fso.OpenTextFile(strReadFile, 1, False)
Set objWriteFile = fso.CreateTextFile(strWriteFile, True)

a = 1

Do While a < intStart
    strLine = objReadFile.ReadLine
    a = a + 1
Loop

a = 0

Do Until a = intLines Or objReadFile.AtEndOfStream
    objWriteFile.WriteLine (objReadFile.ReadLine)
    a = a + 1
Loop

objReadFile.Close
objWriteFile.Close

x = MsgBox("処理が終わりました。", 64, strTitle)
002. HTML を読む
Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Navigate ("http://www.yahoo.co.jp/index.html")

Do While objIE.Busy
    WScript.Sleep 100
Loop

MsgBox (objIE.document.body.innerText)

Set objIE = Nothing
003. ASP を読む
On Error Resume Next

strURL = "http://192.168.0.1/read.asp?parm1=123&parm2=abc"

Set objXML = WScript.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "POST", strURL, False
objXML.Send
strText = objXML.ResponseText
intStat = objXML.Status
strStat = objXML.StatusText
Set objXML = Nothing

MsgBox strText
MsgBox intStat
MsgBox strStat
004. RSS(XML) を読む
Set objXML = CreateObject("MSXML2.DOMDocument")
objXML.async = False

rtResult = objXML.Load("http://dailynews.yahoo.co.jp/fc/rss.xml")

If rtResult = True Then
    subSetData objXML.childNodes
End If

Set objXML = Nothing

WScript.Quit

Sub subSetData(objNode)

    For Each Item In objNode

        If Item.nodeType = 3 Then
            a = ""
            a = a & "Name(4) = " & Item.parentNode.parentNode.parentNode.parentNode.nodeName & vbCrLf
            a = a & "Name(3) = " & Item.parentNode.parentNode.parentNode.nodeName & vbCrLf
            a = a & "Name(2) = " & Item.parentNode.parentNode.nodeName & vbCrLf
            a = a & "Name(1) = " & Item.parentNode.nodeName & vbCrLf
            a = a & "Value = " & Item.nodeValue & vbCrLf
            MsgBox a
        End If

        If Item.hasChildNodes Then
            subSetData Item.childNodes
        End If

    Next

End Sub
005. WMIクラス/プロセス情報の取得
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")

'// 特定のプロセスを指定する場合
'For Each Process In objWMI.ExecQuery("select * from Win32_Process where name='wscript.exe'")

For Each Process In objWMI.InstancesOf("Win32_Process")

    With Process
        Call .GetOwner(strOwner, strDomain)
        WScript.Echo "Name                       : " & .Name & _
            vbCrLf & "Caption                    : " & .Caption & _
            vbCrLf & "CreationClassName          : " & .CreationClassName & _
            vbCrLf & "CreationDate               : " & .CreationDate & _
            vbCrLf & "CSCreationClassName        : " & .CSCreationClassName & _
            vbCrLf & "CSName                     : " & .CSName & _
            vbCrLf & "Description                : " & .Description & _
            vbCrLf & "ExecutablePath             : " & .ExecutablePath & _
            vbCrLf & "ExecutionState             : " & .ExecutionState & _
            vbCrLf & "Handle                     : " & .Handle & _
            vbCrLf & "HandleCount                : " & .HandleCount & _
            vbCrLf & "InstallDate                : " & .InstallDate & _
            vbCrLf & "KernelModeTime             : " & .KernelModeTime & _
            vbCrLf & "MaximumWorkingSetSize      : " & .MaximumWorkingSetSize & _
            vbCrLf & "MinimumWorkingSetSize      : " & .MinimumWorkingSetSize & _
            vbCrLf & "OSCreationClassName        : " & .OSCreationClassName & _
            vbCrLf & "OSName                     : " & .OSName & _
            vbCrLf & "OtherOperationCount        : " & .OtherOperationCount & _
            vbCrLf & "OtherTransferCount         : " & .OtherTransferCount & _
            vbCrLf & "PageFaults                 : " & .PageFaults & _
            vbCrLf & "PageFileUsage              : " & .PageFileUsage & _
            vbCrLf & "ParentProcessId            : " & .ParentProcessId & _
            vbCrLf & "PeakPageFileUsage          : " & .PeakPageFileUsage & _
            vbCrLf & "PeakVirtualSize            : " & .PeakVirtualSize & _
            vbCrLf & "PeakWorkingSetSize         : " & .PeakWorkingSetSize & _
            vbCrLf & "Priority                   : " & .Priority & _
            vbCrLf & "PrivatePageCount           : " & .PrivatePageCount & _
            vbCrLf & "ProcessId                  : " & .ProcessId & _
            vbCrLf & "QuotaNonPagedPoolUsage     : " & .QuotaNonPagedPoolUsage & _
            vbCrLf & "QuotaPagedPoolUsage        : " & .QuotaPagedPoolUsage & _
            vbCrLf & "QuotaPeakNonPagedPoolUsage : " & .QuotaPeakNonPagedPoolUsage & _
            vbCrLf & "QuotaPeakPagedPoolUsage    : " & .QuotaPeakPagedPoolUsage & _
            vbCrLf & "ReadOperationCount         : " & .ReadOperationCount & _
            vbCrLf & "ReadTransferCount          : " & .ReadTransferCount & _
            vbCrLf & "Domain                     : " & strDomain & _
            vbCrLf & "Owner                      : " & strOwner
    End With

Next
Win32 Classes
006. Excel マクロ実行
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run ("excel.exe")

Set objXLS = CreateObject("Excel.Application")
objXLS.Visible = True
objXLS.Workbooks.Open "C:\エクセル.xls"
objXLS.Run objXLS.ActiveWorkbook.Name & "!" & "マクロ"
objXLS.Quit
Set objXLS = Nothing
007. Access マクロ実行
Set objAccess = GetObject("C:\アクセス.mdb")
objAccess.DoCmd.RunMacro "マクロ"
objAccess.Quit
Set objAccess = Nothing
008. CD ドライブ取り出し
On Error Resume Next

Set objShell = CreateObject("Shell.Application")
set objDrive = objShell.NameSpace("D:\")  '// D ドライブの場合
Set objItem = objDrive.Items.Item

objItem.InvokeVerb "取り出し(&J)"
009. 日付(YYYYMMDD) & 時刻(hhmmss)
'// Get execute time
strDate = Replace(Date, "/", "")
strTime = Right("0" & Replace(Time, ":", ""), 6)

MsgBox "strDate = " & strDate & vbCrLf & "strTime = " & strTime
010. VBScript から JScript を実行 + URI エンコード
'// Get URI encode value
Set objSC = CreateObject("ScriptControl")
objSC.Language = "JScript"
Set objCO = objSC.CodeObject

strURI = "http://maps.google.co.jp/maps?q=新宿区西新宿6丁目9"
a = "【エンコード前】" & vbCrLf & strURI & vbCrLf

strURI = objCO.encodeURI(strURI)  '// 「:」、「/」、「;」、「?」はコード化されない。
a = a & "【URI エンコード】" & vbCrLf & strURI & vbCrLf

strURI = objCO.encodeURIComponent(strURI)
a = a & "【URI 完全エンコード】" & vbCrLf & strURI & vbCrLf

strDecode = objCO.decodeURIComponent(strURI)
a = a & "【デコード】" & vbCrLf & strDecode & vbCrLf

Set objSC = Nothing
Set objCO = Nothing

MsgBox a
011. WMIクラス/BIOS情報の取得
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")

For Each objBIOS In objWMI.ExecQuery("select * from Win32_BIOS")
    a = a & vbCrLf & "Build Number          : " & objBIOS.BuildNumber
    a = a & vbCrLf & "Current Language      : " & objBIOS.CurrentLanguage
    a = a & vbCrLf & "Installable Languages : " & objBIOS.InstallableLanguages
    a = a & vbCrLf & "Manufacturer          : " & objBIOS.Manufacturer
    a = a & vbCrLf & "Name                  : " & objBIOS.Name
    a = a & vbCrLf & "Primary BIOS          : " & objBIOS.PrimaryBIOS
    a = a & vbCrLf & "Release Date          : " & objBIOS.ReleaseDate
    a = a & vbCrLf & "Serial Number         : " & objBIOS.SerialNumber
    a = a & vbCrLf & "SMBIOS Version        : " & objBIOS.SMBIOSBIOSVersion
    a = a & vbCrLf & "SMBIOS Major Version  : " & objBIOS.SMBIOSMajorVersion
    a = a & vbCrLf & "SMBIOS Minor Version  : " & objBIOS.SMBIOSMinorVersion
    a = a & vbCrLf & "SMBIOS Present        : " & objBIOS.SMBIOSPresent
    a = a & vbCrLf & "Status                : " & objBIOS.Status
    a = a & vbCrLf & "Version               : " & objBIOS.Version
    For i = 0 to Ubound(objBIOS.BiosCharacteristics)
        a = a & vbCrLf &  "BIOS Characteristics: " & objBIOS.BiosCharacteristics(i)
    Next
Next

WScript.Echo a
012. WMIクラス/Win32_ComputerSystem
On Error Resume Next

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")

For Each objItem In objWMI.InstancesOf("Win32_ComputerSystem")
    With objItem
        a = ""
        a = a & vbCrLf & "AdminPasswordStatus       : " & .AdminPasswordStatus
        a = a & vbCrLf & "AutomaticResetBootOption  : " & .AutomaticResetBootOption
        a = a & vbCrLf & "AutomaticResetCapability  : " & .AutomaticResetCapability
        a = a & vbCrLf & "BootOptionOnLimit         : " & .BootOptionOnLimit
        a = a & vbCrLf & "BootOptionOnWatchDog      : " & .BootOptionOnWatchDog
        a = a & vbCrLf & "BootROMSupported          : " & .BootROMSupported
        a = a & vbCrLf & "BootupState               : " & .BootupState
        a = a & vbCrLf & "Caption                   : " & .Caption
        a = a & vbCrLf & "ChassisBootupState        : " & .ChassisBootupState
        a = a & vbCrLf & "CreationClassName         : " & .CreationClassName
        a = a & vbCrLf & "CurrentTimeZone           : " & .CurrentTimeZone
        a = a & vbCrLf & "DaylightInEffect          : " & .DaylightInEffect
        a = a & vbCrLf & "Description               : " & .Description
        a = a & vbCrLf & "DNSHostName               : " & .DNSHostName
        a = a & vbCrLf & "Domain                    : " & .Domain
        a = a & vbCrLf & "DomainRole                : " & .DomainRole
        a = a & vbCrLf & "EnableDaylightSavingsTime : " & .EnableDaylightSavingsTime
        a = a & vbCrLf & "FrontPanelResetStatus     : " & .FrontPanelResetStatus
        a = a & vbCrLf & "InfraredSupported         : " & .InfraredSupported
        a = a & vbCrLf & "InitialLoadInfo           : " & .InitialLoadInfo
        a = a & vbCrLf & "InstallDate               : " & .InstallDate
        a = a & vbCrLf & "KeyboardPasswordStatus    : " & .KeyboardPasswordStatus
        a = a & vbCrLf & "LastLoadInfo              : " & .LastLoadInfo
        a = a & vbCrLf & "Manufacturer              : " & .Manufacturer
        a = a & vbCrLf & "Model                     : " & .Model
        a = a & vbCrLf & "Name                      : " & .Name
        a = a & vbCrLf & "NameFormat                : " & .NameFormat
        a = a & vbCrLf & "NetworkServerModeEnabled  : " & .NetworkServerModeEnabled
        a = a & vbCrLf & "NumberOfProcessors        : " & .NumberOfProcessors
        a = a & vbCrLf & "PartOfDomain              : " & .PartOfDomain
        a = a & vbCrLf & "PauseAfterReset           : " & .PauseAfterReset
        a = a & vbCrLf & "PowerManagementSupported  : " & .PowerManagementSupported
        a = a & vbCrLf & "PowerOnPasswordStatus     : " & .PowerOnPasswordStatus
        a = a & vbCrLf & "PowerState                : " & .PowerState
        a = a & vbCrLf & "PowerSupplyState          : " & .PowerSupplyState
        a = a & vbCrLf & "PrimaryOwnerContact       : " & .PrimaryOwnerContact
        a = a & vbCrLf & "PrimaryOwnerName          : " & .PrimaryOwnerName
        a = a & vbCrLf & "ResetCapability           : " & .ResetCapability
        a = a & vbCrLf & "ResetCount                : " & .ResetCount
        a = a & vbCrLf & "ResetLimit                : " & .ResetLimit
        a = a & vbCrLf & "Status                    : " & .Status
        a = a & vbCrLf & "SystemStartupDelay        : " & .SystemStartupDelay
        a = a & vbCrLf & "SystemStartupSetting      : " & .SystemStartupSetting
        a = a & vbCrLf & "SystemType                : " & .SystemType
        a = a & vbCrLf & "ThermalState              : " & .ThermalState
        a = a & vbCrLf & "TotalPhysicalMemory       : " & .TotalPhysicalMemory
        a = a & vbCrLf & "UserName                  : " & .UserName
        a = a & vbCrLf & "WakeUpType                : " & .WakeUpType
        a = a & vbCrLf & "Workgroup                 : " & .Workgroup
        If .Caption <> "" Then WScript.Echo a
    End With
Next
013. WMIクラス/VRAM(ビデオメモリ)容量
On Error Resume Next

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")

For Each objVC In objWMI.InstancesOf("Win32_VideoController")
    If objVC.VideoModeDescription <> "" Then
        a = a & vbCrLf & "AcceleratorCapabilities      : " & objVC.AcceleratorCapabilities
        a = a & vbCrLf & "AdapterCompatibility         : " & objVC.AdapterCompatibility
        a = a & vbCrLf & "AdapterDACType               : " & objVC.AdapterDACType
        a = a & vbCrLf & "AdapterRAM                   : " & objVC.AdapterRAM
        a = a & vbCrLf & "AdapterRAM [MB]              : " & objVC.AdapterRAM / 1024 / 1024 & " [MB]"
        a = a & vbCrLf & "Availability                 : " & objVC.Availability
        a = a & vbCrLf & "CapabilityDescriptions       : " & objVC.CapabilityDescriptions
        a = a & vbCrLf & "Caption                      : " & objVC.Caption
        a = a & vbCrLf & "ColorTableEntries            : " & objVC.ColorTableEntries
        a = a & vbCrLf & "ConfigManagerErrorCode       : " & objVC.ConfigManagerErrorCode
        a = a & vbCrLf & "ConfigManagerUserConfig      : " & objVC.ConfigManagerUserConfig
        a = a & vbCrLf & "CreationClassName            : " & objVC.CreationClassName
        a = a & vbCrLf & "CurrentBitsPerPixel          : " & objVC.CurrentBitsPerPixel
        a = a & vbCrLf & "CurrentHorizontalResolution  : " & objVC.CurrentHorizontalResolution
        a = a & vbCrLf & "CurrentNumberOfColors        : " & objVC.CurrentNumberOfColors
        a = a & vbCrLf & "CurrentNumberOfColumns       : " & objVC.CurrentNumberOfColumns
        a = a & vbCrLf & "CurrentNumberOfRows          : " & objVC.CurrentNumberOfRows
        a = a & vbCrLf & "CurrentRefreshRate           : " & objVC.CurrentRefreshRate
        a = a & vbCrLf & "CurrentScanMode              : " & objVC.CurrentScanMode
        a = a & vbCrLf & "CurrentVerticalResolution    : " & objVC.CurrentVerticalResolution
        a = a & vbCrLf & "Description                  : " & objVC.Description
        a = a & vbCrLf & "DeviceID                     : " & objVC.DeviceID
        a = a & vbCrLf & "DeviceSpecificPens           : " & objVC.DeviceSpecificPens
        a = a & vbCrLf & "DitherType                   : " & objVC.DitherType
        a = a & vbCrLf & "DriverDate                   : " & objVC.DriverDate
        a = a & vbCrLf & "DriverVersion                : " & objVC.DriverVersion
        a = a & vbCrLf & "ErrorCleared                 : " & objVC.ErrorCleared
        a = a & vbCrLf & "ErrorDescription             : " & objVC.ErrorDescription
        a = a & vbCrLf & "ICMIntent                    : " & objVC.ICMIntent
        a = a & vbCrLf & "ICMMethod                    : " & objVC.ICMMethod
        a = a & vbCrLf & "InfFilename                  : " & objVC.InfFilename
        a = a & vbCrLf & "InfSection                   : " & objVC.InfSection
        a = a & vbCrLf & "InstallDate                  : " & objVC.InstallDate
        a = a & vbCrLf & "InstalledDisplayDrivers      : " & objVC.InstalledDisplayDrivers
        a = a & vbCrLf & "LastErrorCode                : " & objVC.LastErrorCode
        a = a & vbCrLf & "MaxMemorySupported           : " & objVC.MaxMemorySupported
        a = a & vbCrLf & "MaxNumberControlled          : " & objVC.MaxNumberControlled
        a = a & vbCrLf & "MaxRefreshRate               : " & objVC.MaxRefreshRate
        a = a & vbCrLf & "MinRefreshRate               : " & objVC.MinRefreshRate
        a = a & vbCrLf & "Monochrome                   : " & objVC.Monochrome
        a = a & vbCrLf & "Name                         : " & objVC.Name
        a = a & vbCrLf & "NumberOfColorPlanes          : " & objVC.NumberOfColorPlanes
        a = a & vbCrLf & "NumberOfVideoPages           : " & objVC.NumberOfVideoPages
        a = a & vbCrLf & "PNPDeviceID                  : " & objVC.PNPDeviceID
        a = a & vbCrLf & "PowerManagementCapabilities  : " & objVC.PowerManagementCapabilities
        a = a & vbCrLf & "PowerManagementSupported     : " & objVC.PowerManagementSupported
        a = a & vbCrLf & "ProtocolSupported            : " & objVC.ProtocolSupported
        a = a & vbCrLf & "ReservedSystemPaletteEntries : " & objVC.ReservedSystemPaletteEntries
        a = a & vbCrLf & "SpecificationVersion         : " & objVC.SpecificationVersion
        a = a & vbCrLf & "Status                       : " & objVC.Status
        a = a & vbCrLf & "StatusInfo                   : " & objVC.StatusInfo
        a = a & vbCrLf & "SystemCreationClassName      : " & objVC.SystemCreationClassName
        a = a & vbCrLf & "SystemName                   : " & objVC.SystemName
        a = a & vbCrLf & "SystemPaletteEntries         : " & objVC.SystemPaletteEntries
        a = a & vbCrLf & "TimeOfLastReset              : " & objVC.TimeOfLastReset
        a = a & vbCrLf & "VideoArchitecture            : " & objVC.VideoArchitecture
        a = a & vbCrLf & "VideoMemoryType              : " & objVC.VideoMemoryType
        a = a & vbCrLf & "VideoMode                    : " & objVC.VideoMode
        a = a & vbCrLf & "VideoModeDescription         : " & objVC.VideoModeDescription
        a = a & vbCrLf & "VideoProcessor               : " & objVC.VideoProcessor
    End If
Next

WScript.Echo a
014. ODBCデータソース名(DSN)の取得
'// &H80000001 : -2147483647
'// &H80000002 : -2147483646
'// HKEY : Hive Key

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

'// Initial definition
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001
strTitle = fso.GetBaseName(Wscript.ScriptFullName)
strPath = "Software\ODBC\ODBC.INI\ODBC Data Sources"
a = ""

strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

'// System DSN
Call read_registry(HKEY_LOCAL_MACHINE, strPath)
'// User DSN
Call read_registry(HKEY_CURRENT_USER, strPath)

If a = "" Then a = "DNS が登録されていません。"
x = MsgBox(a, , strTitle)

Wscript.Quit

Function read_registry(strHKEY, strPath)
    objReg.EnumValues strHKEY, strPath, aryNames, aryTypes
    If Not IsArray(aryNames) Then Exit Function
    If strHKEY = &H80000002 Then a = a & "-- System DSN --" & vbCrLf
    If strHKEY = &H80000001 Then a = a & "-- User DSN --" & vbCrLf
    For Each strName In aryNames
        objReg.GetStringValue strHKEY, strPath, strName, strValue
        a = a & strName & "  [" & strValue & "]" & vbCrLf
    Next
End Function
015. ドメインユーザ パスワード変更

▽その1(ドメコン省略)

Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
objUser.ChangePassword "変更前パスワード", "変更後パスワード"

▽その2

Set objUser = GetObject("LDAP://[ドメイン or ドメインコントローラ]/CN=xxx,OU=xxx,OU=xxx,DC=xxx,DC=xxx")
objUser.ChangePassword "変更前パスワード", "変更後パスワード"
016. ローカルユーザ パスワード変更
'// 予めパスワードを変更する権限を持ったアカウントで接続しておく
'// 【接続例】
'//   Set WshShell = CreateObject("WScript.Shell")
'//   x = WshShell.Run("net use \\[コンピュータ名] /user:[ドメイン名]\[ユーザ名] [パスワード]", 0, 0)
'//   ・・・ パスワード変更 ・・・
'//   x = WshShell.Run("net use /d \\[コンピュータ名]", 0, True)

On Error Resume Next

strServer = "localhost"
strUser = "administrator"
strPass = "password"

'// Connect to target computer
Set objUser = GetObject("WinNT://" & strServer & "/" & strUser)
If Err.Number <> 0 Then Call error_msg("接続に失敗しました。")

'// Change password
objUser.SetPassword strPass
If Err.Number <> 0 Then Call error_msg("パスワードの変更に失敗しました。")

objUser.SetInfo

Set objUser = Nothing

MsgBox "パスワードを変更しました。"

'/*----------------------------------------------------------*
' * Sub-Routine (Error Message)
' *----------------------------------------------------------*/
Sub error_msg(strMsg)
    strMsg = strMsg & vbCrLf & "Err.Number : " & CStr(Err.Number)
    strMsg = strMsg & vbCrLf & "Description : " & Err.Description
    MsgBox strMsg
    WScript.Quit
End Sub
017. ドメインユーザ情報をテキストファイルに出力
On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

strDomain = InputBox("Please enter a domainname", "Input")
If strDomain = "" Then WScript.Quit

'// Create output file
Set objFile = fso.CreateTextFile(strDomain & ".txt", True)

'// Header
a = "Name"
a = a & vbTab & "AccountDisabled"
a = a & vbTab & "AccountExpirationDate"
a = a & vbTab & "BadLoginAddress"
a = a & vbTab & "BadLoginCount"
a = a & vbTab & "Department"
a = a & vbTab & "Description"
a = a & vbTab & "Division"
a = a & vbTab & "EmailAddress"
a = a & vbTab & "EmployeeID"
a = a & vbTab & "FaxNumber"
a = a & vbTab & "FirstName"
a = a & vbTab & "FullName"
a = a & vbTab & "GraceLoginsAllowed"
a = a & vbTab & "GraceLoginsRemaining"
a = a & vbTab & "HomeDirectory"
a = a & vbTab & "HomePage"
a = a & vbTab & "IsAccountLocked"
a = a & vbTab & "Languages"
a = a & vbTab & "LastFailedLogin"
a = a & vbTab & "LastLogin"
a = a & vbTab & "LastLogoff"
a = a & vbTab & "LastName"
a = a & vbTab & "LoginHours"
a = a & vbTab & "LoginScript"
a = a & vbTab & "LoginWorkstations"
a = a & vbTab & "Manager"
a = a & vbTab & "MaxLogins"
a = a & vbTab & "MaxStorage"
a = a & vbTab & "NamePrefix"
a = a & vbTab & "NameSuffix"
a = a & vbTab & "OfficeLocations"
a = a & vbTab & "OtherName"
a = a & vbTab & "PasswordExpirationDate"
a = a & vbTab & "PasswordLastChanged"
a = a & vbTab & "PasswordMinimumLength"
a = a & vbTab & "PasswordRequired"
a = a & vbTab & "Picture"
a = a & vbTab & "PostalAddresses"
a = a & vbTab & "PostalCodes"
a = a & vbTab & "Profile"
a = a & vbTab & "RequireUniquePassword"
a = a & vbTab & "SeeAlso"
a = a & vbTab & "TelephoneHome"
a = a & vbTab & "TelephoneMobile"
a = a & vbTab & "TelephoneNumber"
a = a & vbTab & "TelephonePager"
a = a & vbTab & "Title"
objFile.WriteLine a

Set objComputer = GetObject("WinNT://" & strDomain)
objComputer.Filter = Array("User")
For Each usr In objComputer
    a = usr.Name
    a = a & vbTab: a = a & usr.AccountDisabled
    a = a & vbTab: a = a & usr.AccountExpirationDate
    a = a & vbTab: a = a & usr.BadLoginAddress
    a = a & vbTab: a = a & usr.BadLoginCount
    a = a & vbTab: a = a & usr.Department
    a = a & vbTab: a = a & usr.Description
    a = a & vbTab: a = a & usr.Division
    a = a & vbTab: a = a & usr.EmailAddress
    a = a & vbTab: a = a & usr.EmployeeID
    a = a & vbTab: a = a & usr.FaxNumber
    a = a & vbTab: a = a & usr.FirstName
    a = a & vbTab: a = a & usr.FullName
    a = a & vbTab: a = a & usr.GraceLoginsAllowed
    a = a & vbTab: a = a & usr.GraceLoginsRemaining
    a = a & vbTab: a = a & usr.HomeDirectory
    a = a & vbTab: a = a & usr.HomePage
    a = a & vbTab: a = a & usr.IsAccountLocked
    a = a & vbTab: a = a & usr.Languages
    a = a & vbTab: a = a & usr.LastFailedLogin
    a = a & vbTab: a = a & usr.LastLogin
    a = a & vbTab: a = a & usr.LastLogoff
    a = a & vbTab: a = a & usr.LastName
    a = a & vbTab: a = a & usr.LoginHours
    a = a & vbTab: a = a & usr.LoginScript
    a = a & vbTab: a = a & usr.LoginWorkstations
    a = a & vbTab: a = a & usr.Manager
    a = a & vbTab: a = a & usr.MaxLogins
    a = a & vbTab: a = a & usr.MaxStorage
    a = a & vbTab: a = a & usr.NamePrefix
    a = a & vbTab: a = a & usr.NameSuffix
    a = a & vbTab: a = a & usr.OfficeLocations
    a = a & vbTab: a = a & usr.OtherName
    a = a & vbTab: a = a & usr.PasswordExpirationDate
    a = a & vbTab: a = a & usr.PasswordLastChanged
    a = a & vbTab: a = a & usr.PasswordMinimumLength
    a = a & vbTab: a = a & usr.PasswordRequired
    a = a & vbTab: a = a & usr.Picture
    a = a & vbTab: a = a & usr.PostalAddresses
    a = a & vbTab: a = a & usr.PostalCodes
    a = a & vbTab: a = a & usr.Profile
    a = a & vbTab: a = a & usr.RequireUniquePassword
    a = a & vbTab: a = a & usr.SeeAlso
    a = a & vbTab: a = a & usr.TelephoneHome
    a = a & vbTab: a = a & usr.TelephoneMobile
    a = a & vbTab: a = a & usr.TelephoneNumber
    a = a & vbTab: a = a & usr.TelephonePager
    a = a & vbTab: a = a & usr.Title
    objFile.WriteLine a
Next

objFile.Close

MsgBox "終わったよ!"
018. VBScript のインクルード
Set fso = CreateObject("Scripting.FileSystemObject")
Execute fso.OpenTextFile("xxx.vbs", 1, False).ReadAll()
019. IP アドレスの取得
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")

For Each nic In objWMI.ExecQuery("select * from Win32_NetworkAdapterConfiguration where IPEnabled=true")
    If nic.IPAddress(0) <> "" Then WScript.Echo nic.IPAddress(0)
Next
020. Windows シャットダウン/再起動
x = MsgBox("Windows をシャットダウンします。よろしいですか?", 1)
If x <> 1 Then WScript.Quit

'// Windows 2000 シャットダウン
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}")
For Each objOS In objWMI.InstancesOf("Win32_OperatingSystem")
'// Log Off
'    objOS.Win32Shutdown 0
'// Shutdown
'    objOS.Win32Shutdown 1
'// Reboot
'    objOS.Win32Shutdown 2
'// Forced Log Off
'    objOS.Win32Shutdown 4
'// Forced Shutdown
'    objOS.Win32Shutdown 5
'// Forced Reboot
'    objOS.Win32Shutdown 6
'// Power Off
'    objOS.Win32Shutdown 8
'// Forced Power Off
    objOS.Win32Shutdown 12
Next
021. 「最近使ったファイル」のクリア
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFile fso.BuildPath(WshShell.SpecialFolders("Recent"), "*.*")
022. タイマー (sleep)
t = InputBox("Wait する時間(分)を入力して下さい", "タイマー")
If t = "" Then WScript.Quit

WScript.Sleep (t * 60000)
023. サービスの起動/停止/削除
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objService = objWMI.ExecQuery("select * from Win32_Service where name = 'MSSQLSERVER'")

For Each objService In objService
'// Start service
    objService.StartService() 
'// Stop service
'    objService.StopService()
'// Delte service
'    objService.Delete()
Next
024. 環境変数の取得
Set WshShell = CreateObject("WScript.Shell")

WScript.Echo _
    vbCrLf & "USERNAME : " & WshShell.ExpandEnvironmentStrings("%USERNAME%") & _
    vbCrLf & "USERDOMAIN : " & WshShell.ExpandEnvironmentStrings("%USERDOMAIN%") & _
    vbCrLf & "COMPUTERNAME : " & WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & _
    vbCrLf & "APPDATA : " & WshShell.ExpandEnvironmentStrings("%APPDATA%") & _
    vbCrLf & "windir : " & WshShell.ExpandEnvironmentStrings("%windir%") & _
    vbCrLf

Set objEnv = WshShell.Environment("SYSTEM")

WScript.Echo _
    vbCrLf & "NUMBER_OF_PROCESSORS : " & objEnv("NUMBER_OF_PROCESSORS") & _
    vbCrLf & "PROCESSOR_ARCHITECTURE : " & objEnv("PROCESSOR_ARCHITECTURE") & _
    vbCrLf & "PROCESSOR_IDENTIFIER : " & objEnv("PROCESSOR_IDENTIFIER") & _
    vbCrLf & "PROCESSOR_LEVEL : " & objEnv("PROCESSOR_LEVEL") & _
    vbCrLf & "PROCESSOR_REVISION : " & objEnv("PROCESSOR_REVISION") & _
    vbCrLf & "OS : " & objEnv("OS") & _
    vbCrLf & "COMSPEC : " & objEnv("COMSPEC") & _
    vbCrLf & "HOMEDRIVE : " & objEnv("HOMEDRIVE") & _
    vbCrLf
025. 実行パスの取得
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox fso.GetAbsolutePathName("")
026. ODBC接続/SQL(SELECT)結果をテキストファイルに出力
'// 実行するSQLファイルをドラッグ&ドロップ
'// Arguments : (0)SQL File
Set objArgs = WScript.Arguments

Set WshShell = CreateObject("WScript.Shell")
Set objADO = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")

'// Change current directory
WshShell.CurrentDirectory = fso.GetParentFolderName(WScript.ScriptFullName)

'// Initial definition
strTitle = fso.GetBaseName(WScript.ScriptFullName)
dsn = "MSSQL"
strUID = "sa"

'// SQL File
If objArgs.Count > 0 Then
    strSqlFile = objArgs(0)
Else
    strSqlFile = InputBox("SQLファイル名を入力して下さい", strTitle & "  1/4")
    strSqlFile = Trim(strSqlFile)
    If strSqlFile = "" Then WScript.Quit
End If

'// Output File
strOutFile = fso.GetBaseName(strSqlFile) & ".txt"
strOutFile = InputBox("出力ファイル名を入力して下さい", strTitle & "  2/4", strOutFile)
strOutFile = Trim(strOutFile)
If strOutFile = "" Then WScript.Quit

'// Input User ID
uid = InputBox("ユーザーIDを入力して下さい", strTitle & "  3/4", strUID)
uid = Trim(uid)
If uid = "" Then WScript.Quit

'// Input Password
pwd = InputBox("パスワードを入力して下さい", strTitle & "  4/4")
pwd = Trim(pwd)
If pwd = "" Then WScript.Quit

'// Start timer
StartTime = Now

'// Setup of connection definition
strCon = "DSN=" & dsn & "; UID=" & uid & "; PWD=" & pwd

'// Create execution SQL
Set objReadFile = fso.OpenTextFile(strSqlFile, 1, False)
strSQL = objReadFile.ReadAll()
objReadFile.Close

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to database
objADO.Open strCon

'// Record count
rc = 0

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// Output to text file
If rs.EOF Then
    x = MsgBox("該当データがありません。" & vbCrLf & vbCrLf & strSqlFile, 64, strTitle)
    WScript.Quit
Else

    '// Create output file
    Set objWriteFile = fso.CreateTextFile(strOutFile, True)

    '// Get number of fields
    fc = rs.Fields.Count - 1

    '// Output column name
    a = ""
    For i = 0 To fc
        a = a & rs.Fields(i).Name
        If i < fc Then a = a & Chr(9)
    Next
    objWriteFile.WriteLine (a)

    '// Output data
    Do Until rs.EOF
        a = ""
        For i = 0 To fc
            a = a & Trim(rs.Fields(i).Value)
            If i < fc Then a = a & Chr(9)
        Next
        a = Replace(a, Chr(0), "")
        objWriteFile.WriteLine (a)
        rc = rc + 1
        rs.Movenext
    Loop

    objWriteFile.Close

End If

'// Disconnect from database
objADO.Close

'// End timer
TimeIt = FormatDateTime((Now - StartTime), 3)

'// Message
strMSG = "検索処理が終了しました。"
strMSG = strMSG & vbCrLf & vbCrLf
strMSG = strMSG & rc & " 件"
strMSG = strMSG & vbCrLf & vbCrLf
strMSG = strMSG & "処理時間は、( " & TimeIt & " 秒) だったよ~ん。"
strMSG = strMSG & vbCrLf & vbCrLf
strMSG = strMSG & "THANK YOU! ┐(´◇`)┌"
strMSG = strMSG & vbCrLf & vbCrLf & vbCrLf & ">> " & strOutFile

'// Show message
x = MsgBox(strMSG, 64, strTitle)

WScript.Quit
027. ODBC接続/SQL(DELETE/UPDAETE等)実行
'// 実行するSQLファイルをドラッグ&ドロップ
'// Arguments : (0)SQL File
Set objArgs = WScript.Arguments

Set WshShell = CreateObject("WScript.Shell")
Set objADO = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")

'// Initial definition
strTitle = fso.GetBaseName(WScript.ScriptFullName)
dsn = "MSSQL"
strUID = "sa"

'// SQL File
If objArgs.Count > 0 Then
    strSqlFile = objArgs(0)
Else
    strSqlFile = InputBox("SQLファイル名を入力して下さい", strTitle & "  1/3")
    strSqlFile = Trim(strSqlFile)
    If strSqlFile = "" Then WScript.Quit
End If

'// Input User ID
uid = InputBox("ユーザーIDを入力して下さい", strTitle & "  2/3", strUID)
uid = Trim(uid)
If uid = "" Then WScript.Quit

'// Input Password
pwd = InputBox("パスワードを入力して下さい", strTitle & "  3/3")
pwd = Trim(pwd)
If pwd = "" Then WScript.Quit

'// Start timer
StartTime = Now

'// Setup of connection definition
strCon = "DSN=" & dsn & "; UID=" & uid & "; PWD=" & pwd

'// Create execution SQL
Set objReadFile = fso.OpenTextFile(strSqlFile, 1, False)
strSQL = objReadFile.ReadAll()
objReadFile.Close

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to database
objADO.Open strCon

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// ADO properties [オマケ]
a = "-- ADO properties --"
a = a & vbCrLf & "ConnectionString : " & objADO.ConnectionString
a = a & vbCrLf & "Attributes : " & objADO.Attributes
a = a & vbCrLf & "CommandTimeout : " & objADO.CommandTimeout
a = a & vbCrLf & "ConnectionTimeout : " & objADO.ConnectionTimeout
a = a & vbCrLf & "CursorLocation : " & objADO.CursorLocation
a = a & vbCrLf & "DefaultDatabase : " & objADO.DefaultDatabase
a = a & vbCrLf & "IsolationLevel : " & objADO.IsolationLevel
a = a & vbCrLf & "Mode : " & objADO.Mode
a = a & vbCrLf & "Provider : " & objADO.Provider
a = a & vbCrLf & "State : " & objADO.State
a = a & vbCrLf & "Version : " & objADO.Version
MsgBox a

'// Recordset properties [オマケ]
On Error Resume Next
a = "-- Recordset properties --"
a = a & vbCrLf & "AbsolutePage : " & rs.AbsolutePage
a = a & vbCrLf & "AbsolutePosition : " & rs.AbsolutePosition
a = a & vbCrLf & "ActiveCommand : " & rs.ActiveCommand
a = a & vbCrLf & "ActiveConnection : " & rs.ActiveConnection
a = a & vbCrLf & "BOF : " & rs.BOF
a = a & vbCrLf & "Bookmark : " & rs.Bookmark
a = a & vbCrLf & "CacheSize : " & rs.CacheSize
a = a & vbCrLf & "CursorLocation : " & rs.CursorLocation
a = a & vbCrLf & "CursorType : " & rs.CursorType
a = a & vbCrLf & "DataMember : " & rs.DataMember
a = a & vbCrLf & "DataSource : " & rs.DataSource
a = a & vbCrLf & "EditMode : " & rs.EditMode
a = a & vbCrLf & "EOF : " & rs.EOF
a = a & vbCrLf & "Filter : " & rs.Filter
a = a & vbCrLf & "Index : " & rs.Index
a = a & vbCrLf & "LockType : " & rs.LockType
a = a & vbCrLf & "MarshalOptions : " & rs.MarshalOptions
a = a & vbCrLf & "MaxRecords : " & rs.MaxRecords
a = a & vbCrLf & "PageCount : " & rs.PageCount
a = a & vbCrLf & "PageSize : " & rs.PageSize
a = a & vbCrLf & "RecordCount : " & rs.RecordCount
a = a & vbCrLf & "Sort : " & rs.Sort
a = a & vbCrLf & "Source : " & rs.Source
a = a & vbCrLf & "State : " & rs.State
a = a & vbCrLf & "Status : " & rs.Status
a = a & vbCrLf & "StayInSync : " & rs.StayInSync
On Error GoTo 0
MsgBox a

'// Disconnect from database
objADO.Close

'// End timer
TimeIt = FormatDateTime((Now - StartTime), 3)

'// Message
strMSG = "処理が終了しました。"
strMSG = strMSG & vbCrLf & vbCrLf
strMSG = strMSG & "処理時間は、( " & TimeIt & " 秒) だったよ~ん。"
strMSG = strMSG & vbCrLf & vbCrLf
strMSG = strMSG & "THANK YOU!  (`へ´)v"
strMSG = strMSG & vbCrLf & vbCrLf & vbCrLf & ">> " & strSqlFile

'// Show message
x = MsgBox(strMSG, 64, strTitle)

WScript.Quit
028. LDAP情報の取得
'// Initial definition
Set fso = CreateObject("Scripting.FileSystemObject")
strTitle = fso.GetBaseName(WScript.ScriptFullName)

str00 = "[アカウント]を入力して下さい"
str00 = str00 & vbCrLf
str00 = str00 & vbCrLf & "0:ログインアカウント情報"
str00 = str00 & vbCrLf & "1:クライアント情報"
str00 = str00 & vbCrLf & "※何も入力しないとログインアカウント情報を表示します。"

strUser = InputBox(str00, strTitle, 0)
strUser = Trim(strUser)

If strUser = "" Or strUser = "0" Or strUser = "1" Then

    Set objSysInfo = CreateObject("ADSystemInfo")

    str00 = "-- ログイン情報 --"
    str00 = str00 & vbCrLf & "User name : " & objSysInfo.UserName
    str00 = str00 & vbCrLf & "Computer name : " & objSysInfo.ComputerName
    str00 = str00 & vbCrLf & "Site name : " & objSysInfo.SiteName
    str00 = str00 & vbCrLf & "Domain short name : " & objSysInfo.DomainShortName
    str00 = str00 & vbCrLf & "Domain DNS name : " & objSysInfo.DomainDNSName
    str00 = str00 & vbCrLf & "Forest DNS name : " & objSysInfo.ForestDNSName
    str00 = str00 & vbCrLf & "PDC role owner : " & objSysInfo.PDCRoleOwner
    str00 = str00 & vbCrLf & "Schema role owner : " & objSysInfo.SchemaRoleOwner
    str00 = str00 & vbCrLf & "Domain is in native mode : " & objSysInfo.IsNativeMode
    MsgBox str00

    If strUser = "1" Then
        strUser = "LDAP://" & objSysInfo.ComputerName
    Else
        strUser = "LDAP://" & objSysInfo.UserName
    End If

Else

    strADsPath = GetObject("GC://RootDSE").Get("defaultNamingContext")

    flg_ok = "NG"
    strDC = strADsPath: Call get_adspath(strDC)
    strDC = "[追加ドメイン]": If flg_ok = "NG" Then Call get_adspath(strDC)
    strDC = "[追加ドメコン]": If flg_ok = "NG" Then Call get_adspath(strDC)

    If flg_ok = "NG" Then
        MsgBox strUser & " は存在しません。", 64, strTitle
        WScript.Quit
    End If

End If

Call get_information(strUser)

WScript.Quit


Function get_adspath(strDC)

    Set objCon = CreateObject("ADODB.Connection")
    objCon.provider = "ADsDSOObject"
    objCon.Open "Active Directory Provider"
    Set objCmd = CreateObject("ADODB.Command")
    Set objCmd.ActiveConnection = objCon

    strSQL = "select * from 'LDAP://" & strDC & "' where cn='" & strUser & "'"

    objCmd.CommandText = strSQL
    Set objRs = objCmd.Execute

    If objRs.EOF Then Exit Function

    str00 = "-- ADsPath 情報 --"
    str00 = str00 & vbCrLf & "Fields.Count = " & objRs.Fields.Count
    str00 = str00 & vbCrLf & "Fields(0).Name = " & objRs.Fields(0).Name
    str00 = str00 & vbCrLf & "Fields(0).Value = " & objRs.Fields(0).Value
    MsgBox str00

    strUser = objRs(0)
    flg_ok = "OK"

    objRs.Close
    objCon.Close

End Function

Function get_information(strUser)

    On Error Resume Next

    Set objUser = GetObject(strUser)
    a = "-- AD情報 --"
    str00 = str00 & vbCrLf & "cn : " & objUser.Get("cn")
    str00 = str00 & vbCrLf & "PasswordLastChanged : " & objUser.PasswordLastChanged
    str00 = str00 & vbCrLf & "aCSPolicyName : " & objUser.Get("aCSPolicyName")
    str00 = str00 & vbCrLf & "maxStorage : " & objUser.Get("maxStorage")
    str00 = str00 & vbCrLf & "memberOf : " & objUser.Get("memberOf")
    str00 = str00 & vbCrLf & "mhsORAddress : " & objUser.Get("mhsORAddress")
    str00 = str00 & vbCrLf & "middleName : " & objUser.Get("middleName")
    str00 = str00 & vbCrLf & "mobile : " & objUser.Get("mobile")
    str00 = str00 & vbCrLf & "modifyTimeStamp : " & objUser.Get("modifyTimeStamp")
    str00 = str00 & vbCrLf & "mS-DS-ConsistencyChildCount : " & objUser.Get("mS-DS-ConsistencyChildCount")
    str00 = str00 & vbCrLf & "mS-DS-ConsistencyGuid : " & objUser.Get("mS-DS-ConsistencyGuid")
    str00 = str00 & vbCrLf & "mS-DS-CreatorSID : " & objUser.Get("mS-DS-CreatorSID")
    str00 = str00 & vbCrLf & "msCOM-PartitionSetLink : " & objUser.Get("msCOM-PartitionSetLink")
    str00 = str00 & vbCrLf & "adminCount : " & objUser.Get("adminCount")
    str00 = str00 & vbCrLf & "msCOM-UserLink : " & objUser.Get("msCOM-UserLink")
    str00 = str00 & vbCrLf & "msCOM-UserPartitionSetLink : " & objUser.Get("msCOM-UserPartitionSetLink")
    str00 = str00 & vbCrLf & "msDFSR-ComputerReferenceBL : " & objUser.Get("msDFSR-ComputerReferenceBL")
    str00 = str00 & vbCrLf & "msDFSR-MemberReferenceBL : " & objUser.Get("msDFSR-MemberReferenceBL")
    str00 = str00 & vbCrLf & "msDRM-IdentityCertificate : " & objUser.Get("msDRM-IdentityCertificate")
    str00 = str00 & vbCrLf & "msDS-AllowedToDelegateTo : " & objUser.Get("msDS-AllowedToDelegateTo")
    str00 = str00 & vbCrLf & "msDS-Approx-Immed-Subordinates : " & objUser.Get("msDS-Approx-Immed-Subordinates")
    str00 = str00 & vbCrLf & "msDS-Cached-Membership : " & objUser.Get("msDS-Cached-Membership")
    str00 = str00 & vbCrLf & "msDS-Cached-Membership-Time-Stamp : " & objUser.Get("msDS-Cached-Membership-Time-Stamp")
    str00 = str00 & vbCrLf & "msDS-KeyVersionNumber : " & objUser.Get("msDS-KeyVersionNumber")
    str00 = str00 & vbCrLf & "adminDescription : " & objUser.Get("adminDescription")
    str00 = str00 & vbCrLf & "msDs-masteredBy : " & objUser.Get("msDs-masteredBy")
    str00 = str00 & vbCrLf & "msDS-MembersForAzRoleBL : " & objUser.Get("msDS-MembersForAzRoleBL")
    str00 = str00 & vbCrLf & "msDS-NCReplCursors : " & objUser.Get("msDS-NCReplCursors")
    str00 = str00 & vbCrLf & "msDS-NCReplInboundNeighbors : " & objUser.Get("msDS-NCReplInboundNeighbors")
    str00 = str00 & vbCrLf & "msDS-NCReplOutboundNeighbors : " & objUser.Get("msDS-NCReplOutboundNeighbors")
    str00 = str00 & vbCrLf & "msDS-NonMembersBL : " & objUser.Get("msDS-NonMembersBL")
    str00 = str00 & vbCrLf & "msDS-ObjectReferenceBL : " & objUser.Get("msDS-ObjectReferenceBL")
    str00 = str00 & vbCrLf & "msDS-OperationsForAzRoleBL : " & objUser.Get("msDS-OperationsForAzRoleBL")
    str00 = str00 & vbCrLf & "msDS-OperationsForAzTaskBL : " & objUser.Get("msDS-OperationsForAzTaskBL")
    str00 = str00 & vbCrLf & "msDS-ReplAttributeMetaData : " & objUser.Get("msDS-ReplAttributeMetaData")
    str00 = str00 & vbCrLf & "adminDisplayName : " & objUser.Get("adminDisplayName")
    str00 = str00 & vbCrLf & "msDS-ReplValueMetaData : " & objUser.Get("msDS-ReplValueMetaData")
    str00 = str00 & vbCrLf & "msDS-Site-Affinity : " & objUser.Get("msDS-Site-Affinity")
    str00 = str00 & vbCrLf & "msDS-SourceObjectDN : " & objUser.Get("msDS-SourceObjectDN")
    str00 = str00 & vbCrLf & "msDS-TasksForAzRoleBL : " & objUser.Get("msDS-TasksForAzRoleBL")
    str00 = str00 & vbCrLf & "msDS-TasksForAzTaskBL : " & objUser.Get("msDS-TasksForAzTaskBL")
    str00 = str00 & vbCrLf & "msDS-User-Account-Control-Computed : " & objUser.Get("msDS-User-Account-Control-Computed")
    str00 = str00 & vbCrLf & "msExchAssistantName : " & objUser.Get("msExchAssistantName")
    str00 = str00 & vbCrLf & "msExchHouseIdentifier : " & objUser.Get("msExchHouseIdentifier")
    str00 = str00 & vbCrLf & "msExchLabeledURI : " & objUser.Get("msExchLabeledURI")
    str00 = str00 & vbCrLf & "msIIS-FTPDir : " & objUser.Get("msIIS-FTPDir")
    str00 = str00 & vbCrLf & "allowedAttributes : " & objUser.Get("allowedAttributes")
    str00 = str00 & vbCrLf & "msIIS-FTPRoot : " & objUser.Get("msIIS-FTPRoot")
    str00 = str00 & vbCrLf & "mSMQDigests : " & objUser.Get("mSMQDigests")
    str00 = str00 & vbCrLf & "mSMQDigestsMig : " & objUser.Get("mSMQDigestsMig")
    str00 = str00 & vbCrLf & "mSMQSignCertificates : " & objUser.Get("mSMQSignCertificates")
    str00 = str00 & vbCrLf & "mSMQSignCertificatesMig : " & objUser.Get("mSMQSignCertificatesMig")
    str00 = str00 & vbCrLf & "msNPAllowDialin : " & objUser.Get("msNPAllowDialin")
    str00 = str00 & vbCrLf & "msNPCallingStationID : " & objUser.Get("msNPCallingStationID")
    str00 = str00 & vbCrLf & "msNPSavedCallingStationID : " & objUser.Get("msNPSavedCallingStationID")
    str00 = str00 & vbCrLf & "msRADIUSCallbackNumber : " & objUser.Get("msRADIUSCallbackNumber")
    str00 = str00 & vbCrLf & "msRADIUSFramedIPAddress : " & objUser.Get("msRADIUSFramedIPAddress")
    str00 = str00 & vbCrLf & "allowedAttributesEffective : " & objUser.Get("allowedAttributesEffective")
    str00 = str00 & vbCrLf & "msRADIUSFramedRoute : " & objUser.Get("msRADIUSFramedRoute")
    str00 = str00 & vbCrLf & "msRADIUSServiceType : " & objUser.Get("msRADIUSServiceType")
    str00 = str00 & vbCrLf & "msRASSavedCallbackNumber : " & objUser.Get("msRASSavedCallbackNumber")
    str00 = str00 & vbCrLf & "msRASSavedFramedIPAddress : " & objUser.Get("msRASSavedFramedIPAddress")
    str00 = str00 & vbCrLf & "msRASSavedFramedRoute : " & objUser.Get("msRASSavedFramedRoute")
    str00 = str00 & vbCrLf & "msSFU30Name : " & objUser.Get("msSFU30Name")
    str00 = str00 & vbCrLf & "msSFU30NisDomain : " & objUser.Get("msSFU30NisDomain")
    str00 = str00 & vbCrLf & "msSFU30PosixMemberOf : " & objUser.Get("msSFU30PosixMemberOf")
    str00 = str00 & vbCrLf & "name : " & objUser.Get("name")
    str00 = str00 & vbCrLf & "netbootSCPBL : " & objUser.Get("netbootSCPBL")
    str00 = str00 & vbCrLf & "allowedChildClasses : " & objUser.Get("allowedChildClasses")
    str00 = str00 & vbCrLf & "networkAddress : " & objUser.Get("networkAddress")
    str00 = str00 & vbCrLf & "nonSecurityMemberBL : " & objUser.Get("nonSecurityMemberBL")
    str00 = str00 & vbCrLf & "ntPwdHistory : " & objUser.Get("ntPwdHistory")
    str00 = str00 & vbCrLf & "o : " & objUser.Get("o")
    str00 = str00 & vbCrLf & "objectGUID : " & objUser.Get("objectGUID")
    str00 = str00 & vbCrLf & "objectVersion : " & objUser.Get("objectVersion")
    str00 = str00 & vbCrLf & "operatorCount : " & objUser.Get("operatorCount")
    str00 = str00 & vbCrLf & "otherFacsimileTelephoneNumber : " & objUser.Get("otherFacsimileTelephoneNumber")
    str00 = str00 & vbCrLf & "otherHomePhone : " & objUser.Get("otherHomePhone")
    str00 = str00 & vbCrLf & "otherIpPhone : " & objUser.Get("otherIpPhone")
    str00 = str00 & vbCrLf & "allowedChildClassesEffective : " & objUser.Get("allowedChildClassesEffective")
    str00 = str00 & vbCrLf & "otherLoginWorkstations : " & objUser.Get("otherLoginWorkstations")
    str00 = str00 & vbCrLf & "otherMailbox : " & objUser.Get("otherMailbox")
    str00 = str00 & vbCrLf & "otherMobile : " & objUser.Get("otherMobile")
    str00 = str00 & vbCrLf & "otherPager : " & objUser.Get("otherPager")
    str00 = str00 & vbCrLf & "otherTelephone : " & objUser.Get("otherTelephone")
    str00 = str00 & vbCrLf & "otherWellKnownObjects : " & objUser.Get("otherWellKnownObjects")
    str00 = str00 & vbCrLf & "ou : " & objUser.Get("ou")
    str00 = str00 & vbCrLf & "ownerBL : " & objUser.Get("ownerBL")
    str00 = str00 & vbCrLf & "pager : " & objUser.Get("pager")
    str00 = str00 & vbCrLf & "partialAttributeDeletionList : " & objUser.Get("partialAttributeDeletionList")
    str00 = str00 & vbCrLf & "altSecurityIdentities : " & objUser.Get("altSecurityIdentities")
    str00 = str00 & vbCrLf & "partialAttributeSet : " & objUser.Get("partialAttributeSet")
    str00 = str00 & vbCrLf & "personalTitle : " & objUser.Get("personalTitle")
    str00 = str00 & vbCrLf & "photo : " & objUser.Get("photo")
    str00 = str00 & vbCrLf & "physicalDeliveryOfficeName : " & objUser.Get("physicalDeliveryOfficeName")
    str00 = str00 & vbCrLf & "possibleInferiors : " & objUser.Get("possibleInferiors")
    str00 = str00 & vbCrLf & "postalAddress : " & objUser.Get("postalAddress")
    str00 = str00 & vbCrLf & "postalCode : " & objUser.Get("postalCode")
    str00 = str00 & vbCrLf & "postOfficeBox : " & objUser.Get("postOfficeBox")
    str00 = str00 & vbCrLf & "preferredDeliveryMethod : " & objUser.Get("preferredDeliveryMethod")
    str00 = str00 & vbCrLf & "preferredLanguage : " & objUser.Get("preferredLanguage")
    str00 = str00 & vbCrLf & "assistant : " & objUser.Get("assistant")
    str00 = str00 & vbCrLf & "preferredOU : " & objUser.Get("preferredOU")
    str00 = str00 & vbCrLf & "primaryGroupID : " & objUser.Get("primaryGroupID")
    str00 = str00 & vbCrLf & "primaryInternationalISDNNumber : " & objUser.Get("primaryInternationalISDNNumber")
    str00 = str00 & vbCrLf & "primaryTelexNumber : " & objUser.Get("primaryTelexNumber")
    str00 = str00 & vbCrLf & "profilePath : " & objUser.Get("profilePath")
    str00 = str00 & vbCrLf & "proxiedObjectName : " & objUser.Get("proxiedObjectName")
    str00 = str00 & vbCrLf & "proxyAddresses : " & objUser.Get("proxyAddresses")
    str00 = str00 & vbCrLf & "pwdLastSet : " & objUser.Get("pwdLastSet")
    str00 = str00 & vbCrLf & "queryPolicyBL : " & objUser.Get("queryPolicyBL")
    str00 = str00 & vbCrLf & "registeredAddress : " & objUser.Get("registeredAddress")
    str00 = str00 & vbCrLf & "instanceType : " & objUser.Get("instanceType")
    str00 = str00 & vbCrLf & "attributeCertificateAttribute : " & objUser.Get("attributeCertificateAttribute")
    str00 = str00 & vbCrLf & "replPropertyMetaData : " & objUser.Get("replPropertyMetaData")
    str00 = str00 & vbCrLf & "replUpToDateVector : " & objUser.Get("replUpToDateVector")
    str00 = str00 & vbCrLf & "repsFrom : " & objUser.Get("repsFrom")
    str00 = str00 & vbCrLf & "repsTo : " & objUser.Get("repsTo")
    str00 = str00 & vbCrLf & "revision : " & objUser.Get("revision")
    str00 = str00 & vbCrLf & "rid : " & objUser.Get("rid")
    str00 = str00 & vbCrLf & "roomNumber : " & objUser.Get("roomNumber")
    str00 = str00 & vbCrLf & "sAMAccountType : " & objUser.Get("sAMAccountType")
    str00 = str00 & vbCrLf & "scriptPath : " & objUser.Get("scriptPath")
    str00 = str00 & vbCrLf & "sDRightsEffective : " & objUser.Get("sDRightsEffective")
    str00 = str00 & vbCrLf & "audio : " & objUser.Get("audio")
    str00 = str00 & vbCrLf & "secretary : " & objUser.Get("secretary")
    str00 = str00 & vbCrLf & "securityIdentifier : " & objUser.Get("securityIdentifier")
    str00 = str00 & vbCrLf & "seeAlso : " & objUser.Get("seeAlso")
    str00 = str00 & vbCrLf & "serialNumber : " & objUser.Get("serialNumber")
    str00 = str00 & vbCrLf & "serverReferenceBL : " & objUser.Get("serverReferenceBL")
    str00 = str00 & vbCrLf & "servicePrincipalName : " & objUser.Get("servicePrincipalName")
    str00 = str00 & vbCrLf & "shadowExpire : " & objUser.Get("shadowExpire")
    str00 = str00 & vbCrLf & "shadowFlag : " & objUser.Get("shadowFlag")
    str00 = str00 & vbCrLf & "shadowInactive : " & objUser.Get("shadowInactive")
    str00 = str00 & vbCrLf & "shadowLastChange : " & objUser.Get("shadowLastChange")
    str00 = str00 & vbCrLf & "badPasswordTime : " & objUser.Get("badPasswordTime")
    str00 = str00 & vbCrLf & "shadowMax : " & objUser.Get("shadowMax")
    str00 = str00 & vbCrLf & "shadowMin : " & objUser.Get("shadowMin")
    str00 = str00 & vbCrLf & "shadowWarning : " & objUser.Get("shadowWarning")
    str00 = str00 & vbCrLf & "showInAddressBook : " & objUser.Get("showInAddressBook")
    str00 = str00 & vbCrLf & "showInAdvancedViewOnly : " & objUser.Get("showInAdvancedViewOnly")
    str00 = str00 & vbCrLf & "sIDHistory : " & objUser.Get("sIDHistory")
    str00 = str00 & vbCrLf & "siteObjectBL : " & objUser.Get("siteObjectBL")
    str00 = str00 & vbCrLf & "sn : " & objUser.Get("sn")  'ラスト ネーム (Last Name)
    str00 = str00 & vbCrLf & "st : " & objUser.Get("st")
    str00 = str00 & vbCrLf & "street : " & objUser.Get("street")
    str00 = str00 & vbCrLf & "badPwdCount : " & objUser.Get("badPwdCount")
    str00 = str00 & vbCrLf & "streetAddress : " & objUser.Get("streetAddress")
    str00 = str00 & vbCrLf & "structuralObjectClass : " & objUser.Get("structuralObjectClass")
    str00 = str00 & vbCrLf & "subRefs : " & objUser.Get("subRefs")
    str00 = str00 & vbCrLf & "subSchemaSubEntry : " & objUser.Get("subSchemaSubEntry")
    str00 = str00 & vbCrLf & "supplementalCredentials : " & objUser.Get("supplementalCredentials")
    str00 = str00 & vbCrLf & "systemFlags : " & objUser.Get("systemFlags")
    str00 = str00 & vbCrLf & "telephoneNumber : " & objUser.Get("telephoneNumber")
    str00 = str00 & vbCrLf & "teletexTerminalIdentifier : " & objUser.Get("teletexTerminalIdentifier")
    str00 = str00 & vbCrLf & "telexNumber : " & objUser.Get("telexNumber")
    str00 = str00 & vbCrLf & "terminalServer : " & objUser.Get("terminalServer")
    str00 = str00 & vbCrLf & "bridgeheadServerListBL : " & objUser.Get("bridgeheadServerListBL")
    str00 = str00 & vbCrLf & "textEncodedORAddress : " & objUser.Get("textEncodedORAddress")
    str00 = str00 & vbCrLf & "thumbnailLogo : " & objUser.Get("thumbnailLogo")
    str00 = str00 & vbCrLf & "thumbnailPhoto : " & objUser.Get("thumbnailPhoto")
    str00 = str00 & vbCrLf & "title : " & objUser.Get("title")
    str00 = str00 & vbCrLf & "tokenGroups : " & objUser.Get("tokenGroups")
    str00 = str00 & vbCrLf & "tokenGroupsGlobalAndUniversal : " & objUser.Get("tokenGroupsGlobalAndUniversal")
    str00 = str00 & vbCrLf & "tokenGroupsNoGCAcceptable : " & objUser.Get("tokenGroupsNoGCAcceptable")
    str00 = str00 & vbCrLf & "uid : " & objUser.Get("uid")
    str00 = str00 & vbCrLf & "uidNumber : " & objUser.Get("uidNumber")
    str00 = str00 & vbCrLf & "unicodePwd : " & objUser.Get("unicodePwd")
    str00 = str00 & vbCrLf & "businessCategory : " & objUser.Get("businessCategory")
    str00 = str00 & vbCrLf & "unixHomeDirectory : " & objUser.Get("unixHomeDirectory")
    str00 = str00 & vbCrLf & "unixUserPassword : " & objUser.Get("unixUserPassword")
    str00 = str00 & vbCrLf & "url : " & objUser.Get("url")
    str00 = str00 & vbCrLf & "userAccountControl : " & objUser.Get("userAccountControl")
    str00 = str00 & vbCrLf & "userCert : " & objUser.Get("userCert")
    str00 = str00 & vbCrLf & "userCertificate : " & objUser.Get("userCertificate")
'    str00 = str00 & vbCrLf & "userParameters : " & objUser.Get("userParameters")
    str00 = str00 & vbCrLf & "userPassword : " & objUser.userPassword
    str00 = str00 & vbCrLf & "userPKCS12 : " & objUser.Get("userPKCS12")
    str00 = str00 & vbCrLf & "userPrincipalName : " & objUser.Get("userPrincipalName")
    str00 = str00 & vbCrLf & "c : " & objUser.Get("c")
    str00 = str00 & vbCrLf & "userSharedFolder : " & objUser.Get("userSharedFolder")
    str00 = str00 & vbCrLf & "userSharedFolderOther : " & objUser.Get("userSharedFolderOther")
    str00 = str00 & vbCrLf & "userSMIMECertificate : " & objUser.Get("userSMIMECertificate")
    str00 = str00 & vbCrLf & "userWorkstations : " & objUser.Get("userWorkstations")
    str00 = str00 & vbCrLf & "uSNChanged : " & objUser.Get("uSNChanged")
    str00 = str00 & vbCrLf & "uSNCreated : " & objUser.Get("uSNCreated")
    str00 = str00 & vbCrLf & "uSNDSALastObjRemoved : " & objUser.Get("uSNDSALastObjRemoved")
    str00 = str00 & vbCrLf & "USNIntersite : " & objUser.Get("USNIntersite")
    str00 = str00 & vbCrLf & "uSNLastObjRem : " & objUser.Get("uSNLastObjRem")
    str00 = str00 & vbCrLf & "uSNSource : " & objUser.Get("uSNSource")
    str00 = str00 & vbCrLf & "canonicalName : " & objUser.Get("canonicalName")
    str00 = str00 & vbCrLf & "wbemPath : " & objUser.Get("wbemPath")
    str00 = str00 & vbCrLf & "wellKnownObjects : " & objUser.Get("wellKnownObjects")
    str00 = str00 & vbCrLf & "whenChanged : " & objUser.Get("whenChanged")
    str00 = str00 & vbCrLf & "whenCreated : " & objUser.Get("whenCreated")
    str00 = str00 & vbCrLf & "wWWHomePage : " & objUser.Get("wWWHomePage")
    str00 = str00 & vbCrLf & "x121Address : " & objUser.Get("x121Address")
    str00 = str00 & vbCrLf & "x500uniqueIdentifier : " & objUser.Get("x500uniqueIdentifier")
    str00 = str00 & vbCrLf & "carLicense : " & objUser.Get("carLicense")
    str00 = str00 & vbCrLf & "co : " & objUser.Get("co")
    str00 = str00 & vbCrLf & "nTSecurityDescriptor : " & objUser.Get("nTSecurityDescriptor")
    str00 = str00 & vbCrLf & "codePage : " & objUser.Get("codePage")
    str00 = str00 & vbCrLf & "comment : " & objUser.Get("comment")
    str00 = str00 & vbCrLf & "company : " & objUser.Get("company")
    str00 = str00 & vbCrLf & "controlAccessRights : " & objUser.Get("controlAccessRights")
    str00 = str00 & vbCrLf & "countryCode : " & objUser.Get("countryCode")
    str00 = str00 & vbCrLf & "createTimeStamp : " & objUser.Get("createTimeStamp")
    str00 = str00 & vbCrLf & "dBCSPwd : " & objUser.Get("dBCSPwd")
    str00 = str00 & vbCrLf & "defaultClassStore : " & objUser.Get("defaultClassStore")
    str00 = str00 & vbCrLf & "department : " & objUser.Get("department")
    str00 = str00 & vbCrLf & "departmentNumber : " & objUser.Get("departmentNumber")
    str00 = str00 & vbCrLf & "objectCategory : " & objUser.Get("objectCategory")
    str00 = str00 & vbCrLf & "description : " & objUser.Get("description")
    str00 = str00 & vbCrLf & "desktopProfile : " & objUser.Get("desktopProfile")
    str00 = str00 & vbCrLf & "destinationIndicator : " & objUser.Get("destinationIndicator")
    str00 = str00 & vbCrLf & "directReports : " & objUser.Get("directReports")
    str00 = str00 & vbCrLf & "displayName : " & objUser.Get("displayName")  '表示名 (Display Name)
    str00 = str00 & vbCrLf & "displayNamePrintable : " & objUser.Get("displayNamePrintable")
    str00 = str00 & vbCrLf & "distinguishedName : " & objUser.Get("distinguishedName")  '識別名 (Distinguished Name)
    str00 = str00 & vbCrLf & "division : " & objUser.Get("division")
    str00 = str00 & vbCrLf & "dSASignature : " & objUser.Get("dSASignature")
    str00 = str00 & vbCrLf & "dSCorePropagationData : " & objUser.Get("dSCorePropagationData")
    str00 = str00 & vbCrLf & "objectClass : " & objUser.Get("objectClass")
    str00 = str00 & vbCrLf & "dynamicLDAPServer : " & objUser.Get("dynamicLDAPServer")
    str00 = str00 & vbCrLf & "employeeID : " & objUser.Get("employeeID")
    str00 = str00 & vbCrLf & "employeeNumber : " & objUser.Get("employeeNumber")
    str00 = str00 & vbCrLf & "employeeType : " & objUser.Get("employeeType")
    str00 = str00 & vbCrLf & "extensionName : " & objUser.Get("extensionName")
    str00 = str00 & vbCrLf & "facsimileTelephoneNumber : " & objUser.Get("facsimileTelephoneNumber")
    str00 = str00 & vbCrLf & "flags : " & objUser.Get("flags")
    str00 = str00 & vbCrLf & "fromEntry : " & objUser.Get("fromEntry")
    str00 = str00 & vbCrLf & "frsComputerReferenceBL : " & objUser.Get("frsComputerReferenceBL")
    str00 = str00 & vbCrLf & "fRSMemberReferenceBL : " & objUser.Get("fRSMemberReferenceBL")
    str00 = str00 & vbCrLf & "objectSid : " & objUser.Get("objectSid")
    str00 = str00 & vbCrLf & "fSMORoleOwner : " & objUser.Get("fSMORoleOwner")
    str00 = str00 & vbCrLf & "garbageCollPeriod : " & objUser.Get("garbageCollPeriod")
    str00 = str00 & vbCrLf & "gecos : " & objUser.Get("gecos")
    str00 = str00 & vbCrLf & "generationQualifier : " & objUser.Get("generationQualifier")
    str00 = str00 & vbCrLf & "gidNumber : " & objUser.Get("gidNumber")
    str00 = str00 & vbCrLf & "givenName : " & objUser.Get("givenName")
    str00 = str00 & vbCrLf & "groupMembershipSAM : " & objUser.Get("groupMembershipSAM")
    str00 = str00 & vbCrLf & "groupPriority : " & objUser.Get("groupPriority")
    str00 = str00 & vbCrLf & "groupsToIgnore : " & objUser.Get("groupsToIgnore")
    str00 = str00 & vbCrLf & "homeDirectory : " & objUser.Get("homeDirectory")
    str00 = str00 & vbCrLf & "sAMAccountName : " & objUser.Get("sAMAccountName")  'ログオン名 (SAM Account Name)
    str00 = str00 & vbCrLf & "homeDrive : " & objUser.Get("homeDrive")
    str00 = str00 & vbCrLf & "homePhone : " & objUser.Get("homePhone")
    str00 = str00 & vbCrLf & "homePostalAddress : " & objUser.Get("homePostalAddress")
    str00 = str00 & vbCrLf & "houseIdentifier : " & objUser.Get("houseIdentifier")
    str00 = str00 & vbCrLf & "info : " & objUser.Get("info")
    str00 = str00 & vbCrLf & "initials : " & objUser.Get("initials")
    str00 = str00 & vbCrLf & "internationalISDNNumber : " & objUser.Get("internationalISDNNumber")
    str00 = str00 & vbCrLf & "ipPhone : " & objUser.Get("ipPhone")
    str00 = str00 & vbCrLf & "isCriticalSystemObject : " & objUser.Get("isCriticalSystemObject")
    str00 = str00 & vbCrLf & "isDeleted : " & objUser.Get("isDeleted")
    str00 = str00 & vbCrLf & "accountExpires : " & objUser.Get("accountExpires")
    str00 = str00 & vbCrLf & "isPrivilegeHolder : " & objUser.Get("isPrivilegeHolder")
    str00 = str00 & vbCrLf & "jpegPhoto : " & objUser.Get("jpegPhoto")
    str00 = str00 & vbCrLf & "l : " & objUser.Get("l")
    str00 = str00 & vbCrLf & "labeledURI : " & objUser.Get("labeledURI")
    str00 = str00 & vbCrLf & "lastKnownParent : " & objUser.Get("lastKnownParent")
    str00 = str00 & vbCrLf & "lastLogoff : " & objUser.Get("lastLogoff")
    str00 = str00 & vbCrLf & "lastLogon : " & objUser.Get("lastLogon")
    str00 = str00 & vbCrLf & "lastLogonTimestamp : " & objUser.Get("lastLogonTimestamp")
    str00 = str00 & vbCrLf & "legacyExchangeDN : " & objUser.Get("legacyExchangeDN")
    str00 = str00 & vbCrLf & "lmPwdHistory : " & objUser.Get("lmPwdHistory")
    str00 = str00 & vbCrLf & "accountNameHistory : " & objUser.Get("accountNameHistory")
    str00 = str00 & vbCrLf & "localeID : " & objUser.Get("localeID")
    str00 = str00 & vbCrLf & "lockoutTime : " & objUser.Get("lockoutTime")
    str00 = str00 & vbCrLf & "loginShell : " & objUser.Get("loginShell")
    str00 = str00 & vbCrLf & "logonCount : " & objUser.Get("logonCount")
    str00 = str00 & vbCrLf & "logonHours : " & objUser.Get("logonHours")
    str00 = str00 & vbCrLf & "logonWorkstation : " & objUser.Get("logonWorkstation")
    str00 = str00 & vbCrLf & "mail : " & objUser.Get("mail")
    str00 = str00 & vbCrLf & "managedObjects : " & objUser.Get("managedObjects")
    str00 = str00 & vbCrLf & "manager : " & objUser.Get("manager")
    str00 = str00 & vbCrLf & "masteredBy : " & objUser.Get("masteredBy")
    On Error GoTo 0

    MsgBox str00

End Function
029. UTF8 文字列の MD5 ハッシュ値

レジストリ [HKEY_CLASSES_ROOT\System.Security.Cryptography.MD5CryptoServiceProvider] を参照している

レジストリ [HKEY_CLASSES_ROOT\System.Text.UTF8Encoding] を参照している

.NET Framework が入っていれば使えるらしい(バージョンは??)

BASP21 や Base64.dll を使えばラクなんですけどね・・・

Set objMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")

'// 文字列を UTF8 にエンコードし、バイト配列に変換
bytes = objUTF8.GetBytes_4("テスト")

'// ハッシュ値を計算(バイナリ)
hash = objMD5.ComputeHash_2((bytes))

'// バイナリを16進数文字列に変換
For i = 1 To LenB(hash)
    a = a & Right("0" & Hex(AscB(MidB(hash, i, 1))), 2)
Next
strText = LCase(a)

'// 結果を返す
WScript.Echo strText
030. UTF8 文字列の SHA1 ハッシュ値
Set objSHA1 = CreateObject("System.Security.Cryptography.SHA1Managed")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")

'// 文字列を UTF8 にエンコードし、バイト配列に変換
bytes = objUTF8.GetBytes_4("テスト")

'// ハッシュ値を計算(バイナリ)
hash = objSHA1.ComputeHash_2((bytes))

'// バイナリを16進数文字列に変換
For i = 1 To LenB(hash)
    a = a & Right("0" & Hex(AscB(MidB(hash, i, 1))), 2)
Next
strText = LCase(a)

'// 結果を返す
WScript.Echo strText
031. UTF8 文字列の SHA256 ハッシュ値
Set objSHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")

'// 文字列を UTF8 にエンコードし、バイト配列に変換
bytes = objUTF8.GetBytes_4("テスト")

'// ハッシュ値を計算(バイナリ)
hash = objSHA256.ComputeHash_2((bytes))

'// バイナリを16進数文字列に変換
For i = 1 To LenB(hash)
    a = a & Right("0" & Hex(AscB(MidB(hash, i, 1))), 2)
Next
strText = LCase(a)

'// 結果を返す
WScript.Echo strText
032. Shift_JIS 文字列の SHA1 ハッシュ値 & ファイルに書き込み

CAPICOM を使うには、マイクロソフトのサイトから "capicom.dll" をダウンロードし、

capicom.dll をパスの通ったフォルダ(C:\Windows\System32 など)に置き、

「ファイル名を指定して実行」から "regsvr32 capicom.dll" を実行する。

Set objSHA1 = CreateObject("System.Security.Cryptography.SHA1Managed")
Set objStrm = CreateObject("ADODB.Stream")
Set objUtil = CreateObject("CAPICOM.Utilities")

'// Shift_JIS 文字列をバイト配列に変換
objStrm.Open
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"  'レジストリ [HKEY_CLASSES_ROOT\MIME\Database\Charset]
objStrm.WriteText "テスト"
' バイナリに変換
objStrm.Position = 0
objStrm.Type = 1  '1:Binary
' バイト配列に変換
bytes = objStrm.Read(objStrm.Size)  '(objStrm.Size) は、なくてもいい
objStrm.Close

'// ハッシュ値を計算(バイナリ)
hash = objSHA1.ComputeHash_2((bytes))

'// バイナリを16進数文字列に変換
strText = LCase(objUtil.BinaryToHex(hash))

'// ファイルに書き込み(バイナリ)
objStrm.Open
objStrm.Type = 1  '1:Binary
objStrm.Write hash
objStrm.SaveToFile "SHA1Managed.txt", 2
objStrm.Close

'// 結果を返す(16進数文字列)
WScript.Echo strText
033. ファイルの SHA1 ハッシュ値

ファイルをドラッグ&ドロップすると SHA1 ハッシュ値を返す

100MB を超えるような大きいファイルは無理? メモリによる?

こんなことせず素直に fciv.exe などを使えばよいのでは?

MD5, SHA256 にしたいときは objSHA1 の参照先を変更するだけ

 →レジストリ [HKEY_CLASSES_ROOT\System.Security.Cryptography.~] を見よ

Set objSHA1 = CreateObject("System.Security.Cryptography.SHA1Managed")
Set objUtil = CreateObject("CAPICOM.Utilities")
Set fso = CreateObject("Scripting.FileSystemObject")

'// Arguments : (0)Input file
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

'// ファイルをバイト配列に変換
Set objStrm = CreateObject("ADODB.Stream")
objStrm.Open
objStrm.Type = 1  '1:Binary
objStrm.LoadFromFile(objArgs(0))
bytes = objStrm.Read
objStrm.Close

'// ハッシュ値を計算(バイナリ)
hash = objSHA1.ComputeHash_2((bytes))

'// バイナリを16進数文字列に変換
strText = LCase(objUtil.BinaryToHex(hash))

'// 結果を返す
WScript.Echo strText
034. Shift_JIS 文字列 → BASE64 エンコード

.NET Framework ToBase64Transform クラス

http://msdn.microsoft.com/ja-jp/library/system.security.cryptography.tobase64transform.aspx

Set objBase64 = CreateObject("System.Security.Cryptography.ToBase64Transform")
Set objStrm = CreateObject("ADODB.Stream")

i_size = objBase64.InputBlockSize
o_size = objBase64.OutputBlockSize

'//---------------------------------------------------------------------------//
'// CanTransformMultipleBlocks = False の場合、1ブロックずつしかエンコードできない(たぶん)
'//---------------------------------------------------------------------------//

MsgBox "CanTransformMultipleBlocks = " & objBase64.CanTransformMultipleBlocks

'//---------------------------------------------------------------------------//
'// Shift_JIS 文字列をバイト配列に変換
'//---------------------------------------------------------------------------//

objStrm.Open

' Shift_JIS 文字列をインプット
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"  'レジストリ [HKEY_CLASSES_ROOT\MIME\Database\Charset]
objStrm.WriteText "テスト"

' バイナリに変換
objStrm.Position = 0
objStrm.Type = 1  '1:Binary

' バイト配列に変換
bytes = objStrm.Read

objStrm.Close

'//---------------------------------------------------------------------------//
'// BASE64 エンコード
'//---------------------------------------------------------------------------//

objStrm.Open
objStrm.Type = 1  '1:Binary

' n_block = ブロック数
If LenB(bytes) Mod i_size = 0 Then n_block = LenB(bytes) / i_size Else n_block = LenB(bytes) \ i_size + 1

' 1ブロックごとに処理
For i = 0 To n_block - 1
    ' b_len = 1ブロックのバイト数(基本は i_size = 3 bytes、最後だけ短くなる)
    If LenB(bytes) < (i + 1) * i_size Then b_len = LenB(bytes) - i * i_size Else b_len = i_size
    ' BASE64 エンコード(1ブロックずつ)
    data = objBase64.TransformFinalBlock((bytes), i * i_size, b_len)
    ' オブジェクト(ADODB.Stream)にバイナリを書き込む
    objStrm.Write data
Next

' ASCII 文字列に変換
objStrm.Position = 0
objStrm.Type = 2  '2:Text
objStrm.Charset = "ascii"  'レジストリ [HKEY_CLASSES_ROOT\MIME\Database\Charset]
strText = objStrm.ReadText

objStrm.Close

'//---------------------------------------------------------------------------//
'// 結果を返す
'//---------------------------------------------------------------------------//

WScript.Echo strText

▽その2 (2017.10.10 追記)

strText = "base64 エンコード・デコード"
WScript.Echo base64_encode(strText)

'//-------------------------------------------------------//
'// shift_jis -> base64 エンコード
'//-------------------------------------------------------//
Function base64_encode(strText)
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    Set objStrm = CreateObject("ADODB.Stream")
    '// ADODB.StreamTypeEnum
    Const adTypeBinary = 1
    Const adTypeText = 2
    '// shift_jis 読み込み
    objStrm.Open
    objStrm.Type = adTypeText
    objStrm.Charset = "shift_jis"
    objStrm.WriteText strText
    objStrm.Position = 0
    objStrm.Type = adTypeBinary
    '// shift_jis -> base64
    Set objElement = xmlDoc.CreateElement("dummy")
    objElement.DataType = "bin.base64"
    objElement.NodeTypedValue = objStrm.Read
    strBase = objElement.Text
    '// Return
    base64_encode = strBase
End Function
035. Shift_JIS 文字列 ← BASE64 デコード

.NET Framework FromBase64Transform クラス

http://msdn.microsoft.com/ja-jp/library/system.security.cryptography.frombase64transform.aspx
Set objBase64 = CreateObject("System.Security.Cryptography.FromBase64Transform")
Set objStrm = CreateObject("ADODB.Stream")

'//---------------------------------------------------------------------------//
'// ASCII 文字列をバイト配列に変換
'//---------------------------------------------------------------------------//

objStrm.Open

' ASCII 文字列をインプット
objStrm.Type = 2  '2:Text
objStrm.Charset = "ascii"  'レジストリ [HKEY_CLASSES_ROOT\MIME\Database\Charset]
objStrm.WriteText "g2WDWINn"

' バイナリに変換
objStrm.Position = 0
objStrm.Type = 1  '1:Binary

' バイト配列に変換
bytes = objStrm.Read
b_len = objStrm.Size

objStrm.Close

'//---------------------------------------------------------------------------//
'// BASE64 デコード
'//---------------------------------------------------------------------------//

objStrm.Open

' バイト配列をインプット
objStrm.Type = 1  '1:Binary
objStrm.Write objBase64.TransformFinalBlock((bytes), 0, b_len)

' Shift_JIS 文字列に変換
objStrm.Position = 0
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"  'レジストリ [HKEY_CLASSES_ROOT\MIME\Database\Charset]
strText = objStrm.ReadText

objStrm.Close

'//---------------------------------------------------------------------------//
'// 結果を返す
'//---------------------------------------------------------------------------//

WScript.Echo strText

▽その2 (2017.10.10 追記)

strBase = "YmFzZTY0IINHg5ODUoFbg2iBRYNmg1KBW4No"
WScript.Echo base64_decode(strBase)

'//-------------------------------------------------------//
'// base64 -> shift_jis デコード
'//-------------------------------------------------------//
Function base64_decode(strBase)
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    Set objStrm = CreateObject("ADODB.Stream")
    '// ADODB.StreamTypeEnum
    Const adTypeBinary = 1
    Const adTypeText = 2
    '// base64 読み込み
    Set objElement = xmlDoc.CreateElement("dummy")
    objElement.DataType = "bin.base64"
    objElement.Text = strBase
    '// base64 -> shift_jis
    objStrm.Open
    objStrm.Type = adTypeBinary
    objStrm.Write objElement.NodeTypedValue
    objStrm.Position = 0
    objStrm.Type = adTypeText
    objStrm.Charset = "shift_jis"
    strText = objStrm.ReadText
    '// Return
    base64_decode = strText
End Function
036. [CAPICOM] Shift_JIS 文字列のハッシュ値

CAPICOM HashedData Object

http://msdn.microsoft.com/en-us/library/aa382440.aspx

CAPICOM Utilities Object

http://msdn.microsoft.com/en-us/library/aa388176.aspx

CAPICOM_HASH_ALGORITHM

http://msdn.microsoft.com/en-us/library/aa375694.aspx

'//---------------------------------------------//
'// CAPICOM_HASH_ALGORITHM
'//---------------------------------------------//
'   0 : SHA1
'   1 : MD2
'   2 : MD4
'   3 : MD5
'   4 : SHA-256
'   5 : SHA-384
'   6 : SHA-512
'//---------------------------------------------//

Set objHash = CreateObject("CAPICOM.HashedData")
Set objUtil = CreateObject("CAPICOM.Utilities")
Set objStrm = CreateObject("ADODB.Stream")

'// Shift_JIS 文字列をバイト配列に変換
objStrm.Open
' Shift_JIS 文字列をインプット
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"
objStrm.WriteText "テスト"
' バイナリに変換
objStrm.Position = 0
objStrm.Type = 1  '1:Binary
' バイト配列に変換
bytes = objStrm.Read
objStrm.Close

'// バイト配列をバイナリ文字列に変換
bstr = objUtil.ByteArrayToBinaryString(bytes)

'// ハッシュ値
objHash.Algorithm = 0  '0:SHA1
objHash.Hash (bstr)
strText = LCase(objHash.Value)

'// 結果を返す
WScript.Echo strText
037. [CAPICOM] Shift_JIS 文字列の BASE64 デコード
Set objUtil = CreateObject("CAPICOM.Utilities")

'// BASE64 デコード
data = objUtil.Base64Decode("g2WDWINn")

'// 16進数文字列に変換
data = objUtil.BinaryToHex(data)

'// 16進数文字列を Shift_JIS 文字列に変換
For i = 1 To Len(data) / 2
    strHEX = Mid(data, i * 2 - 1, 2)
    intHEX = CInt("&H" & strHEX)
    '// Shift_JIS 2バイト文字の処理
    If (&H81 <= intHEX And intHEX <= &H9F) Or (&HE0 <= intHEX And intHEX <= &HFC) Then
        strHEX = strHEX & Mid(data, i * 2 + 1, 2)
        i = i + 1
    End If
    strText = strText & Chr("&H" & strHEX)
Next

'// 結果を返す
WScript.Echo strText
038. [CAPICOM] Shift_JIS 文字列の BASE64 デコード(その2)
Set objUtil = CreateObject("CAPICOM.Utilities")
Set objStrm = CreateObject("ADODB.Stream")

'//---------------------------------------------------------------------------//
'// BASE64 デコード
'//---------------------------------------------------------------------------//

data = objUtil.Base64Decode("g2WDWINn")

'//---------------------------------------------------------------------------//
'// 16進数文字列に変換
'//---------------------------------------------------------------------------//

data = objUtil.BinaryToHex(data)

'//---------------------------------------------------------------------------//
'// 16進数文字列を Shift_JIS 文字列に変換
'//---------------------------------------------------------------------------//

' 16進数文字列をインプット
objStrm.Open
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"

For i = 1 To Len(data) / 2
    strHEX = Mid(data, i * 2 - 1, 2)
    intHEX = CInt("&H" & strHEX)
    ' Shift_JIS 2バイト文字の処理
    If (&H81 <= intHEX And intHEX <= &H9F) Or (&HE0 <= intHEX And intHEX <= &HFC) Then
        strHEX = strHEX & Mid(data, i * 2 + 1, 2)
        i = i + 1
    End If
    objStrm.WriteText Chr("&H" & strHEX)
Next

' Shift_JIS 文字列に変換
objStrm.Position = 0
objStrm.Type = 2  '2:Text
objStrm.Charset = "shift_jis"
strText = objStrm.ReadText
objStrm.Close

'//---------------------------------------------------------------------------//
'// 結果を返す
'//---------------------------------------------------------------------------//

WScript.Echo strText
039. IEで開いているアドレスを取得
2011.10.01

Internet Explorer でアドレスバーが隠されているサイトに対して、アドレス(URL)を取得する。

Set objShell = CreateObject("Shell.Application")

For Each objWindow In objShell.Windows
    If TypeName(objWindow.Document) = "HTMLDocument" Then
        x = MsgBox(objWindow.FullName & vbCrLf & objWindow.LocationURL, , objWindow.Document.Title)
    End If
Next
040. ドメインユーザのパスワード有効期限
2014.10.07

注)ドメインに参加しているときだけ使える。

Set objNT = CreateObject("WinNTSystemInfo")
'// http://msdn.microsoft.com/en-us/library/aa746345.aspx
'   objNT.UserName
'   objNT.ComputerName
'   objNT.DomainName
'   objNT.PDC

Set objAD = CreateObject("ADSystemInfo")
'// http://msdn.microsoft.com/en-us/library/aa705962.aspx
'   objAD.UserName
'   objAD.ComputerName
'   objAD.SiteName
'   objAD.DomainShortName
'   objAD.DomainDNSName
'   objAD.ForestDNSName
'   objAD.PDCRoleOwner
'   objAD.SchemaRoleOwner
'   objAD.IsNativeMode

Set objUserNT = GetObject("WinNT://" & objNT.DomainName & "/" & objNT.UserName)
Set objUserAD = GetObject("LDAP://" & objAD.UserName)

MsgBox objAD.UserName & vbCrLf & vbCrLf _
     & "アカウント有効期限:" & objUserAD.AccountExpirationDate & vbCrLf _
     & "パスワード最終更新:" & objUserAD.PasswordLastChanged & vbCrLf _
     & "パスワード有効期限:" & objUserNT.PasswordExpirationDate & vbCrLf _
     & "パスワード有効期間:" & Fix(objUserNT.PasswordExpirationDate - objUserAD.PasswordLastChanged) & "日"

Set objUserNT = Nothing
Set objUserAD = Nothing
Set objNT = Nothing
Set objAD = Nothing
041. UTF-8 ファイル読み取り ⇒ Shift_JIS ファイル書き出し
2015.05.12
'// Library ADODB
'//     C:\Program Files\Common Files\System\ado\msado28.tlb
'//     Microsoft ActiveX Data Objects 2.8 Library

'// Arguments : (0)Input File, (2)Output File
Set objArgs = WScript.Arguments

Set objStrm = WScript.CreateObject("ADODB.Stream")

'// ADODB.StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'// ADODB.SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

'// UTF-8 ファイル読み取り
objStrm.Open
objStrm.Type = adTypeText
objStrm.Charset = "UTF-8"
objStrm.LoadFromFile objArgs(0)
strText = objStrm.ReadText
objStrm.Close

'// Shift_JIS ファイル書き出し
objStrm.Open
objStrm.Position = 0
objStrm.Charset = "Shift_JIS"
objStrm.WriteText strText
objStrm.SaveToFile objArgs(1), adSaveCreateOverWrite
objStrm.Close

Set objStrm = Nothing
042. エクセルのシート名、インデックス、オブジェクト名
2015.07.20
'// Arguments : (0)Excel File
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

Set objExcel = CreateObject("Excel.Application")

'// Excel File を開く
Set objWorkbook = objExcel.Workbooks.Open(objArgs(0)): objWorkbook.Saved = True

MsgBox "Worksheets.Count = " & objWorkbook.Worksheets.Count, , objWorkbook.Name

For Each objWorksheet In objWorkbook.Worksheets
    a = ""
    a = a & vbCrLf & "シート名 = " & objWorksheet.Name
    a = a & vbCrLf & "インデックス = " & objWorksheet.Index
    a = a & vbCrLf & "オブジェクト名 = " & objWorksheet.CodeName  'VBScript では取れないことも
    MsgBox a
Next

objWorkbook.Close
Set objExcel = Nothing
043. Jet, ACE データベースエンジンでエクセル読み書き
2016.05.30

Microsoft Office をインストールしなくても Excel をデータベースとして扱うことで読み書きできる。

Web アプリなどサーバーサイドで実行する場合、マルチスレッドでエラーが出るようならシングルスレッドにする。


▽Microsoft Access 2010 を使用したデータ プログラミング

https://msdn.microsoft.com/ja-jp/library/office/ff965871(v=office.14).aspx

▽Microsoft Access 2010 Runtime

https://www.microsoft.com/ja-jp/download/details.aspx?id=10910

▽Microsoft Access データベース エンジン 2010 再頒布可能コンポーネント

https://www.microsoft.com/ja-jp/download/details.aspx?id=13255

※使用制限あり

▽Visual Basic .NET と ADO.NET を使用して Excel ブックのレコードの取得と変更を行う方法

https://support.microsoft.com/ja-jp/kb/316934

▽Microsoft.Jet.OLEDB.4.0

ODBCJT32.DLL / Microsoft Excel Driver (*.xls)

※Jet データベース エンジンはマルチスレッド非対応

https://msdn.microsoft.com/ja-jp/data/gg607262.aspx

▽Microsoft.ACE.OLEDB.12.0

ACEODBC.DLL / Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)

▽データ ソース (ODBC)

-- 32bit OS / 32bit版

%windir%\system32\odbcad32.exe

-- 64bit OS / 32bit版

%windir%\SysWOW64\odbcad32.exe


Jetサンプル.xls, ACEサンプル.xlsx.zip (11KB)

▽Microsoft.Jet.OLEDB.4.0 / SELECT

Set fso = CreateObject("Scripting.FileSystemObject")
Set objADO = CreateObject("ADODB.Connection")

'// Excel File
excel_path = fso.GetParentFolderName(WScript.ScriptFullName) & "\Jetサンプル.xls"

'// ConnectionString
strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0;HDR=NO;""; Data Source=" & excel_path & ";"

'// 指定セルから読み取り
strSQL = "SELECT * FROM [Sheet1$A3:A3]"

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to Database
objADO.Open strCon

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// Read from Excel File
If rs.EOF Then
    x = MsgBox("該当データがありません。" & vbCrLf & vbCrLf & sql_file, 64, strTitle)
    WScript.Quit
Else
    Do Until rs.EOF
        For i = 0 To rs.Fields.Count - 1
            MsgBox rs.Fields(i).Name & vbCrLf & rs.Fields(i).Value
        Next
        rs.Movenext
    Loop
End If

'// Disconnect from Database
objADO.Close

WScript.Quit

▽Microsoft.Jet.OLEDB.4.0 / UPDATE, INSERT

Set fso = CreateObject("Scripting.FileSystemObject")
Set objADO = CreateObject("ADODB.Connection")

'// Excel File
excel_path = fso.GetParentFolderName(WScript.ScriptFullName) & "\Jetサンプル.xls"

'// ConnectionString
strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0;HDR=NO;""; Data Source=" & excel_path & ";"

'// 指定セルへ書き込み
strSQL = "UPDATE [Sheet1$A3:A3] SET F1 = Now"
'// 行追加
'strSQL = "INSERT INTO [Sheet1$A0:A0] VALUES (Now)"

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to Database
objADO.Open strCon

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// ADO properties
a = "-- ADO properties --"
a = a & vbCrLf & "ConnectionString : " & objADO.ConnectionString
a = a & vbCrLf & "Attributes : " & objADO.Attributes
a = a & vbCrLf & "CommandTimeout : " & objADO.CommandTimeout
a = a & vbCrLf & "ConnectionTimeout : " & objADO.ConnectionTimeout
a = a & vbCrLf & "CursorLocation : " & objADO.CursorLocation
a = a & vbCrLf & "DefaultDatabase : " & objADO.DefaultDatabase
a = a & vbCrLf & "IsolationLevel : " & objADO.IsolationLevel
a = a & vbCrLf & "Mode : " & objADO.Mode
a = a & vbCrLf & "Provider : " & objADO.Provider
a = a & vbCrLf & "State : " & objADO.State
a = a & vbCrLf & "Version : " & objADO.Version
MsgBox a

'// Disconnect from Database
objADO.Close

WScript.Quit

▽Microsoft.ACE.OLEDB.12.0 / SELECT

Set fso = CreateObject("Scripting.FileSystemObject")
Set objADO = CreateObject("ADODB.Connection")

'// Excel File
excel_path = fso.GetParentFolderName(WScript.ScriptFullName) & "\ACEサンプル.xlsx"

'// ConnectionString
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Extended Properties=""Excel 12.0 Xml;HDR=NO;""; Data Source=" & excel_path & ";"

'// 指定セルから読み取り
strSQL = "SELECT * FROM [Sheet1$A3:A3]"

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to Database
objADO.Open strCon

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// Read from Excel File
If rs.EOF Then
    x = MsgBox("該当データがありません。" & vbCrLf & vbCrLf & sql_file, 64, strTitle)
    WScript.Quit
Else
    Do Until rs.EOF
        For i = 0 To rs.Fields.Count - 1
            MsgBox rs.Fields(i).Name & vbCrLf & rs.Fields(i).Value
        Next
        rs.Movenext
    Loop
End If

'// Disconnect from Database
objADO.Close

WScript.Quit

▽Microsoft.ACE.OLEDB.12.0 / UPDATE, INSERT

Set fso = CreateObject("Scripting.FileSystemObject")
Set objADO = CreateObject("ADODB.Connection")

'// Excel File
excel_path = fso.GetParentFolderName(WScript.ScriptFullName) & "\ACEサンプル.xlsx"

'// ConnectionString
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Extended Properties=""Excel 12.0 Xml;HDR=NO;""; Data Source=" & excel_path & ";"

'// 指定セルへ書き込み
strSQL = "UPDATE [Sheet1$A3:A3] SET F1 = Now"
'// 行追加
'strSQL = "INSERT INTO [Sheet1$A:C] VALUES (""123"", Now, ""さかた"")"
'// WHERE 指定
'strSQL = "UPDATE [Sheet1$] SET F3 = ""やまもと"" WHERE F1 = ""123"""

'// Unrestricted connection timeout
objADO.CommandTimeout = 0

'// Connect to Database
objADO.Open strCon

'// Execute SQL
Set rs = objADO.Execute(strSQL)

'// ADO properties
a = "-- ADO properties --"
a = a & vbCrLf & "ConnectionString : " & objADO.ConnectionString
a = a & vbCrLf & "Attributes : " & objADO.Attributes
a = a & vbCrLf & "CommandTimeout : " & objADO.CommandTimeout
a = a & vbCrLf & "ConnectionTimeout : " & objADO.ConnectionTimeout
a = a & vbCrLf & "CursorLocation : " & objADO.CursorLocation
a = a & vbCrLf & "DefaultDatabase : " & objADO.DefaultDatabase
a = a & vbCrLf & "IsolationLevel : " & objADO.IsolationLevel
a = a & vbCrLf & "Mode : " & objADO.Mode
a = a & vbCrLf & "Provider : " & objADO.Provider
a = a & vbCrLf & "State : " & objADO.State
a = a & vbCrLf & "Version : " & objADO.Version
MsgBox a

'// Disconnect from Database
objADO.Close

WScript.Quit
044. Shift_JIS 文字列 → HEX(16進数)エンコード
2017.10.10

▽その1

strText = "hex(16進数)エンコード・デコード"
WScript.Echo hex_encode(strText)

'//-------------------------------------------------------//
'// shift_jis -> hex エンコード
'//-------------------------------------------------------//
Function hex_encode(strText)
    '// shift_jis -> hex
    For i = 1 To Len(strText)
        aaa = Hex(Asc(Mid(strText, i, 1)))
        If Len(aaa) Mod 2 = 1 Then aaa = "0" & aaa
        strHEX = strHEX & aaa
    Next
    '// Return
    hex_encode = strHEX
End Function

▽その2

strText = "hex(16進数)エンコード・デコード"
WScript.Echo hex_encode(strText)

'//-------------------------------------------------------//
'// shift_jis -> hex エンコード
'//-------------------------------------------------------//
Function hex_encode(strText)
    Set objStrm = CreateObject("ADODB.Stream")
    Set objUtil = CreateObject("CAPICOM.Utilities")
    '// ADODB.StreamTypeEnum
    Const adTypeBinary = 1
    Const adTypeText = 2
    '// shift_jis -> binary
    objStrm.Open
    objStrm.Type = adTypeText
    objStrm.Charset = "shift_jis"
    objStrm.WriteText strText
    objStrm.Position = 0
    objStrm.Type = adTypeBinary
    binary = objStrm.Read
    '// binary -> hex
    strHEX = objUtil.BinaryToHex(binary)
    '// Return
    hex_encode = strHEX
End Function

▽その3

strText = "hex(16進数)エンコード・デコード"
WScript.Echo hex_encode(strText)

'//-------------------------------------------------------//
'// shift_jis -> hex エンコード
'//-------------------------------------------------------//
Function hex_encode(strText)
    Set objStrm = CreateObject("ADODB.Stream")
    '// ADODB.StreamTypeEnum
    Const adTypeBinary = 1
    Const adTypeText = 2
    '// shift_jis -> binary
    objStrm.Open
    objStrm.Type = adTypeText
    objStrm.Charset = "shift_jis"
    objStrm.WriteText strText
    objStrm.Position = 0
    objStrm.Type = adTypeBinary
    binary = objStrm.Read
    '// binary -> hex
    For i = 1 To LenB(binary)
        strHEX = strHEX & Right("0" & Hex(AscB(MidB(binary, i, 1))), 2)
    Next
    '// Return
    hex_encode = strHEX
End Function
045. Shift_JIS 文字列 ← HEX(16進数)デコード
2017.10.10

▽その1

strHEX = "6865788169313690699094816A834783938352815B8368814583668352815B8368"
WScript.Echo hex_decode(strHEX)

'//-------------------------------------------------------//
'// hex -> shift_jis デコード
'//-------------------------------------------------------//
Function hex_decode(strHEX)
    '// hex -> shift_jis
    For i = 1 To Len(strHEX) / 2
        aaa = Mid(strHEX, i * 2 - 1, 2)
        '// 2バイト文字
        If Left(aaa, 1) = "8" Or Left(aaa, 1) = "9" Or Left(aaa, 1) = "E" Or Left(aaa, 1) = "F" Then
            aaa = Mid(strHEX, i * 2 - 1, 4)
            i = i + 1
        End If
        strText = strText & Chr("&H" & aaa)
    Next
    '// Return
    hex_decode = strText
End Function

▽その2

strHEX = "6865788169313690699094816A834783938352815B8368814583668352815B8368"
WScript.Echo hex_decode(strHEX)

'//-------------------------------------------------------//
'// hex -> shift_jis デコード
'//-------------------------------------------------------//
Function hex_decode(strHEX)
    Set objStrm = CreateObject("ADODB.Stream")
    Set objUtil = CreateObject("CAPICOM.Utilities")
    '// ADODB.StreamTypeEnum
    Const adTypeBinary = 1
    Const adTypeText = 2
    '// hex -> shift_jis
    objStrm.Open
    objStrm.Type = adTypeBinary
    objStrm.Write objUtil.BinaryStringToByteArray(objUtil.HexToBinary(strHEX))
    objStrm.Position = 0
    objStrm.Type = adTypeText
    objStrm.Charset = "shift_jis"
    strText = objStrm.ReadText
    '// Return
    hex_decode = strText
End Function
046. バイナリ → BASE64 エンコード
2017.10.10

JPG などのファイルをドラッグ&ドロップ

72桁で改行されたテキストファイルが作成される

'// Arguments : (0)Input file
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

Set fso = CreateObject("Scripting.FileSystemObject")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objStrm = CreateObject("ADODB.Stream")

'// ADODB.StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'// binary ファイル読み込み
objStrm.Open
objStrm.Type = adTypeBinary
objStrm.Position = 0
objStrm.LoadFromFile objArgs(0)

Set objElement = xmlDoc.CreateElement("dummy")
objElement.DataType = "bin.base64"
objElement.NodeTypedValue = objStrm.Read

'// text ファイル書き出し
Set objFile = fso.CreateTextFile(objArgs(0) & "≪base64エンコード≫.txt", True)
objFile.Write objElement.Text

Set objElement = Nothing
Set xmlDoc = Nothing
Set objFile = Nothing
Set objStrm = Nothing

MsgBox "おわりました"

WScript.Quit
047. バイナリ ← BASE64 デコード
2017.10.10

BASE64 でエンコードされたテキストファイルをドラッグ&ドロップ

'// Arguments : (0)Input file
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

Set fso = CreateObject("Scripting.FileSystemObject")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objStrm = CreateObject("ADODB.Stream")

'// ADODB.StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'// ADODB.SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

'// text ファイル読み込み
Set objFile = fso.OpenTextFile(objArgs(0), 1, False)

'// binary ファイル書き出し
Set objElement = xmlDoc.CreateElement("dummy")
objElement.DataType = "bin.base64"
objElement.Text = objFile.ReadAll

objStrm.Open
objStrm.Type = adTypeBinary
objStrm.Position = 0
objStrm.Write objElement.NodeTypedValue
objStrm.SaveToFile objArgs(0) & "≪base64デコード≫", adSaveCreateOverWrite

Set objElement = Nothing
Set xmlDoc = Nothing
Set objFile = Nothing
Set objStrm = Nothing

MsgBox "おわりました"

WScript.Quit
048. バイナリ → HEX(16進数)エンコード
2017.10.10

JPG などのファイルをドラッグ&ドロップ

改行なしのテキストファイルが作成される

'// Arguments : (0)Input file
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

Set fso = CreateObject("Scripting.FileSystemObject")
Set objStrm = CreateObject("ADODB.Stream")
Set objUtil = CreateObject("CAPICOM.Utilities")

'// ADODB.StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'// binary ファイル読み込み
objStrm.Open
objStrm.Type = adTypeBinary
objStrm.Position = 0
objStrm.LoadFromFile objArgs(0)

'// text ファイル書き出し
Set objFile = fso.CreateTextFile(objArgs(0) & "≪hexエンコード≫.txt", True)
objFile.Write objUtil.BinaryToHex(objStrm.Read)

Set objFile = Nothing
Set objStrm = Nothing

MsgBox "おわりました"

WScript.Quit
049. バイナリ ← HEX(16進数)デコード
2017.10.10

HEX(16進数)でエンコードされたテキストファイルをドラッグ&ドロップ

'// Arguments : (0)Input file
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then WScript.Quit

Set fso = CreateObject("Scripting.FileSystemObject")
Set objStrm = CreateObject("ADODB.Stream")
Set objUtil = CreateObject("CAPICOM.Utilities")

'// ADODB.StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'// ADODB.SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

'// text ファイル読み込み
Set objFile = fso.OpenTextFile(objArgs(0), 1, False)

'// binary ファイル書き出し
objStrm.Open
objStrm.Type = adTypeBinary
objStrm.Position = 0
objStrm.Write objUtil.BinaryStringToByteArray(objUtil.HexToBinary(objFile.ReadAll))
objStrm.SaveToFile objArgs(0) & "≪hexデコード≫", adSaveCreateOverWrite

Set objFile = Nothing
Set objStrm = Nothing

MsgBox "おわりました"

WScript.Quit