'================================================================== '* OS, Browser, Plugin のバージョンチェック 'https://www.palm84.com/entry/wsh 'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Check_Plugins.vbs.txt 'https://drive.google.com/file/d/1a2aisQlcWQhF5YogwRJLSzqC3Te6blEk/view?usp=sharing '================================================================== 'On Error Resume Next Option Explicit Dim objFSO, objNetWork, objTxt, objShell, objFile ' FileSystemObject の作成 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") ' NetWork オブジェクトの作成 Set objNetWork = WScript.CreateObject("WScript.Network") ' ログファイル Dim CompName, appPath, LogFile CompName= objNetWork.ComputerName appPath = objFSO.GetParentFolderName(WScript.ScriptFullName) LogFile = appPath & "\Check_Plugins1_" & CompName & ".txt" Const ForReading = 1, ForWriting = 2, ForAppending = 8 Set objTxt = objFSO.OpenTextFile(LogFile, ForWriting, true, -2) ' 環境変数の値を取得 Set objShell = WScript.CreateObject("WScript.Shell") Dim PROGRAMS, WINDIR, TEMP, PROGRAMSx86, PROGRAMW6432, LOCALAPPDATA WINDIR = objShell.ExpandEnvironmentStrings("%windir%") PROGRAMS = objShell.ExpandEnvironmentStrings("%ProgramFiles%") PROGRAMSx86 = objShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%") PROGRAMW6432 = objShell.ExpandEnvironmentStrings("%ProgramW6432%") TEMP = objShell.ExpandEnvironmentStrings("%Temp%") LOCALAPPDATA = objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") Dim strPlugin Dim strKeyPath(), strValue(), strFilePath(),strURL() ' Plugins ディレクトリ ReDim arrBrowser(10) arrBrowser(0) = "\Opera\program\plugins" arrBrowser(1) = "\Mozilla Firefox\plugins" arrBrowser(2) = "\mozilla.org\SeaMonkey\plugins" arrBrowser(3) = "\Mozilla Thunderbird\plugins" arrBrowser(4) = "\Safari\plugins" arrBrowser(5) = "\Lunascape\Lunascape\extents\gecko\plugins" arrBrowser(6) = "\Lunascape\Lunascape4\extents\gecko\plugins" arrBrowser(7) = "\Lunascape\Lunascape5\extents\gecko\plugins" arrBrowser(8) = "\Lunascape\Lunascape6\extents\gecko\plugins" arrBrowser(9) = "\Fenrir & Co\Gecko_v1712\gecko20051003\plugins" arrBrowser(10) = "\Fenrir & Co\Sleipnir\plugins\browser\ActiveGeckoBrowser\plugins" ReDim arrPluginDirectory(21) Dim bytX If PROGRAMW6432 = "%ProgramW6432%" Then For bytX = 0 To 10 arrPluginDirectory(bytX) = PROGRAMS & arrBrowser(bytX) Next ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then For bytX = 0 To 10 arrPluginDirectory(bytX) = ProgramW6432 & arrBrowser(bytX) Next For bytX = 0 To 10 arrPluginDirectory(bytX + 11) = PROGRAMSx86 & arrBrowser(bytX) Next End If ' レジストリ Uninstall キーのサブキーを格納 Const HKLM = &H80000002 Dim strComputer strComputer = "." Dim objReg Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") Dim strParKey strParKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" Dim arrSubKeys objReg.EnumKey HKLM, strParKey, arrSubKeys Dim strParKeyx86 strParKeyx86 = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" Dim arrSubKeysx86 objReg.EnumKey HKLM, strParKeyx86, arrSubKeysx86 objTxt.WriteLine "****************************************************************" objTxt.WriteLine "調査日時 : " & Date() & " - " & Time() objTxt.WriteLine "****************************************************************" objTxt.WriteBlankLines (1) Dim intFileVersion, intProductVersion, intProductVersion271 MyOperatingSystem objTxt.WriteBlankLines (1) 'Sub Dim Chrome_Dir, Chrome_Ver IE Edge Firefox Chrome Opera Safari JRE AdobeReader FlashX FlashPlugin ShockwaveX ShockwavePlugin AdobeAIR RealPlayer QuickTime iTunes objTxt.Close objShell.Run """" & LogFile & """" Set objNetWork = Nothing Set objTxt = Nothing Set objFSO = Nothing Set objShell = Nothing '********************************************************* ' Sub MyOperatingSystem '********************************************************* Sub MyOperatingSystem On Error Resume Next Dim strComputer, objWMIService, colItems, strOSVersion, objItem strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48) Const Reg_DisplayVersion = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DisplayVersion" Const Reg_EditionID = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\EditionID" Const Reg_ProductName = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName" Const Reg_CurrentVersion = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion" Const Reg_BuildBranch = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\BuildBranch" Const Reg_ReleaseId = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ReleaseId" Const Reg_CurrentBuildNumber = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber" Const Reg_UBR = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\UBR" Const Reg_BuildLabEx = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\BuildLabEx" For Each objItem in colItems objTxt.WriteLine "Caption : " & objItem.Caption objTxt.WriteLine "EditionID : " & objShell.RegRead(Reg_EditionID) objTxt.WriteLine "OSArchitecture : " & objItem.OSArchitecture objTxt.WriteLine "ProductName : " & objShell.RegRead(Reg_ProductName) objTxt.WriteLine "ServicePack : " & objItem.ServicePackMajorVersion objTxt.WriteLine "CurrentVersion : " & objShell.RegRead(Reg_CurrentVersion) objTxt.WriteLine "Version : " & objItem.Version objTxt.WriteLine "BuildBranch : " & objShell.RegRead(Reg_BuildBranch) objTxt.WriteLine "DisplayVersion : " & objShell.RegRead(Reg_DisplayVersion) objTxt.WriteLine "ReleaseId : " & objShell.RegRead(Reg_ReleaseId) objTxt.WriteLine "CurrentBuildNumber : " & objShell.RegRead(Reg_CurrentBuildNumber) objTxt.WriteLine "UBR : " & objShell.RegRead(Reg_UBR) objTxt.WriteLine "BuildLabEx : " & objShell.RegRead(Reg_BuildLabEx) 'strOSVersion = objItem.Version objTxt.WriteLine "CSDVersion : " & objItem.CSDVersion objTxt.WriteLine "WindowsDirectory : " & objItem.WindowsDirectory objTxt.WriteLine "搭載物理メモリ : " & Round(objItem.TotalVisibleMemorySize / 1024) & " MB" objTxt.WriteLine "空き物理メモリ : " & Round(objItem.FreePhysicalMemory / 1024) & " MB" objTxt.WriteLine "最大仮想メモリ : " & Round(objItem.TotalVirtualMemorySize / 1024) & " MB" Next 'If InStr(strOSVersion, "5.0.") > 0 Then ' intFileVersion = "18" ' intProductVersion = "20" 'ElseIf InStr(strOSVersion, "5.1.") > 0 Then ' intFileVersion = "37" ' intProductVersion = "39" 'ElseIf InStr(strOSVersion, "6.0.") > 0 Then ' intFileVersion = "156" ' intProductVersion = "264" 'ElseIf InStr(strOSVersion, "6.1.") > 0Then ' intFileVersion = "156" ' intProductVersion = "268" '' intProductVersion271 = "271" 'End If Set objWMIService = Nothing On Error GoTo 0 End Sub '********************************************************* ' Sub IE '********************************************************* Sub IE strPlugin = "Internet Explorer" ReDim strURL(4) strURL(0) = "http://www.microsoft.com/japan/windows/internet-explorer/" strURL(1) = "http://www.microsoft.com/downloads/details.aspx?FamilyID=341c2ad5-8c3d-4347-8c03-08cdecd8852b&displaylang=ja" 'strURL(2) = "http://www.microsoft.com/japan/windows/ie/ie6/default.mspx" Redim strKeyPath(9), strValue(9) strKeyPath(0) = "HKLM\SOFTWARE\Microsoft\Internet Explorer" strValue(0) = "svcUpdateVersion" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer" strValue(1) = "svcUpdateVersion" strKeyPath(2) = "HKLM\SOFTWARE\Microsoft\Internet Explorer" strValue(2) = "svcVersion" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer" strValue(3) = "svcVersion" strKeyPath(4) = "HKLM\SOFTWARE\Microsoft\Internet Explorer" strValue(4) = "Version" strKeyPath(5) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer" strValue(5) = "Version" strKeyPath(6) = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings" strValue(6) = "MinorVersion" strKeyPath(7) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Internet Settings" strValue(7) = "MinorVersion" Redim strIEFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strIEFile(0) = PROGRAMS & "\Internet Explorer\iexplore.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strIEFile(0) = PROGRAMW6432 & "\Internet Explorer\iexplore.exe" strIEFile(1) = PROGRAMSx86 & "\Internet Explorer\iexplore.exe" End If ReDim strFilePath(4) Dim x For x = 0 To 4 If objFSO.FileExists(strIEFile(x)) Then strFilePath(x) = strIEFile(x) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub Edge '********************************************************* Sub Edge strPlugin = "Microsoft Edge" ReDim strURL(4) strURL(0) = "https://www.microsoft.com/ja-jp/edge" strURL(1) = "https://ja.wikipedia.org/wiki/Microsoft_Edge" 'strURL(2) = "http://www.microsoft.com/japan/windows/ie/ie6/default.mspx" Redim strKeyPath(1), strValue(1) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Microsoft Edge") > 0 Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Microsoft Edge") > 0 Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Redim strEdgeFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strEdgeFile(0) = PROGRAMS & "\Microsoft\Edge\Application\msedge.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strEdgeFile(0) = PROGRAMW6432 & "\Microsoft\Edge\Application\msedge.exe" strEdgeFile(1) = PROGRAMSx86 & "\Microsoft\Edge\Application\msedge.exe" End If ReDim strFilePath(4) For x = 0 To 4 If objFSO.FileExists(strEdgeFile(x)) Then strFilePath(x) = strEdgeFile(x) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub Firefox '********************************************************* Sub Firefox strPlugin = "Mozilla Firefox" ReDim strURL(4) strURL(0) = "http://mozilla.jp/firefox/" Redim strKeyPath(8), strValue(8) strKeyPath(0) = "HKLM\SOFTWARE\Mozilla\Mozilla Firefox" strValue(0) = "CurrentVersion" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\Mozilla\Mozilla Firefox" strValue(1) = "CurrentVersion" Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Mozilla Firefox") > 0 Then strKeyPath(2) = "HKLM\" & strParKey & "\" & strSubKey strValue(2) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Mozilla Firefox") > 0 Then strKeyPath(3) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(3) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Redim strfxFile(4) ' If PROGRAMW6432 = "%ProgramW6432%" Then ' strfxFile(0) = PROGRAMS & "\Mozilla Firefox\firefox.exe" ' ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then ' strfxFile(0) = PROGRAMW6432 & "\Mozilla Firefox\firefox.exe" ' strfxFile(1) = PROGRAMSx86 & "\Mozilla Firefox\firefox.exe" ' End If If strKeyPath(2) <> "" Then strfxFile(2) = objShell.RegRead(strKeyPath(2) & "\InstallLocation") & "\" & "firefox.exe" End If If strKeyPath(3) <> "" Then strfxFile(3) = objShell.RegRead(strKeyPath(3) & "\InstallLocation") & "\" & "firefox.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strfxFile(z)) Then strFilePath(z) = strfxFile(z) End If Next '*** 複数バージョン存在時のチェック ' ReDim strFilePath(8) ' Const HKLM = &H80000002 ' Const strBaseKey = "SOFTWARE\Mozilla\Mozilla Firefox\" ' Dim strComputer ' strComputer = "." ' Dim objReg ' オブジェクト Regestryプロバイダ ' Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv") ' Dim arrSubKeys 'サブキー名を配列に格納 ' objReg.EnumKey HKLM, strBaseKey, arrSubKeys ' Dim strSubKey '配列arrSubKeysからサブキー名を読み取り ' Dim intX ' On Error Resume Next ' For intX = 0 To Ubound(arrSubKeys) ' strSubKey = arrSubKeys(intX) ' strFilePath(intX) = objShell.RegRead("HKLM\" & strBaseKey & strSubKey & "\Main\" & "PathToExe") ' Next ' For intX = 0 To Ubound(arrSubKeys) ' strSubKey = arrSubKeys(intX) ' strKeyPath(intX + 1) = "HKLM\" & strBaseKey & strSubKey ' Next ' Const strBaseKeyx86 = "SOFTWARE\Wow6432Node\Mozilla\Mozilla Firefox\" ' Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv") ' Dim arrSubKeysx86 'サブキー名を配列に格納 ' objReg.EnumKey HKLM, strBaseKeyx86 , arrSubKeysx86 ' Dim strSubKeyx86 '配列arrSubKeysからサブキー名を読み取り ' Dim intY ' On Error Resume Next ' For intY = 0 To Ubound(arrSubKeysx86) ' strSubKeyx86 = arrSubKeysx86(intY) ' strFilePath(intY + 4) = objShell.RegRead("HKLM\" & strBaseKeyx86 & strSubKeyx86 & "\Main\" & "PathToExe") ' Next ' For intY = 0 To Ubound(arrSubKeysx86 ) ' strSubKeyx86 = arrSubKeysx86(intX) ' strKeyPath(intX + 5) = "HKLM\" & strBaseKeyx86 & strSubKeyx86 ' Next ' On Error GoTo 0 MyRegRead MyFileVer End Sub '********************************************************* ' Sub Opera '********************************************************* Sub Opera strPlugin = "Opera" ReDim strURL(4) strURL(0) = "http://jp.opera.com/download/" strURL(1) = "http://jp.opera.com/docs/changelogs/windows/" Redim strKeyPath(4), strValue(4) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Opera") > 0 Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Opera") > 0 Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Redim strOperaFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strOperaFile(0) = PROGRAMS & "\Opera\Opera.exe" strOperaFile(1) = LOCALAPPDATA & "\Programs\Opera\launcher.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strOperaFile(0) = PROGRAMW6432 & "\Opera\Opera.exe" strOperaFile(1) = PROGRAMSx86 & "\Opera\Opera.exe" strOperaFile(2) = LOCALAPPDATA & "\Programs\Opera\launcher.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strOperaFile(z)) Then strFilePath(z) = strOperaFile(z) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub Safari '********************************************************* Sub Safari strPlugin = "Safari" ReDim strURL(6) strURL(0) = "http://www.apple.com/jp/safari/" Redim strKeyPath(3), strValue(3) strKeyPath(0) = "HKLM\SOFTWARE\Apple Computer, Inc.\Safari" strValue(0) = "Version" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\Apple Computer, Inc.\Safari" strValue(1) = "Version" Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If strTest = "Safari" Then strKeyPath(2) = "HKLM\" & strParKey & "\" & strSubKey strValue(2) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If strTestx86 = "Safari" Then strKeyPath(3) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(3) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Redim strSafariFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strSafariFile(0) = PROGRAMS & "\Safari\Safari.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strSafariFile(0) = PROGRAMW6432 & "\Safari\Safari.exe" strSafariFile(1) = PROGRAMSx86 & "\Safari\Safari.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strSafariFile(z)) Then strFilePath(z) = strSafariFile(z) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub Chrome '********************************************************* Sub Chrome strPlugin = "Google Chrome" ReDim strURL(3) strURL(0) = "http://www.google.co.jp/chrome/" strURL(1) = "http://www.google.co.jp/chrome/intl/ja/more/index.html?hl=ja" strURL(2) = "http://www.google.com/support/chrome/?hl=ja" strURL(3) = "http://www.google.com/support/chrome/bin/static.py?page=known_issues.cs" Redim strKeyPath(3), strValue(3) strKeyPath(0) = "HKCU\Software\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome" strValue(0) = "DisplayVersion" strKeyPath(1) = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome" strValue(1) = "DisplayVersion" strKeyPath(2) = "HKCU\Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome" strValue(2) = "DisplayVersion" strKeyPath(3) = "HKLM\Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome" strValue(3) = "DisplayVersion" Dim x, strTest On Error Resume Next For x = 0 To 3 strTest = objShell.RegRead(strKeyPath(x) & "\DisplayVersion") If strTest <> "" Then Chrome_Dir = objShell.RegRead(strKeyPath(x) & "\InstallLocation") Chrome_Ver = objShell.RegRead(strKeyPath(x) & "\DisplayVersion") Exit For End If Err.Clear Next On Error GoTo 0 Redim strChromeFile(1) strChromeFile(0) = Chrome_Dir & "\" & "chrome.exe" strChromeFile(1) = Chrome_Dir & "\" & Chrome_Ver & "\chrome.dll" Redim strFilePath(1) Dim z For z = 0 To 1 If objFSO.FileExists(strChromeFile(z)) Then strFilePath(z) = strChromeFile(z) End If Next 'Redim strChromeFile(4) 'strChromeFile(0) = Chrome_Dir & "\" & Chrome_Ver & "\Installer\Setup.exe" 'strChromeFile(1) = Chrome_Dir & "\" & Chrome_Ver & "\chrome.dll" 'strChromeFile(2) = Chrome_Dir & "\" & Chrome_Ver & "\chrome_launcher.exe" 'ReDim strFilePath(4) 'Dim z 'For z = 0 To 4 ' If objFSO.FileExists(strChromeFile(z)) Then ' strFilePath(z) = strChromeFile(z) ' End If 'Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub JRE '********************************************************* Sub JRE On Error Resume Next strPlugin = "Oracle Java Runtime Environment - Java Plug-in (JRE)" ReDim strURL(4) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://java.com/ja/download/index.jsp" strURL(2) = "=== * etc" strURL(3) = "http://www.java.com/ja/download/manual.jsp" 'strURL(2) = "http://java.sun.com/javase/ja/6/download.html" Dim strJavaVer, strJavaHome strJavaVer = objShell.RegRead("HKLM\SOFTWARE\JavaSoft\Java Runtime Environment\" & "Java7FamilyVersion") objShell.RegRead("HKLM\SOFTWARE\JavaSoft\Java Runtime Environment\" & "Java7FamilyVersion") If Err.Number = -2147024894 Then strJavaVer = objShell.RegRead("HKLM\SOFTWARE\JavaSoft\Java Runtime Environment\" & "Java6FamilyVersion") End If strJavaHome = objShell.RegRead("HKLM\SOFTWARE\JavaSoft\Java Runtime Environment\" & strJavaVer & "\JavaHome") Dim strJavaVerx86, strJavaHomex86 strJavaVerx86 = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment\" & "Java7FamilyVersion") objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment\" & "Java7FamilyVersion") If Err.Number = -2147024894 Then strJavaVerx86 = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment\" & "Java6FamilyVersion") End If strJavaHomex86 = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment\" & strJavaVerx86 & "\JavaHome") Redim strKeyPath(7), strValue(7) strKeyPath(0) = "HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment" strValue(0) = "Java6FamilyVersion" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment" strValue(1) = "Java7FamilyVersion" strKeyPath(2) = "HKLM\SOFTWARE\Wow6432Node\JavaSoft\Java Runtime Environment" strValue(2) = "BrowserJavaVersion" strKeyPath(3) = "HKLM\SOFTWARE\JavaSoft\Java Runtime Environment" strValue(3) = "Java6FamilyVersion" strKeyPath(4) = "HKLM\SOFTWARE\JavaSoft\Java Runtime Environment" strValue(4) = "Java7FamilyVersion" strKeyPath(5) = "HKLM\SOFTWARE\JavaSoft\Java Runtime Environment" strValue(5) = "BrowserJavaVersion" Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Java ") > 0 Then strKeyPath(6) = "HKLM\" & strParKey & "\" & strSubKey strValue(6) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Java ") > 0 Then strKeyPath(7) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(7) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 'WScript.echo strJavaHome 'WScript.echo strJavaHomex86 ReDim strJavaFile(77) Dim i, j, k, l strJavaFile(0) = strJavaHome & "\bin\java.exe" strJavaFile(1) = WINDIR & "\SysWOW64\java.exe" strJavaFile(2) = strJavaHomex86 & "\bin\java.exe" strJavaFile(3) = WINDIR & "\System32\java.exe" strJavaFile(4) = strJavaHome & "\bin\npdeploytk.dll" strJavaFile(5) = strJavaHomex86 & "\bin\npdeploytk.dll" strJavaFile(6) = strJavaHome & "\bin\new_plugin\npdeploytk.dll" strJavaFile(7) = strJavaHomex86 & "\bin\new_plugin\npdeploytk.dll" For i = 0 to 21 strJavaFile(i + 8) = arrPluginDirectory(i) & "\npdeploytk.dll" Next strJavaFile(30) = strJavaHome & "\bin\npdeployJava1.dll" strJavaFile(31) = strJavaHomex86 & "\bin\npdeployJava1.dll" For j = 0 to 21 strJavaFile(j + 32) = arrPluginDirectory(j) & "\npdeployJava1.dll" Next strJavaFile(54) = strJavaHome & "\bin\new_plugin\npjp2.dll" strJavaFile(55) = strJavaHomex86 & "\bin\new_plugin\npjp2.dll" For k = 0 to 21 strJavaFile(k + 56) = arrPluginDirectory(k) & "\npjp2.dll" Next ReDim strFilePath(77) For l = 0 To 77 If objFSO.FileExists(strJavaFile(l)) Then strFilePath(l) = strJavaFile(l) End If Next On Error GoTo 0 MyRegRead MyFileVer End Sub '********************************************************* ' Sub AdobeReader '********************************************************* Sub AdobeReader strPlugin = "Adobe Reader" ReDim strURL(6) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://get.adobe.com/jp/reader/" strURL(2) = "=== * etc" strURL(3) = "http://get.adobe.com/jp/reader/otherversions/" strURL(4) = "http://www.adobe.com/jp/support/downloads/acrwin.html" strURL(5) = "ftp://ftp.adobe.com/pub/adobe/reader/win/" strURL(6) = "----- 【注意】nppdf32.dll について - \Program Files\Adobe\.. 内のバージョンを確認" & vbcrlf & "それより古いものが他の plugins フォルダにあれば削除する -----" Dim strVer, W, X, Y, Z Redim strAdrReg(1) strVer = Array("11.0", "10.0", "9.0", "8.0", "7.0", "6.0") For Each W in strVer On Error Resume Next objShell.RegRead("HKLM\SOFTWARE\Adobe\Acrobat Reader\" & W & "\Installer\JPN_GUID") If Err.Number = 0 Then strAdrReg(0) = "HKLM\SOFTWARE\Adobe\Acrobat Reader\" & W & "\Installer" End If Err.Clear Next For Each X in strVer On Error Resume Next objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Acrobat Reader\" & X & "\Installer\JPN_GUID") If Err.Number = 0 Then strAdrReg(1) = "HKLM\SOFTWARE\Wow6432Node\Adobe\Acrobat Reader\" & X & "\Installer" End If Err.Clear Next ReDim strAdrGUID(1) For Each Y in strVer On Error Resume Next objShell.RegRead("HKLM\SOFTWARE\Adobe\Acrobat Reader\" & Y & "\Installer\JPN_GUID") If Err.Number = 0 Then strAdrGUID(0) = objShell.RegRead("HKLM\SOFTWARE\Adobe\Acrobat Reader\" & Y & "\Installer\JPN_GUID") End If Err.Clear Next For Each Z in strVer On Error Resume Next objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Acrobat Reader\" & Z & "\Installer\JPN_GUID") If Err.Number = 0 Then strAdrGUID(1) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Acrobat Reader\" & Z & "\Installer\JPN_GUID") End If Err.Clear Next Redim strKeyPath(9), strValue(9) strKeyPath(0) = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & strAdrGUID(0) strValue(0) = "DisplayVersion" strKeyPath(1) = strAdrReg(0) strValue(1) = "VersionMax" strKeyPath(2) = strAdrReg(0) strValue(2) = "VersionMin" strKeyPath(3) = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{AC76BA86-7AD7-1041-7B44-A81200000003}_Adobe Reader 8.1.2 - Japanese" strValue(3) = "ReleaseID" strKeyPath(4) = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{6846389C-BAC0-4374-808E-B120F86AF5D7}" strValue(4) = "DisplayName" strKeyPath(5) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\" & strAdrGUID(1) strValue(5) = "DisplayVersion" strKeyPath(6) = strAdrReg(1) strValue(6) = "VersionMax" strKeyPath(7) = strAdrReg(1) strValue(7) = "VersionMin" strKeyPath(8) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\{AC76BA86-7AD7-1041-7B44-A81200000003}_Adobe Reader 8.1.2 - Japanese" strValue(8) = "ReleaseID" strKeyPath(9) = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\{6846389C-BAC0-4374-808E-B120F86AF5D7}" strValue(9) = "DisplayName" ReDim strADRP(25) 'strADRP(0) = objShell.RegRead(strAdrReg(0) & "\Path") & "Reader\AcroRd32.dll" strADRP(0) = objShell.RegRead(strAdrReg(0) & "\Path") & "Reader\AcroRd32.exe" strADRP(1) = objShell.RegRead(strAdrReg(0) & "\Path") & "Reader\Browser\nppdf32.dll" 'strADRP(3) = objShell.RegRead(strAdrReg(1) & "\Path") & "Reader\AcroRd32.dll" strADRP(2) = objShell.RegRead(strAdrReg(1) & "\Path") & "Reader\AcroRd32.exe" strADRP(3) = objShell.RegRead(strAdrReg(1) & "\Path") & "Reader\Browser\nppdf32.dll" If strADRP(0) = strADRP(2) Then strADRP(2) = "" strADRP(3) = "" 'strADRP(5) = "" End If Dim i For i = 0 to 21 strADRP(i + 4) = arrPluginDirectory(i) & "\nppdf32.dll" Next ReDim strFilePath(27) Dim j If strAdrReg(1) <> strAdrReg(0) Then For j = 0 To 27 If objFSO.FileExists(strADRP(j)) Then strFilePath(j) = strADRP(j) End If Next End If MyRegRead MyFileVer End Sub '********************************************************* ' Sub FlashX '********************************************************* Sub FlashX On Error Resume Next strPlugin = "Flash Player ActiveX" ReDim strURL(16) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://get.adobe.com/jp/flashplayer/" strURL(2) = "=== * バージョンチェック" strURL(3) = "http://www.adobe.com/jp/software/flash/about/" strURL(4) = "http://helpx.adobe.com/jp/flash-player.html" strURL(5) = "http://helpx.adobe.com/jp/flash-player/kb/229980.html" strURL(6) = "-----" strURL(7) = "=== * XP / 7 の IE用インストーラー 直リンク (8/10 用は自動更新なのでなし)" strURL(8) = "https://www.adobe.com/jp/products/flashplayer/distribution3.html" strURL(9) = "http://download.macromedia.com/pub/flashplayer/latest/help/install_flash_player_ax.exe" strURL(10) = "http://fpdownload.macromedia.com/pub/flashplayer/latest/help/install_flash_player_ax.exe" strURL(11) = "-----" strURL(12) = "=== * アンインストーラー 直リンク (IE/Firefoxなど兼用)" strURL(13) = "http://download.macromedia.com/get/flashplayer/current/support/uninstall_flash_player.exe" strURL(14) = "http://fpdownload.adobe.com/get/flashplayer/current/support/uninstall_flash_player.exe" strURL(15) = "=== * etc" strURL(16) = "http://www.adobe.com/jp/shockwave/download/alternates/" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/uninstall_flash_player_32bit.exe" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/uninstall_flash_player_64bit.exe" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/install_flash_player_ax_32bit.exe" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/install_flash_player_ax_64bit.exe" 'strURL() = "http://aihdownload.adobe.com/bin/install_flashplayer11x64ax_aih.exe" Redim strKeyPath(5), strValue(5) strKeyPath(0) = "HKLM\SOFTWARE\Macromedia\FlashPlayerActiveX" strValue(0) = "Version" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\Macromedia\FlashPlayerActiveX" strValue(1) = "Version" strKeyPath(2) = "HKLM\SOFTWARE\Macromedia\FlashPlayerActiveX" strValue(2) = "isScriptDebugger" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\Macromedia\FlashPlayerActiveX" strValue(3) = "isScriptDebugger" strKeyPath(4) = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player ActiveX" strValue(4) = "DisplayVersion" strKeyPath(5) = "HKLM\Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player ActiveX" strValue(5) = "DisplayVersion" ReDim strFilePath(4) strFilePath(0) = objShell.RegRead("HKLM\SOFTWARE\Classes\CLSID\{D27CDB6E-AE6D-11cf-96B8-444553540000}\InprocServer32\") strFilePath(1) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Classes\CLSID\{D27CDB6E-AE6D-11cf-96B8-444553540000}\InprocServer32\") On Error GoTo 0 MyRegRead MyFileVer End Sub '********************************************************* ' Sub FlashPlugin '********************************************************* Sub FlashPlugin strPlugin = "Flash Player Plugin (for Firefox, Opera, etc)" ReDim strURL(17) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://get.adobe.com/jp/flashplayer/" strURL(2) = "=== * バージョンチェック" strURL(3) = "http://www.adobe.com/jp/software/flash/about/" strURL(4) = "http://helpx.adobe.com/jp/flash-player.html" strURL(5) = "http://helpx.adobe.com/jp/flash-player/kb/229980.html" strURL(6) = "-----" strURL(7) = "=== * XP / 7 /8 の Firefox, Opera 用インストーラー 直リンク" strURL(8) = "https://www.adobe.com/jp/products/flashplayer/distribution3.html" strURL(9) = "----- 【注意】下記はデバッグ版? -----" strURL(10) = "http://download.macromedia.com/pub/flashplayer/latest/help/install_flash_player.exe" strURL(11) = "http://fpdownload.macromedia.com/pub/flashplayer/latest/help/install_flash_player.exe" strURL(12) = "-----" strURL(13) = "=== * アンインストーラー 直リンク (IE/Firefoxなど兼用)" strURL(14) = "http://download.macromedia.com/get/flashplayer/current/support/uninstall_flash_player.exe" strURL(15) = "http://fpdownload.adobe.com/get/flashplayer/current/support/uninstall_flash_player.exe" strURL(16) = "=== * etc" strURL(17) = "http://www.adobe.com/jp/shockwave/download/alternates/" 'strURL() = "http://download.macromedia.com/pub/flashplayer/current/uninstall_flash_player_32bit.exe" 'strURL() = "http://download.macromedia.com/pub/flashplayer/current/uninstall_flash_player_64bit.exe" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/install_flash_player_32bit.exe" 'strURL() = "http://fpdownload.adobe.com/get/flashplayer/current/install_flash_player_64bit.exe" 'strURL() = "http://aihdownload.adobe.com/bin/install_flashplayer11x64_mssd_aih.exe" Redim strKeyPath(10), strValue(10) strKeyPath(0) = "HKLM\SOFTWARE\Macromedia\FlashPlayerPlugin" strValue(0) = "Version" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\Macromedia\FlashPlayerPlugin" strValue(1) = "Version" strKeyPath(2) = "HKLM\SOFTWARE\Macromedia\FlashPlayerPlugin" strValue(2) = "isScriptDebugger" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\Macromedia\FlashPlayerPlugin" strValue(3) = "isScriptDebugger" strKeyPath(4) = "HKLM\SOFTWARE\MozillaPlugins\@adobe.com/FlashPlayer" strValue(4) = "Version" strKeyPath(5) = "HKLM\SOFTWARE\MozillaPlugins\@macromedia.com/FlashPlayer9" strValue(5) = "Version" strKeyPath(6) = "HKLM\SOFTWARE\MozillaPlugins\@macromedia.com/FlashPlayer8" strValue(6) = "Version" strKeyPath(7) = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player Plugin" strValue(7) = "DisplayVersion" strKeyPath(8) = "HKLM\Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player Plugin" strValue(8) = "DisplayVersion" strKeyPath(9) = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player NPAPI" strValue(9) = "DisplayVersion" strKeyPath(10) = "HKLM\SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Adobe Flash Player NPAPI" strValue(10) = "DisplayVersion" ReDim strFilePath(35) On Error Resume Next strFilePath(0) = objShell.RegRead("HKLM\SOFTWARE\Macromedia\FlashPlayerPlugin\PlayerPath") strFilePath(1) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Macromedia\FlashPlayerPlugin\PlayerPath") On Error GoTo 0 If objFSO.FileExists(WINDIR & "\system32\Macromed\Flash\NPSWF32.dll") Then strFilePath(2) = WINDIR & "\system32\Macromed\Flash\NPSWF32.dll" End If If objFSO.FileExists(WINDIR & "\SysWOW64\Macromed\Flash\NPSWF32.dll") Then strFilePath(3) = WINDIR & "\SysWOW64\Macromed\Flash\NPSWF32.dll" End If If objFSO.FileExists(PROGRAMS & "\Adobe\Reader 9.0\Reader\authplay.dll") Then strFilePath(4) = PROGRAMS & "\Adobe\Reader 9.0\Reader\authplay.dll" End If If objFSO.FileExists(PROGRAMSx86 & "\Adobe\Reader 9.0\Reader\authplay.dll") Then strFilePath(5) = PROGRAMSx86 & "\Adobe\Reader 9.0\Reader\authplay.dll" End If If objFSO.FileExists(PROGRAMS & "\Adobe\Reader 10.0\Reader\authplay.dll") Then strFilePath(6) = PROGRAMS & "\Adobe\Reader 10.0\Reader\authplay.dll" End If If objFSO.FileExists(PROGRAMSx86 & "\Adobe\Reader 10.0\Reader\authplay.dll") Then strFilePath(7) = PROGRAMSx86 & "\Adobe\Reader 10.0\Reader\authplay.dll" End If If objFSO.FileExists(PROGRAMS & "\Adobe\Reader 11.0\Reader\NPSWF32.dll") Then strFilePath(8) = PROGRAMS & "\Adobe\Reader 11.0\Reader\NPSWF32.dll" End If If objFSO.FileExists(PROGRAMSx86 & "\Adobe\Reader 11.0\Reader\NPSWF32.dll") Then strFilePath(9) = PROGRAMSx86 & "\Adobe\Reader 11.0\Reader\NPSWF32.dll" End If If objFSO.FileExists(Chrome_Dir & "\" & Chrome_Ver & "\PepperFlash\pepflashplayer.dll") Then strFilePath(10) = Chrome_Dir & "\" & Chrome_Ver & "\PepperFlash\pepflashplayer.dll" End If Dim PepFolder, objPepFolder, PepSubFolder PepFolder = LOCALAPPDATA & "\Google\Chrome\User Data\PepperFlash" If objFSO.FolderExists(PepFolder) Then Set objPepFolder = objFSO.GetFolder(PepFolder) For Each PepSubFolder In objPepFolder.SubFolders If objFSO.FileExists(PepFolder & "\" & PepSubFolder.Name & "\pepflashplayer.dll") Then strFilePath(11) = PepFolder & "\" & PepSubFolder.Name & "\pepflashplayer.dll" End If Next End If If objFSO.FileExists(PROGRAMSx86 & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll") Then strFilePath(12) = PROGRAMSx86 & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll" End If If objFSO.FileExists(PROGRAMW6432 & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll") Then strFilePath(13) = PROGRAMW6432 & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll" End If If objFSO.FileExists(PROGRAMS & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll") Then strFilePath(14) = PROGRAMS & "\Common Files\Adobe AIR\Versions\1.0\Resources\NPSWF32.dll" End If Dim x For x = 0 to 21 If objFSO.FileExists(arrPluginDirectory(x) & "\NPSWF32.dll") Then strFilePath(x + 14) = arrPluginDirectory(x) & "\NPSWF32.dll" End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub ShockwaveX '********************************************************* Sub ShockwaveX strPlugin = "Shockwave ActiveX Control (for Internet Explorer)" ReDim strURL(7) strURL(0) = "=== * ダウンロード・サイト (インストーラーはIE/Firefoxなど兼用)" strURL(1) = "http://get.adobe.com/jp/shockwave/" strURL(2) = "=== * インストーラー 直リンク (IE/Firefoxなど兼用)" strURL(3) = "http://fpdownload.adobe.com/get/shockwave/default/english/win95nt/latest/Shockwave_Installer_Slim.exe" strURL(4) = "=== * アンインストーラー 直リンク (IE/Firefoxなど兼用)" strURL(5) = "http://fpdownload.adobe.com/get/shockwave/uninstall/win/sw_uninstaller.exe" strURL(6) = "=== * etc" strURL(7) = "http://www.adobe.com/jp/shockwave/download/alternates/" Redim strKeyPath(8), strValue(8) strValue(0) = "DisplayVersion" Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Shockwave") > 0 Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Shockwave") > 0 Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 strKeyPath(2) = "HKLM\SOFTWARE\Adobe\Shockwave 11\currentupdateversion" strValue(2) = "" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 11\currentupdateversion" strValue(3) = "" strKeyPath(4) = "HKLM\SOFTWARE\Adobe\Shockwave 12\currentupdateversion" strValue(4) = "" strKeyPath(5) = "HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 12\currentupdateversion" strValue(5) = "" strKeyPath(6) = "HKLM\SOFTWARE\Macromedia\Shockwave 10\currentupdateversion" strValue(6) = "" strKeyPath(7) = "HKLM\SOFTWARE\Macromedia\Shockwave 9\currentupdateversion" strValue(7) = "" strKeyPath(8) = "HKLM\SOFTWARE\Macromedia\Shockwave 8\currentupdateversion" strValue(8) = "" Dim strVersion(3) On Error Resume Next strVersion(0) = objShell.RegRead("HKLM\SOFTWARE\Adobe\Shockwave 11\currentupdateversion\") strVersion(1) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 11\currentupdateversion\") strVersion(2) = objShell.RegRead("HKLM\SOFTWARE\Adobe\Shockwave 12\currentupdateversion\") strVersion(3) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 12\currentupdateversion\") On Error GoTo 0 Dim strSWX(10) strSWX(0) = WINDIR & "\System32\Macromed\Shockwave 7\SwDir.dll" strSWX(1) = WINDIR & "\System32\Macromed\Shockwave 8\SwDir.dll" strSWX(2) = WINDIR & "\System32\Macromed\Shockwave 9\SwDir.dll" strSWX(3) = WINDIR & "\System32\Macromed\Shockwave 10\SwDir.dll" strSWX(4) = WINDIR & "\system32\Macromed\Director\SwDir.dll" strSWX(5) = WINDIR & "\System32\Adobe\Director\SwDir.dll" strSWX(6) = WINDIR & "\SysWOW64\Adobe\Director\SwDir.dll" strSWX(7) = WINDIR & "\System32\Adobe\Director\SwDir_" & strVersion(0) & ".dll" strSWX(8) = WINDIR & "\SysWOW64\Adobe\Director\SwDir_" & strVersion(1) & ".dll" strSWX(9) = WINDIR & "\System32\Adobe\Director\SwDir_" & strVersion(2) & ".dll" strSWX(10) = WINDIR & "\SysWOW64\Adobe\Director\SwDir_" & strVersion(3) & ".dll" ReDim strFilePath(10) Dim z On Error Resume Next For z = 0 To Ubound(strSWX) If objFSO.FileExists(strSWX(z)) Then strFilePath(z) = strSWX(z) End If Next On Error GoTo 0 MyRegRead MyFileVer End Sub '********************************************************* ' Sub ShockwavePlugin '********************************************************* Sub ShockwavePlugin strPlugin = "Shockwave for Director Netscape plug-in (for Firefox, Opera, etc)" ReDim strURL(7) strURL(0) = "=== * ダウンロード・サイト (インストーラーはIE/Firefoxなど兼用)" strURL(1) = "http://get.adobe.com/jp/shockwave/" strURL(2) = "=== * インストーラー 直リンク (IE/Firefoxなど兼用)" strURL(3) = "http://fpdownload.adobe.com/get/shockwave/default/english/win95nt/latest/Shockwave_Installer_Slim.exe" strURL(4) = "=== * アンインストーラー 直リンク (IE/Firefoxなど兼用)" strURL(5) = "http://fpdownload.adobe.com/get/shockwave/uninstall/win/sw_uninstaller.exe" strURL(6) = "=== * etc" strURL(7) = "http://www.adobe.com/jp/shockwave/download/alternates/" Redim strKeyPath(4), strValue(4) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Shockwave") > 0 Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Shockwave") > 0 Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 strKeyPath(2) = "HKLM\SOFTWARE\MozillaPlugins\@adobe.com/ShockwavePlayer" strValue(2) = "Version" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\MozillaPlugins\@adobe.com/ShockwavePlayer" strValue(3) = "Version" ReDim strVersion(3) On Error Resume Next strVersion(0) = objShell.RegRead("HKLM\SOFTWARE\Adobe\Shockwave 11\currentupdateversion\") strVersion(1) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 11\currentupdateversion\") strVersion(2) = objShell.RegRead("HKLM\SOFTWARE\Adobe\Shockwave 12\currentupdateversion\") strVersion(3) = objShell.RegRead("HKLM\SOFTWARE\Wow6432Node\Adobe\Shockwave 12\currentupdateversion\") On Error GoTo 0 Dim strSWP(32) strSWP(0) = WINDIR & "\System32\Macromed\Shockwave 7\np32dsw.dll" strSWP(1) = WINDIR & "\System32\Macromed\Shockwave 8\np32dsw.dll" strSWP(2) = WINDIR & "\System32\Macromed\Shockwave 9\np32dsw.dll" strSWP(3) = WINDIR & "\System32\Macromed\Shockwave 10\np32dsw.dll" strSWP(4) = WINDIR & "\System32\Macromed\Director\np32dsw.dll" strSWP(5) = WINDIR & "\System32\Adobe\Director\np32dsw.dll" strSWP(6) = WINDIR & "\SysWOW64\Adobe\Director\np32dsw.dll" strSWP(7) = WINDIR & "\System32\Adobe\Director\np32dsw_" & strVersion(0) & ".dll" strSWP(8) = WINDIR & "\SysWOW64\Adobe\Director\np32dsw_" & strVersion(1) & ".dll" strSWP(9) = WINDIR & "\System32\Adobe\Director\np32dsw_" & strVersion(2) & ".dll" strSWP(10) = WINDIR & "\SysWOW64\Adobe\Director\np32dsw_" & strVersion(3) & ".dll" Dim i For i = 0 to 21 strSWP(i + 11) = arrPluginDirectory(i) & "\np32dsw.dll" Next ReDim strFilePath(32) Dim j For j = 0 To 32 If objFSO.FileExists(strSWP(j)) Then strFilePath(j) = strSWP(j) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub AdobeAIR '********************************************************* Sub AdobeAIR strPlugin = "Adobe AIR" ReDim strURL(4) strURL(0) = "http://get.adobe.com/jp/air/" Redim strKeyPath(4), strValue(4) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "Adobe AIR") > 0 Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "Adobe AIR") > 0 Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim strAIR(6) strAIR(0) = PROGRAMSx86 & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR.dll" strAIR(1) = PROGRAMW6432 & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR.dll" strAIR(2) = PROGRAMS & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR.dll" strAIR(3) = PROGRAMSx86 & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR Application Installer.exe" strAIR(4) = PROGRAMW6432 & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR Application Installer.exe" strAIR(5) = PROGRAMS & "\Common Files\Adobe AIR\Versions\1.0\Adobe AIR Application Installer.exe" ReDim strFilePath(6) Dim z On Error Resume Next For z = 0 To Ubound(strAIR) If objFSO.FileExists(strAIR(z)) Then strFilePath(z) = strAIR(z) End If Next On Error GoTo 0 MyRegRead MyFileVer End Sub '********************************************************* ' Sub RealPlayer '********************************************************* Sub RealPlayer strPlugin = "Real Player" ReDim strURL(5) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://jp.real.com/windows/" strURL(2) = "http://jp.real.com/windows/how_to_install.html" strURL(3) = "=== * etc" strURL(4) = "http://service.real.com/realplayer/security/ja/" strURL(5) = "http://i.realone.com/product/help/RealPlayer-SP-1.1/ja/RP.htm" Redim strKeyPath(5), strValue(5) strKeyPath(0) = "HKLM\SOFTWARE\RealNetworks\RealPlayer" strValue(0) = "version" strKeyPath(1) = "HKLM\SOFTWARE\Wow6432Node\RealNetworks\RealPlayer" strValue(1) = "version" Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If InStr(strTest, "RealPlayer") > 0 Then strKeyPath(2) = "HKLM\" & strParKey & "\" & strSubKey strValue(2) = "DisplayVersion" objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayVersion") If Err.Number = -2147024894 Then strKeyPath(2) = "HKLM\" & strParKey & "\" & strSubKey strValue(2) = "" End If Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If InStr(strTestx86, "RealPlayer") > 0 Then strKeyPath(3) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(3) = "DisplayVersion" objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayVersion") If Err.Number = -2147024894 Then strKeyPath(3) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(3) = "" End If Exit For End If Err.Clear Next On Error GoTo 0 Redim strRealFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strRealFile(0) = PROGRAMS & "\Real\realplay.exe" strRealFile(1) = PROGRAMS & "\Real\RealPlayer\realplay.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strRealFile(0) = PROGRAMW6432 & "\Real\realplay.exe" strRealFile(1) = PROGRAMW6432 & "\Real\RealPlayer\realplay.exe" strRealFile(2) = PROGRAMSx86 & "\Real\realplay.exe" strRealFile(3) = PROGRAMSx86 & "\Real\RealPlayer\realplay.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strRealFile(z)) Then strFilePath(z) = strRealFile(z) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub QuickTime '********************************************************* Sub QuickTime strPlugin = "QuickTime Player" ReDim strURL(6) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://www.apple.com/jp/quicktime/download/" strURL(2) = "=== * etc" strURL(3) = "http://www.apple.com/jp/downloads/" strURL(4) = "http://support.apple.com/ja_JP/downloads/" strURL(5) = "http://www.apple.com/support/downloads/" strURL(6) = "http://www.apple.com/jp/ftp-info/" Redim strKeyPath(3), strValue(3) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If strTest = "QuickTime" Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If strTestx86 = "QuickTime" Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 strKeyPath(2) = "HKLM\SOFTWARE\Apple Computer, Inc.\QuickTime" strValue(2) = "Version" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\Apple Computer, Inc.\QuickTime" strValue(3) = "Version" Redim strQTFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strQTFile(0) = PROGRAMS & "\QuickTime\QuickTimePlayer.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strQTFile(0) = PROGRAMW6432 & "\QuickTime\QuickTimePlayer.exe" strQTFile(1) = PROGRAMSx86 & "\QuickTime\QuickTimePlayer.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strQTFile(z)) Then strFilePath(z) = strQTFile(z) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub iTunes '********************************************************* Sub iTunes strPlugin = "iTunes" ReDim strURL(6) strURL(0) = "=== * ダウンロード・サイト" strURL(1) = "http://www.apple.com/jp/itunes/download/" strURL(2) = "=== * etc" strURL(3) = "http://www.apple.com/jp/downloads/" strURL(4) = "http://support.apple.com/ja_JP/downloads/" strURL(5) = "http://www.apple.com/support/downloads/" strURL(6) = "http://www.apple.com/jp/ftp-info/" Redim strKeyPath(3), strValue(3) Dim x, strSubKey, strTest On Error Resume Next For x = 0 To Ubound(arrSubKeys) strSubKey = arrSubKeys(x) strTest = objShell.RegRead("HKLM\" & strParKey & "\" & strSubKey & "\DisplayName") If strTest = "iTunes" Then strKeyPath(0) = "HKLM\" & strParKey & "\" & strSubKey strValue(0) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 Dim y, strSubKeyx86, strTestx86 On Error Resume Next For y = 0 To Ubound(arrSubKeysx86) strSubKeyx86 = arrSubKeysx86(y) strTestx86 = objShell.RegRead("HKLM\" & strParKeyx86 & "\" & strSubKeyx86 & "\DisplayName") If strTestx86 = "iTunes" Then strKeyPath(1) = "HKLM\" & strParKeyx86 & "\" & strSubKeyx86 strValue(1) = "DisplayVersion" Exit For End If Err.Clear Next On Error GoTo 0 strKeyPath(2) = "HKLM\SOFTWARE\MozillaPlugins\@Apple.com/iTunes,version=1.0" strValue(2) = "Version" strKeyPath(3) = "HKLM\SOFTWARE\Wow6432Node\MozillaPlugins\@Apple.com/iTunes,version=1.0" strValue(3) = "Version" Redim strITuFile(4) If PROGRAMW6432 = "%ProgramW6432%" Then strITuFile(0) = PROGRAMS & "\iTunes\iTunes.exe" ElseIf PROGRAMW6432 <> "%ProgramW6432%" Then strITuFile(0) = PROGRAMW6432 & "\iTunes\iTunes.exe" strITuFile(1) = PROGRAMSx86 & "\iTunes\iTunes.exe" End If ReDim strFilePath(4) Dim z For z = 0 To 4 If objFSO.FileExists(strITuFile(z)) Then strFilePath(z) = strITuFile(z) End If Next MyRegRead MyFileVer End Sub '********************************************************* ' Sub MyFileVer -- ファイルのバージョンを表示 '********************************************************* Sub MyFileVer Dim objShellApp, objFolder, objFolderItems, objItem, strName, strName2 Dim strFileName, strFolder Dim y For Each y in strFilePath If y <> "" Then Set objFile = objFSO.GetFile(y) strFileName = objFSO.GetFileName(y) strFolder = objFile.ParentFolder Set objShellApp = CreateObject ("Shell.Application") Set objFolder = objShellApp.Namespace(strFolder) Set objFolderItems = objFolder.Items Set objItem = objFolderItems.Item(strFileName) objTxt.WriteLine "Path : " & y Dim n For n=18 to 400 strName = objFolder.GetDetailsOf(Nothing, n) If strName = "ファイル バージョン" Then objTxt.WriteLine "File Version : " & objFolder.GetDetailsOf(objItem, n) End If Next Dim m For m=18 to 400 strName2 = objFolder.GetDetailsOf(Nothing, m) If strName2 = "製品バージョン" Then objTxt.WriteLine "Product Version : " & objFolder.GetDetailsOf(objItem, m) End If Next objTxt.WriteLine "最終更新日時 : " & objFolder.GetDetailsOf(objItem, 3) objTxt.WriteLine "作成日時 : " & objFolder.GetDetailsOf(objItem, 4) objTxt.WriteLine "サイズ : " & objFolder.GetDetailsOf(objItem, 1) Set objItem = Nothing Set objFolderItems = Nothing Set objFolder = Nothing Set objFile = Nothing Set objShellApp = Nothing End If Next objTxt.WriteBlankLines (1) End Sub '********************************************************* ' Sub MyRegRead -- レジストリエントリを表示 '********************************************************* Sub MyRegRead objTxt.WriteLine "============================================================" objTxt.WriteLine " *** " & strPlugin objTxt.WriteLine "============================================================" Dim url For Each url in strURL If url <> "" Then objTxt.WriteLine url Next objTxt.WriteLine "------------------------------------------------------------" On Error Resume Next Dim x For x = 0 to UBound(strKeyPath) If strKeyPath(x) <> "" Then objShell.RegRead(strKeyPath(x) & "\" & strValue(x)) If Err.Number = 0 Then objTxt.WriteLine "[" & strKeyPath(x) & "]" objTxt.WriteLine "DisplayName" & " : " & objShell.RegRead(strKeyPath(x) & "\" & "DisplayName") objTxt.WriteLine strValue(x) & " : " & objShell.RegRead(strKeyPath(x) & "\" & strValue(x)) objTxt.WriteLine strValue(x) & " : " & Hex(objShell.RegRead(strKeyPath(x) & "\" & strValue(x))) & " (Hex)" objTxt.WriteBlankLines (1) End If Err.Clear End If Next On Error GoTo 0 End Sub