'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' PC環境取得スクリプト getpcinfo.vbs ' Alicesoft 2006/06/13 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' スタートアップ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim StartupResult StartupResult = MsgBox("PC環境を取得します" & vbNewLine & _ "OKボタンを押してから、しばらくお待ち下さい", _ vbYesNo, "PC環境取得スクリプト") If StartupResult = vbYes Then RunMain() End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' メインルーチン '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function RunMain() Set WMI = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\.\root\cimv2") Dim strCPU Dim strMem Dim strDisk Dim strDrive Dim strCDROM Dim strVideo Dim strSound Dim strOS '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' CPU '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strCPU = "CPU" & vbNewLine On Error Resume Next Set CPUSet = WMI.ExecQuery("Select * From Win32_Processor") For Each CPU In CPUSet strCPU = strCPU & MakeInfoText("種類", CPU.Description) strCPU = strCPU & MakeInfoText("キャプション", CPU.Caption) strCPU = strCPU & MakeInfoText("名前", CPU.Name) strCPU = strCPU & MakeInfoText("製造元", CPU.Manufacturer) strCPU = strCPU & MakeInfoText("現在の周波数", CPU.CurrentClockSpeed) strCPU = strCPU & MakeInfoText("最大の周波数", CPU.MaxClockSpeed) strCPU = strCPU & MakeInfoText("L2キャッシュサイズ", CPU.L2CacheSize) strCPU = strCPU & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' メモリ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strMem = "メモリ" & vbNewLine On Error Resume Next Set MemSet = WMI.ExecQuery("Select * From Win32_ComputerSystem") For Each Mem In MemSet strMem = strMem & MakeInfoText("サイズ", Mem.TotalPhysicalMemory) strMem = strMem & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ディスクドライブ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strDisk = "ディスクドライブ" & vbNewLine On Error Resume Next Set DiskSet = WMI.ExecQuery("Select * From Win32_DiskDrive") For Each Disk In DiskSet strDisk = strDisk & MakeInfoText("キャプション", Disk.Caption) strDisk = strDisk & MakeInfoText("名前", Disk.Name) strDisk = strDisk & MakeInfoText("サイズ", Disk.Size) strDisk = strDisk & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ドライブ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strDrive = "HDDドライブ" & vbNewLine Set FSO = CreateObject("Scripting.FileSystemObject") For i = 0 To 25 DriveName = Chr(Asc("A") + i) & ":" On Error Resume Next Set Drive = FSO.GetDrive(DriveName) If Err.Number = 0 Then If Drive.DriveType = 2 Then strDrive = strDrive & MakeInfoText("ドライブ名", DriveName) strDrive = strDrive & MakeInfoText("容量", Drive.TotalSize) strDrive = strDrive & MakeInfoText("空き容量", Drive.FreeSpace) strDrive = strDrive & vbNewLine End If End If On Error GoTo 0 Next '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' マザーボード '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strMB = "マザーボード" & vbNewLine On Error Resume Next Set MBSet = WMI.ExecQuery("Select * From Win32_BaseBoard") For Each MB In MBSet strMB = strMB & MakeInfoText("キャプション", MB.Caption) strMB = strMB & MakeInfoText("名前", MB.Name) strMB = strMB & MakeInfoText("製造元", MB.Manufacturer) strMB = strMB & MakeInfoText("製品名", MB.Product) strMB = strMB & MakeInfoText("バージョン", MB.Version) strMB = strMB & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' CD-ROMドライブ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strCDROM = "CD-ROMドライブ" & vbNewLine On Error Resume Next Set CDROMSet = WMI.ExecQuery("Select * From Win32_CDROMDrive") For Each CDROM In CDROMSet strCDROM = strCDROM & MakeInfoText("キャプション", CDROM.Caption) strCDROM = strCDROM & MakeInfoText("名前", CDROM.Name) strCDROM = strCDROM & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ビデオカード '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strVideo = "ビデオカード" & vbNewLine On Error Resume Next Set VideoSet = WMI.ExecQuery("Select * From Win32_VideoController") For Each Video In VideoSet strVideo = strVideo & MakeInfoText("キャプション", Video.Caption) strVideo = strVideo & MakeInfoText("名前", Video.Name) strVideo = strVideo & MakeInfoText("プロセッサ", Video.VideoProcessor) strVideo = strVideo & MakeInfoText("メモリ容量", Video.AdapterRAM) strVideo = strVideo & MakeInfoText("ドライババージョン", Video.DriverVersion) strVideo = strVideo & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' サウンドカード '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strSound = "サウンドカード" & vbNewLine On Error Resume Next Set SoundSet = WMI.ExecQuery("Select * From Win32_SoundDevice") For Each Sound In SoundSet strSound = strSound & MakeInfoText("キャプション", Sound.Caption) strSound = strSound & MakeInfoText("名前", Sound.Name) strSound = strSound & MakeInfoText("Manufacturer", Sound.Manufacturer) strSound = strSound & MakeInfoText("ProductName", Sound.ProductName) strSound = strSound & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' OS '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' strOS = "OS" & vbNewLine On Error Resume Next Set OpeSet = WMI.ExecQuery("Select * From Win32_OperatingSystem") For Each Ope In OpeSet strOS = strOS & MakeInfoText("キャプション", Ope.Caption) strOS = strOS & MakeInfoText("言語", Ope.OSLanguage) strOS = strOS & MakeInfoText("ServicePackMajorVersion", Ope.ServicePackMajorVersion) strOS = strOS & MakeInfoText("ServicePackMinorVersion", Ope.ServicePackMinorVersion) strOS = strOS & MakeInfoText("バージョン", Ope.Version) strOS = strOS & MakeInfoText("ビルド番号", Ope.BuildNumber) strOS = strOS & vbNewLine Next On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 出力 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set FS = WScript.CreateObject("Scripting.FileSystemObject") strSaveFileName = "result.txt" Set File = FS.CreateTextFile(strSaveFileName, True) On Error Resume Next File.WriteLine "■ " & strCPU File.WriteLine "■ " & strMem File.WriteLine "■ " & strDisk File.WriteLine "■ " & strDrive File.WriteLine "■ " & strMB File.WriteLine "■ " & strCDROM File.WriteLine "■ " & strVideo File.WriteLine "■ " & strSound File.WriteLine "■ " & strOS On Error GoTo 0 File.Close WScript.Echo strSaveFileName & vbNewLine & vbNewLine & _ "に結果を保存しました" End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function MakeInfoText(text1, text2) SpaceLength = 24 - LenSJIS(text1) If SpaceLength < 0 Then SpaceLength = 0 MakeInfoText = text1 & Space(SpaceLength) _ & " : " & LTrim(text2) & vbNewLine End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function LenSJIS(text) Length = 0 Dim i For i = 1 To Len(text) Code = Asc(Mid(text, i , 1)) If Code >= 0 And Code < 128 Then Length = Length + 1 Else Length = Length + 2 End If Next LenSJIS = Length End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function GetComputerName() Set Net = CreateObject("WScript.Network") GetComputerName = Net.ComputerName End Function