批处理之家 - Powered by Discuz! Board

Option Explicit
' 获取 Excel 对象
Dim oExcel, oBook
Set oExcel = Excel_Init
Set oBook = oExcel.ActiveWorkbook
'提示非台式机用户选择是否继续
If LCase(ChassisType()) <> LCase("Desktop") Then
If CreateObject("WScript.Shell").Popup(_
"你的电脑不是台式机(桌面计算机)，将会导致扬声器发出较大的噪声，请注意调小音量！" & VbCrLf & VbCrLf & _
"退出程序，请按“确定”，否则请按“取消”。(7秒后自动取消)", 7, "警告", 48+4096+1) = 1 Then
WScript.Quit
End If
End If
'内存报警实例
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放BIOS内存报警声……　　　" , 2, "提示", 64+4096+0
Beep 880, 600: Sleep 200 '內存
Beep 880, 200: Sleep 200
Beep 880, 200: Sleep 200
'//do~si 节奏数据来自VBS吧
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放so~si音阶……　　　　　" , 2, "提示", 64+4096+0
playsnd 440, 100
playsnd 494, 100
playsnd 554, 100
playsnd 622, 100
playsnd 698, 100
playsnd 784, 100
playsnd 880, 100
'//周杰伦的回到过去节奏数据来自VBS吧
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放《周杰伦-回到过去》……" , 2, "提示", 64+4096+0
playsnd 587, 100: playsnd 784, 100: playsnd 880, 100: playsnd 988, 100:: playsnd 988, 200: playsnd 0, 100
playsnd 988, 100: playsnd 880, 100: playsnd 988, 100: playsnd 1047, 200: playsnd 988, 100: playsnd 988, 100
playsnd 880, 100: playsnd 100, 150: playsnd 880, 100: playsnd 784, 100:: playsnd 988, 100: playsnd 0, (5)
playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 880, 100
playsnd 784, 100: playsnd 740, 100: playsnd 784, 200: playsnd 100, 200:: playsnd 784, 100: playsnd 880, 100
playsnd 784, 100: playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100:: playsnd 0, (5)::: playsnd 988, 100
playsnd 0, (5)::: playsnd 988, 100: playsnd 100, 100: playsnd 587, 100:: playsnd 784, 100: playsnd 1175, 100
playsnd 0, (5)::: playsnd 1175, 99: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 0, (5)
playsnd 987, 100: playsnd 100, 100: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 100: playsnd 880, 200
playsnd 784, 100: playsnd 0, (5)::: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 50:: playsnd 659, (50)
playsnd 784, 100: playsnd 659, 100: playsnd 784, 100: playsnd 880, 100:: playsnd 100, 100: playsnd 587, 110
playsnd 784, 120: playsnd 880, 130: playsnd 740, 140: playsnd 784, 200:: playsnd 1, 1::::: playsnd 1, 1
' 关闭 Excel
Excel_Quit
WScript.Quit
Function Excel_Init()
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode
Set oExcel = CreateObject("Excel.Application")
set WshShell = CreateObject("WScript.Shell")
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"
Set oBook = oExcel.Workbooks.Add
Set oModule = obook.VBProject.VBComponents.Add(1)
strCode = _
"Declare Sub Beep Lib ""kernel32"" (ByVal fre As Long, ByVal ms As Long)" & vbCr & _
"Declare Sub Sleep Lib ""kernel32"" (ByVal ms As Long)"
oModule.CodeModule.AddFromString strCode
Set Excel_Init = oExcel
End Function
Function playsnd(ByVal x, ByVal y)
Beep x, y * 3
End Function
Sub Beep(fre,ms)
oExcel.Run "Beep",fre,ms
End Sub
Sub Sleep(ms)
oExcel.Run "Sleep",ms
End Sub
Function Excel_Quit()
oExcel.DisplayAlerts = False
'oBook.Close
oExcel.ActiveWorkbook.Close
oExcel.Quit
End Function
'判断计算机类型，只允许台式机发声(笔记本会使用扬声器发声，声音太刺耳)
Function ChassisType()
Dim strComputer, objWMIService, colChassis, objChassis, strChassisType
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colChassis = objWMIService.ExecQuery _
("Select * from Win32_SystemEnclosure")
For Each objChassis in colChassis
For Each strChassisType in objChassis.ChassisTypes
Select Case strChassisType
Case 1
ChassisType = "Other"
Case 2
ChassisType = "Unknown"
Case 3
ChassisType = "Desktop"
Case 4
ChassisType = "Low Profile Desktop"
Case 5
ChassisType = "Pizza Box"
Case 6
ChassisType = "Mini Tower"
Case 7
ChassisType = "Tower"
Case 8
ChassisType = "Portable"
Case 9
ChassisType = "Laptop"
Case 10
ChassisType = "Notebook"
Case 11
ChassisType = "Handheld"
Case 12
ChassisType = "Docking Station"
Case 13
ChassisType = "All-in-One"
Case 14
ChassisType = "Sub-Notebook"
Case 15
ChassisType = "Space Saving"
Case 16
ChassisType = "Lunch Box"
Case 17
ChassisType = "Main System Chassis"
Case 18
ChassisType = "Expansion Chassis"
Case 19
ChassisType = "Sub-Chassis"
Case 20
ChassisType = "Bus Expansion Chassis"
Case 21
ChassisType = "Peripheral Chassis"
Case 22
ChassisType = "Storage Chassis"
Case 23
ChassisType = "Rack Mount Chassis"
Case 24
ChassisType = "Sealed-Case PC"
Case Else
ChassisType = "Unknown"
End Select
Next
Next
End Function