Anti-FAQ

Anti-FAQ: Jak nagrać WAV?

Sposób podał Marek Pochroń, poniżej cytuję tekst Marka w całości:

Witam wszystkich Kiedyś miałem problem jak z poziomu VB nagrywać wavy. Poniższy kod pozwala nagrać wav i zapisac go w dowolnym katalogu pod nazwa np. ID rekordu. Dziękuje wszystkim, którzy pomogli mi w rozwiązaniu tego problemu. Pozdrawiam Marek marek@marek-p.prv.pl

Declare Function mciSendString Lib "winmm.dll" _
		Alias "mciSendStringA" _
		(ByVal lpstrCommand As String, _
		ByVal lpstrReturnString As String, _
		ByVal uReturnLength As Long, _
		ByVal hwndCallback As Long) As Long
		
Declare Function mciGetErrorString Lib "winmm.dll" _
		Alias "mciGetErrorStringA" _
		(ByVal dwError As Long, _
		ByVal lpstrBuffer As String, _
		ByVal uLength As Long) As Long

Dim Result&

Public Function CloseSound()
    Dim errormsg%
    Dim ReturnString As String * 1024
    Dim ErrorString As String * 1024
    Result& = mciSendString("close mysound", ReturnString, 1024, 0)

End Function

Public Function RecordSound()
    Dim errormsg%
    Dim ReturnString As String * 1024
    Dim ErrorString As String * 1024
    
    CloseSound

    Result& = mciSendString("open new type waveaudio alias mysound", ReturnString, 1024, 0)

    If Not Result& = 0 Then
        errormsg% = mciGetErrorString(Result&, ErrorString, 1024)
        MsgBox ErrorString, 0, "Error"
        Exit Function
    End If

    Result& = mciSendString("set mysound time format ms bitspersample 16 samplespersec 11025 channels 1", ReturnString, 1024, 0)
    If Not Result& = 0 Then
        errormsg% = mciGetErrorString(Result&, ErrorString, 1024)
        MsgBox ErrorString, 0, "Error"
        Exit Function
    End If

    Result& = mciSendString("record mysound", ReturnString, 1024, 0)
    If Not Result& = 0 Then
        errormsg% = mciGetErrorString(Result&, ErrorString, 1024)
        MsgBox ErrorString, 0, "Error"
        Exit Function
    End If

End Function

Public Function PlayRecSound(ID As String)
    Dim errormsg%
    Dim ReturnString As String * 1024
    Dim ErrorString As String * 1024

    Result& = mciSendString("stop mysound", ReturnString, 1024, 0)
    If Not Result& = 0 Then
        errormsg% = mciGetErrorString(Result&, ErrorString, 1024)
        MsgBox ErrorString, 0, "Error"
    End If

    Result& = mciSendString("open DYSK:\KATALOG\" & ID & ".wav alias mysound", ReturnString, 1024, 0)
    Result& = mciSendString("play mysound", ReturnString, 1024, 0)
    If Not Result& = 0 Then
        errormsg% = mciGetErrorString(Result&, ErrorString, 1024)
        MsgBox ErrorString, 0, "Error"
    End If

End Function

Public Function SaveSound(ID As String)
Dim errormsg%
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024

    Result& = mciSendString("stop mysound", ReturnString, 1024, 0)
    Result& = mciSendString("save mysound DYSK:\KATALOG\" & ID & ".wav", ReturnString, 1024, 0)
    Result& = mciSendString("close mysound", ReturnString, 1024, 0)

End Function