-
May 13th, 2021, 02:50 AM
#1
Thread Starter
PowerPoster
Asynchronous Beep by vb6(NtDeviceIoControlFile)
Play the sound of the specified frequency and duration
Code:
Sub Main()
Dim AsyncBeep2 As New AsyncBeep
AsyncBeep2.Play 1000, 2024
MsgBox "ok"
End Sub
Code:
' 异步版 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
-
May 13th, 2021, 05:03 AM
#2
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Code:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const E = 659
Const D = 587
Const C = 523
Const B = 493
Const A = 440
Const G = 392
Dim AsyncBeep2 As New Class1
Private Sub main()
Play D, 250
Play C, 250
Play B, 250
Play G, 250
Play A, 250
Play 0, 250
Play A, 250
Play E, 250
Play D, 250
Play 0, 250
Play C, 250
Play 0, 250
Play B, 250
Play 0, 250
Play B, 250
Play B, 250
Play D, 250
Play 0, 250
Play C, 250
Play B, 250
Play A, 250
Play 0, 250
Play A, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play A, 250
Play 0, 250
Play A, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
End Sub
Private Sub Play(ByVal dwFreq As Long, ByVal dwDuration As Long)
If dwFreq > 0 Then AsyncBeep2.Play dwFreq, dwDuration
Sleep dwDuration
End Sub
-
May 13th, 2021, 08:57 AM
#3
Thread Starter
PowerPoster
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Originally Posted by LeandroA
Code:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const E = 659
Const D = 587
Const C = 523
Const B = 493
Const A = 440
Const G = 392
Dim AsyncBeep2 As New Class1
Private Sub main()
Play D, 250
Play C, 250
Play B, 250
Play G, 250
Play A, 250
Play 0, 250
Play A, 250
Play E, 250
Play D, 250
Play 0, 250
Play C, 250
Play 0, 250
Play B, 250
Play 0, 250
Play B, 250
Play B, 250
Play D, 250
Play 0, 250
Play C, 250
Play B, 250
Play A, 250
Play 0, 250
Play A, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play A, 250
Play 0, 250
Play A, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
Play B * 2, 250
Play C * 2, 250
End Sub
Private Sub Play(ByVal dwFreq As Long, ByVal dwDuration As Long)
If dwFreq > 0 Then AsyncBeep2.Play dwFreq, dwDuration
Sleep dwDuration
End Sub
Are you a musician?
-
May 13th, 2021, 02:31 PM
#4
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Originally Posted by xiaoyao
Are you a musician?
yes,i'm play keyboard/Organ
-
May 13th, 2021, 04:35 PM
#5
Hyperactive Member
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Last edited by yokesee; May 13th, 2021 at 04:39 PM.
-
May 13th, 2021, 07:03 PM
#6
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Perhaps better for the code bank?
-
May 13th, 2021, 09:18 PM
#7
Thread Starter
PowerPoster
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Your optimists are really like a group of young children
-
May 14th, 2021, 01:53 AM
#8
Junior Member
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Great code. But use my delay function. Sleep - suspends the whole process.
Code:
Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Sub Delay(ByVal Milliseconds As Long)
Dim lngHandle As Long
Dim lngRetVal As Long
Dim lngTotalMS As Long
On Error GoTo PROC_ERR
Const WAIT_INCREMEMENT As Long = 5
lngTotalMS = 0
lngHandle = CreateEvent(ByVal 0&, False, False, ByVal 0&)
Do While lngTotalMS < Milliseconds
lngRetVal = WaitForSingleObject(lngHandle, WAIT_INCREMEMENT)
lngTotalMS = lngTotalMS + WAIT_INCREMEMENT
DoEvents
Loop
PROC_EXIT:
On Error Resume Next
lngRetVal = CloseHandle(lngHandle)
Exit Sub
PROC_ERR:
Resume PROC_EXIT
End Sub
This is necessary because if you close the application, the sound continues:
'In module declares:
Code:
Dim boolStop As Boolean
Code:
Private Sub Play(ByVal dwFreq As Long, ByVal dwDuration As Long)
If boolStop = False Then
If dwFreq > 0 Then AsyncBeep2.Play dwFreq, dwDuration
Delay dwDuration
End If
End Sub
Private Sub Form_Load()
boolStop = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
boolStop = True
End Sub
Last edited by Visualman; May 14th, 2021 at 02:09 AM.
-
May 14th, 2021, 02:11 AM
#9
Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)
Originally Posted by Visualman
Great code. But use my delay function. Sleep - suspends the whole process.
Sleep API is not used in the original code and the declare can be safely removed as there is no need for any delay in the original code but this dead declare uses space in the output executable.
Btw, using DoEvents to implement delay in VB6 is a recipe for disaster -- just *don't* and stick to Sleep API.
cheers,
</wqw>
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|