Results 1 to 9 of 9

Thread: Asynchronous Beep by vb6(NtDeviceIoControlFile)

  1. #1

    Thread Starter
    Taking a Break
    Join Date
    Jan 2020
    Posts
    1,340

    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

  2. #2
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    321

    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
    leandroascierto.com Visual Basic 6 projects

  3. #3

    Thread Starter
    Taking a Break
    Join Date
    Jan 2020
    Posts
    1,340

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    Quote Originally Posted by LeandroA View Post
    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?

  4. #4
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    321

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    Quote Originally Posted by xiaoyao View Post
    Are you a musician?
    yes,i'm play keyboard/Organ
    leandroascierto.com Visual Basic 6 projects

  5. #5
    Addicted Member
    Join Date
    Jun 2016
    Location
    Espaņa
    Posts
    247

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    you are the best Leandro
    Last edited by yokesee; May 13th, 2021 at 04:39 PM.

  6. #6
    Fanatic Member
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    931

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    Perhaps better for the code bank?

  7. #7

    Thread Starter
    Taking a Break
    Join Date
    Jan 2020
    Posts
    1,340

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    Your optimists are really like a group of young children

  8. #8
    New Member
    Join Date
    Jul 2020
    Posts
    8

    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.

  9. #9
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    3,029

    Re: Asynchronous Beep by vb6(NtDeviceIoControlFile)

    Quote Originally Posted by Visualman View Post
    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
  •  



Click Here to Expand Forum to Full Width