Play the sound of the specified frequency and duration
Code:
Sub Main()
Dim AsyncBeep2 As New AsyncBeep
AsyncBeep2.Play 1000, 2024
MsgBox "ok"
End SubCode:
' 异步版 Beep，作者YY菌，技术交流群（QQ）：250264265
'AsyncBeep.cls
'Asynchronous version of Beep, author YY bacteria, technical exchange group (QQ): 250264265
Option Explicit
'Input and output status
Private Type IO_STATUS_BLOCK
Status As Long
Information As Long
End Type
'Unicode string
Private Type UNICODE_STRING
Length As Integer
MaximumLength As Integer
Buffer As String
End Type
'Object properties
Private Type OBJECT_ATTRIBUTES
Length As Long
RootDirectory As Long
ObjectName As Long
Attributes As Long
SecurityDescriptor As Long
SecurityQualityOfService As Long
End Type
'Beep parameter
Private Type BEEP_SET_PARAMETERS
Frequency As Long
Duration As Long
End Type
'Beep related constants
Const BEEP_FREQUENCY_MINIMUM& = &H25&
Const BEEP_FREQUENCY_MAXIMUM& = &H7FFF&
Const IOCTL_BEEP_SET& = &H10000
Const DD_BEEP_DEVICE_NAME$ = "\Device\Beep"
'Permission constant
Private Enum ACCESS_MASK
FILE_READ_DATA = &H1&
FILE_WRITE_DATA = &H2&
End Enum
'Open constant
Private Enum CREATE_DISPOSITION
CREATE_NEW = 1
CREATE_ALWAYS = 2
OPEN_EXISTING = 3
OPEN_ALWAYS = 4
TRUNCATE_EXISTING = 5
End Enum
'API statement
Private Declare Function NtCreateFile Lib "ntdll" (ByRef FileHandle As Long, ByVal DesiredAccess As ACCESS_MASK, ObjectAttributes As OBJECT_ATTRIBUTES, IoStatusBlock As IO_STATUS_BLOCK, ByVal AllocationSize As Long, ByVal FileAttributes As Long, ByVal ShareAccess As ACCESS_MASK, ByVal CreateDisposition As CREATE_DISPOSITION, ByVal CreateOptions As Long, EaBuffer As Any, ByVal EaLength As Long) As Long
Private Declare Function NtDeviceIoControlFile Lib "ntdll" (ByVal FileHandle As Long, ByVal EventHandle As Long, ByVal ApcRoutine As Long, ByVal ApcContext As Long, IoStatusBlock As IO_STATUS_BLOCK, ByVal IoControlCode As Long, InputBuffer As Any, ByVal InputBufferLength As Long, OutputBuffer As Any, ByVal OutputBufferLength As Long) As Long
Private Declare Function NtClose Lib "ntdll" (ByVal FileHandle As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Device handle
Dim hDev As Long
'Constructor (open the Beep device)
Private Sub Class_Initialize()
Dim iosb As IO_STATUS_BLOCK
Dim path As UNICODE_STRING
Dim objAttr As OBJECT_ATTRIBUTES
With path
.Buffer = DD_BEEP_DEVICE_NAME
.Length = LenB(.Buffer)
.MaximumLength = .Length + 2
End With
With objAttr
.Length = path.Length
.ObjectName = VarPtr(path)
End With
NtCreateFile hDev, FILE_WRITE_DATA, objAttr, iosb, 0&, 0&, FILE_READ_DATA Or FILE_WRITE_DATA, OPEN_EXISTING, 0&, ByVal 0&, 0&
End Sub
'Destructor (close the Beep device)
Private Sub Class_Terminate()
NtClose hDev
End Sub
'Get Beep device handle
Public Property Get Handle() As Long
Handle = hDev
End Property
'Play the sound of the specified frequency and duration
Public Function Play(ByVal dwFreq As Long, ByVal dwDuration As Long) As Boolean
Dim iosb As IO_STATUS_BLOCK
Dim bsp As BEEP_SET_PARAMETERS
With bsp
.Frequency = dwFreq
.Duration = dwDuration
End With
Play = NtDeviceIoControlFile(hDev, 0&, 0&, 0&, iosb, IOCTL_BEEP_SET, bsp, LenB(bsp), ByVal 0&, 0&) >= 0
End Function