VBScript (Microsoft Visual Basic Scripting Edition)
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 & " １／３")
If strReadFile = "" Then WScript.Quit
End If
intStart = InputBox("先頭行を入力して下さい", strTitle & " ２／３", 1) + 0
If intStart = "" Then WScript.Quit
intLines = InputBox("切り出す行数を入力して下さい", strTitle & " ３／３", 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
|
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=新宿区西新宿６丁目９"
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. ドメインユーザ パスワード変更
▽その１（ドメコン省略）
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
objUser.ChangePassword "変更前パスワード", "変更後パスワード"
|
▽その２
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("ＳＱＬファイル名を入力して下さい", strTitle & " １／４")
strSqlFile = Trim(strSqlFile)
If strSqlFile = "" Then WScript.Quit
End If
'// Output File
strOutFile = fso.GetBaseName(strSqlFile) & ".txt"
strOutFile = InputBox("出力ファイル名を入力して下さい", strTitle & " ２／４", strOutFile)
strOutFile = Trim(strOutFile)
If strOutFile = "" Then WScript.Quit
'// Input User ID
uid = InputBox("ユーザーＩＤを入力して下さい", strTitle & " ３／４", strUID)
uid = Trim(uid)
If uid = "" Then WScript.Quit
'// Input Password
pwd = InputBox("パスワードを入力して下さい", strTitle & " ４／４")
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("ＳＱＬファイル名を入力して下さい", strTitle & " １／３")
strSqlFile = Trim(strSqlFile)
If strSqlFile = "" Then WScript.Quit
End If
'// Input User ID
uid = InputBox("ユーザーＩＤを入力して下さい", strTitle & " ２／３", strUID)
uid = Trim(uid)
If uid = "" Then WScript.Quit
'// Input Password
pwd = InputBox("パスワードを入力して下さい", strTitle & " ３／３")
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
|
▽その２ （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
|
▽その２ （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 デコード（その２）
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で開いているアドレスを取得
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. ドメインユーザのパスワード有効期限
注）ドメインに参加しているときだけ使える。
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 ファイル書き出し
'// 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. エクセルのシート名、インデックス、オブジェクト名
'// 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 データベースエンジンでエクセル読み書き
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
※使用制限あり
▽Microsoft.Jet.OLEDB.4.0
ODBCJT32.DLL / Microsoft Excel Driver (*.xls)
※Jet データベース エンジンはマルチスレッド非対応
▽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進数）エンコード
▽その１
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
|
▽その２
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
|
▽その３
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進数）デコード
▽その１
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
|
▽その２
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 エンコード
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 デコード
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進数）エンコード
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進数）デコード
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
|
050. 暗号・複合
Rijndael（ラインダール）を使用する際、暗号文とIV（初期化ベクター）の２つを相手先に渡し、
Key（共有キー）は外部に漏れないようお互い保持。もしくは SHA256(SessionID＋暗号ソルト) のようにルールに則って作成できるようにする。
初期ベクターは基本的にランダム設定。
ここでは Key に SHA256 を利用した。共有キーのビット数を SHA256 と同じ 256bit としたため。
名前空間: System.Security.Cryptography
アセンブリ: mscorlib (mscorlib.dll 内)
C:\Windows\Microsoft.NET\Framework\v2.0.50727\mscorlib.tlb
C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb
など
▽System.Security.Cryptography 名前空間
https://msdn.microsoft.com/ja-jp/library/system.security.cryptography(v=vs.110).aspx
'//------------------------------------------------------------//
'// mscorlib.CipherMode
Const CipherMode_CBC = 1
Const CipherMode_ECB = 2
Const CipherMode_OFB = 3
Const CipherMode_CFB = 4
Const CipherMode_CTS = 5
'// Public
Public iv, key
'//------------------------------------------------------------//
key = sha256("≪秘密≫共有キー：256bit／バイト配列：32バイト／16進数：64バイト")
plain_txt = "暗号化し、平文に戻します。"
encrypted = encrypt(plain_txt, key)
decrypted = decrypt(encrypted, iv, key)
MsgBox "【平文】" & plain_txt & vbCrLf _
& "【暗号】" & encrypted & vbCrLf _
& "【IV:128bit】" & iv & vbCrLf _
& "【Key:256bit】" & key & vbCrLf _
& "【復号】" & decrypted
WScript.Quit
'//-------------------------------------------------------//
'// 暗号
'//-------------------------------------------------------//
Function encrypt(txt, key)
Set objRijndael = CreateObject("System.Security.Cryptography.RijndaelManaged")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
bytes = objUTF8.GetBytes_4(txt)
objRijndael.Mode = CipherMode_CBC
objRijndael.BlockSize = 128
objRijndael.KeySize = 256
objRijndael.IV '初期ベクター：ランダムに設定
objRijndael.Key = hex2bytes(key)
encrypt = bytes2hex(objRijndael.CreateEncryptor.TransformFinalBlock((bytes), 0, LenB(bytes)))
iv = bytes2hex(objRijndael.IV)
Set objUTF8 = Nothing
Set objRijndael = Nothing
End Function
'//-------------------------------------------------------//
'// 復号
'//-------------------------------------------------------//
Function decrypt(xhex, iv, key)
Set objRijndael = CreateObject("System.Security.Cryptography.RijndaelManaged")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
bytes = hex2bytes(xhex)
objRijndael.Mode = CipherMode_CBC
objRijndael.BlockSize = 128
objRijndael.KeySize = 256
objRijndael.IV = hex2bytes(iv)
objRijndael.Key = hex2bytes(key)
decrypt = objUTF8.GetString((objRijndael.CreateDecryptor.TransformFinalBlock((bytes), 0, LenB(bytes))))
Set objUTF8 = Nothing
Set objRijndael = Nothing
End Function
'//-------------------------------------------------------//
'// bytes -> hex 変換（バイト配列→16進数）
'//-------------------------------------------------------//
Function bytes2hex(xbytes)
With CreateObject("Microsoft.XMLDOM").CreateElement("dummy")
.DataType = "bin.hex"
.NodeTypedValue = xbytes
bytes2hex = .Text
End With
End Function
'//-------------------------------------------------------//
'// hex -> bytes 変換（16進数→バイト配列）
'//-------------------------------------------------------//
Function hex2bytes(xhex)
With CreateObject("Microsoft.XMLDOM").CreateElement("dummy")
.DataType = "bin.hex"
.Text = xhex
hex2bytes = .NodeTypedValue
End With
End Function
'//-------------------------------------------------------//
'// SHA256
'//-------------------------------------------------------//
Function sha256(txt)
Set objSHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")
Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
'// 文字列を UTF8 にエンコードし、バイト配列に変換
bytes = objUTF8.GetBytes_4(txt)
'// ハッシュ値を計算（バイナリ）
hash = objSHA256.ComputeHash_2((bytes))
'// バイト配列を16進数文字列に変換
sha256 = bytes2hex(hash)
End Function
|