返回列表发帖

yu2n

上尉

Rank: 5 Rank: 5

帖子: 715
积分: 1298
技术: 151
捐助: 0
注册时间: 2012-11-1

1楼 跳转到 » 倒序看帖

打印

字体大小: tT

发表于 2014-9-28 14:17 | 只看该作者

[原创] VBS 调用API函数Beep唱一曲《周杰伦-回到过去》

半原创，很多代码参考了百度VBS贴吧。

 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 FunctionCOPY

『千江有水千江月』千江有水，月映千江；万里无云，万里青天。 http://yu2n.qiniudn.com/

yu2n

上尉

Rank: 5 Rank: 5

帖子: 715
积分: 1298
技术: 151
捐助: 0
注册时间: 2012-11-1

2楼

发表于 2014-9-28 14:18 | 只看该作者

VBS演奏UN (Beep())
http://tieba.baidu.com/p/1245891339

 Option Explicit
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
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 523, 195: Sleep 20
Beep 523, 195: Sleep 20
Beep 523, 195: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 659, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 523, 195: Sleep 20
Beep 523, 195: Sleep 20
Beep 523, 195: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 587, 88: Sleep 20
Beep 494, 88: Sleep 20
Beep 349, 88: Sleep 20
Beep 659, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 587, 410: Sleep 20
Beep 587, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 494, 820: Sleep 20
Beep 587, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 587, 410: Sleep 20
Beep 587, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 494, 820: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 410: Sleep 20
Beep 784, 410: Sleep 20
Beep 880, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 88: Sleep 20
Beep 988, 88: Sleep 20
Beep 880, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 523, 410: Sleep 450
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 410: Sleep 20
Beep 784, 410: Sleep 20
Beep 880, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 88: Sleep 20
Beep 988, 88: Sleep 20
Beep 880, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 880, 840: Sleep 20
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 410: Sleep 20
Beep 784, 410: Sleep 20
Beep 880, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 88: Sleep 20
Beep 988, 88: Sleep 20
Beep 880, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 523, 410: Sleep 450
Beep 440, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 494, 410: Sleep 20
Beep 659, 410: Sleep 20
Beep 523, 410: Sleep 20
Beep 587, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 587, 410: Sleep 20
Beep 784, 410: Sleep 20
Beep 880, 195: Sleep 20
Beep 659, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 195: Sleep 20
Beep 988, 195: Sleep 20
Beep 1047, 88: Sleep 20
Beep 988, 88: Sleep 20
Beep 880, 195: Sleep 20
Beep 784, 195: Sleep 20
Beep 880, 840: Sleep 20
Sub Beep(fre,ms)
oExcel.Run "Beep",fre,ms
End Sub
Sub Sleep(ms)
oExcel.Run "Sleep",ms
End Sub
oExcel.DisplayAlerts = False
oBook.Close
oExcel.QuitCOPY

『千江有水千江月』千江有水，月映千江；万里无云，万里青天。 http://yu2n.qiniudn.com/

TOP

DAIC

中将

Rank: 8 Rank: 8

帖子: 2874
积分: 7021
技术: 336
捐助: 0
注册时间: 2011-6-2

3楼

发表于 2014-9-28 15:01 | 只看该作者

来一曲小苹果吧

sed.exe gawk.exe grep.exe 下载地址

TOP

yu2n

上尉

Rank: 5 Rank: 5

帖子: 715
积分: 1298
技术: 151
捐助: 0
注册时间: 2012-11-1

4楼

发表于 2014-9-28 15:25 | 只看该作者

回复 3# DAIC
不懂啊，请指教。

『千江有水千江月』千江有水，月映千江；万里无云，万里青天。 http://yu2n.qiniudn.com/

TOP

返回列表

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[原创] VBS 调用API函数Beep唱一曲《周杰伦-回到过去》

[收藏此主题] [关注此主题的新回复]

[通过 QQ、MSN 分享给朋友]

设置关闭

开启【页面动态效果 + 卡片式布局】
关闭【页面动态效果 + 卡片式布局】

开启【代码高亮】
关闭【代码高亮】

代码高亮主题【亮】
代码高亮主题【暗】


	设置关闭开启【页面动态效果 + 卡片式布局】关闭【页面动态效果 + 卡片式布局】开启【代码高亮】关闭【代码高亮】代码高亮主题【亮】代码高亮主题【暗】

[原创] VBS 调用API函数Beep唱一曲《周杰伦-回到过去》

[收藏此主题] [关注此主题的新回复]

[通过 QQ、MSN 分享给朋友]

设置 关闭

开启 【页面动态效果 + 卡片式布局】 关闭 【页面动态效果 + 卡片式布局】 开启 【代码高亮】关闭 【代码高亮】代码高亮主题 【亮】代码高亮主题 【暗】

设置关闭

开启【页面动态效果 + 卡片式布局】
关闭【页面动态效果 + 卡片式布局】

开启【代码高亮】
关闭【代码高亮】

代码高亮主题【亮】
代码高亮主题【暗】