サウンド録音プログラムの例

' 宣言セクション
Dim Buffer() As Byte   ' 録音されたデータを受け取るためのバッファ
Dim fileRec As Integer ' 録音されたデータを保存する一時ファイルのファイル番号
Dim strRecFileName As String  ' 一時ファイルのファイル名
Dim WaveSize As Long   ' 録音されたデータのサイズ

' 新規作成のプロシージャ
Private Sub cmdNew_Click()
    ' 初期化します。
    Init
    
    ' [録音] ボタンにフォーカスを設定します。
    cmdRec.SetFocus
End Sub

' 録音を開始するプロシージャ
Private Sub cmdRec_Click()
' 録音を開始します。

    Dim i As Integer
    
    ' デバイスを開きます。
    WaveIn.Open
    
    ' バッファを確保します。
    ReDim Buffer(WaveIn.BufferSize - 1)
    
    ' バッファを追加します。
    For i = 0 To WaveIn.NumBuffers - 1
        WaveIn.AddBuffer i
    Next i
    
    ' 録音を開始します。
    WaveIn.Start
End Sub

' 保存のプロシージャ
Private Sub cmdSave_Click()
' 録音したサウンドを WAVE ファイルに保存します。
    Dim strFileName As String
    
    strFileName = InputBox("ファイル名を入力してください。", "WAVE ファイルの保存", "Sound.wav")
    If (strFileName <> "") Then
        SaveWaveFile strFileName, fileRec
    End If
End Sub

' 録音を停止するプロシージャ
Private Sub cmdStop_Click()
    ' 録音を停止します。
    WaveIn.Stop
End Sub

' 終了処理
Private Sub Form_Unload(Cancel As Integer)
    ' 録音を停止します。
    WaveIn.Stop
    
    ' デバイスを閉じます。
    WaveIn.Close
    
    ' ファイルを閉じます。
    Close
    
    ' 録音用の一時ファイルを削除します。
    DeleteTmpFile
End Sub

' OnBusyFlagChange イベントの処理
Private Sub WaveIn_OnBusyFlagChange()
    ' 録音中であれば、
    If (WaveIn.IsBusy) Then
        ' [録音]、[保存]、[新規作成] ボタンを無効にします。
        cmdRec.Enabled = False
        cmdSave.Enabled = False
        cmdNew.Enabled = False

        ' [停止] ボタンを有効にします。
        cmdStop.Enabled = True

        ' [停止] ボタンにフォーカスを設定します。
        cmdStop.SetFocus

    ' 録音中でなければ、
    Else
        ' WAVE 入力デバイスを閉じます。
        WaveIn.Close

        ' [録音]、[保存]、[新規作成] ボタンを有効にします。
        cmdRec.Enabled = True
        cmdSave.Enabled = True
        cmdNew.Enabled = True

        ' [停止] ボタンを無効にします。
        cmdStop.Enabled = False
    End If
End Sub

' OnDone イベントの処理
Private Sub WaveIn_OnDone(ByVal BufferIndex As Integer, ByVal BytesRecorded As Long, ByVal bStopped As Boolean)
    ' データが録音されていれば、
    If (BytesRecorded > 0) Then
        ' 録音されたデータを取得します。
        WaveIn.GetData Buffer, BufferIndex, BytesRecorded

        If (UBound(Buffer) > (BytesRecorded - 1)) Then
            ' 無効なデータが書き込まれないように、配列のサイズを調整します。
            ReDim Preserve Buffer(BytesRecorded - 1)

            ' データをファイルに保存します。
            If (fileRec <> 0) Then
                Put fileRec, , Buffer
            End If

            ' 配列のサイズを元に戻します。
            ReDim Buffer(WaveIn.BufferSize - 1)
        Else
            ' データをファイルに保存します。
            If (fileRec <> 0) Then
                Put fileRec, , Buffer
            End If
        End If

        ' 録音されたデータ量を保存します。
        WaveSize = WaveSize + BytesRecorded
    End If
    
    ' Stop メソッドが実行されていなければ、
    If (bStopped = False) Then
        ' 録音用のバッファを追加します。
        WaveIn.AddBuffer BufferIndex
    End If
End Sub

' Form_Load イベントの処理
Private Sub Form_Load()
    ' 一時ファイルを開きます。
    strRecFileName = "~Record.tmp"
    OpenTmpFile
    ' 初期化します。
    Init
End Sub

' 一時ファイルを開く
Private Function OpenTmpFile() As Boolean
    ' 録音用のファイルを開いていなければ、
    If (fileRec = 0) Then
        ' 録音のための一時ファイルを開きます。
        fileRec = FreeFile
        Open strRecFileName For Binary Access Read Write Lock Write As fileRec
    End If
End Function

' 一時ファイルを閉じる
Private Sub CloseTmpFile()
' 録音用の一時ファイルを閉じます。
    If (fileRec <> 0) Then
        Close fileRec
        fileRec = 0
    End If
End Sub

' 一時ファイルを削除する
Private Sub DeleteTmpFile()
' 録音用の一時ファイルを削除します。
    CloseTmpFile
    If (Dir(strRecFileName) <> "") Then
        Kill strRecFileName
        WaveSize = 0
    End If
End Sub

' 初期化
Private Sub Init()
' 初期化を行います。
    ' 一時ファイルを削除します。
    DeleteTmpFile
    
    ' 一時ファイルを開きます。
    OpenTmpFile
    
    ' [録音] ボタンを有効にします。
    cmdRec.Enabled = True

    ' [停止]、[保存] ボタンを無効にします。
    cmdStop.Enabled = False
    cmdSave.Enabled = False

    ' 変数を初期化します。
    WaveSize = 0
End Sub

' WAVE ファイルを保存する
Private Sub SaveWaveFile(strFileName As String, DataFile As Integer)
' 録音されたデータを WAVE ファイルとして保存します。
' strFileName : 保存するファイル名。
' DataFile    : PCM データが記録されている一時ファイルのファイル番号。

    Dim hdr             As WAVEFILEHEADER
    Dim file            As Integer
    Dim DataSize        As Long
    Dim BytesWritten    As Long
    Dim BytesToWrite    As Long
    Const BufferSize = 65536    ' ファイルの読み書きに使用するバッファのサイズ。
    Dim Buffer()        As Byte ' ファイルの読み書きに使用するバッファ。
    
    ' DataFile が開いていなければ、リターンします。
    If (DataFile = 0) Then
        Exit Sub
    End If
    
    ' ファイルの先頭へシークします。
    Seek DataFile, 1
    
    ' PCM データのサイズを取得します。
    DataSize = LOF(DataFile)
    
    ' 空いているファイル番号を取得します。
    file = FreeFile()
    
    ' バイナリ書き込みモードでファイルを開きます。
    Open strFileName For Binary Access Write As file
    
    ' ファイルに書き込むヘッダ情報を初期化します。
    With hdr
        .ckidRIFF = "RIFF"              ' RIFF チャンクの ID。
        .ckSizeRIFF = DataSize + 36     ' PCM データのサイズ + 36 バイト。
        .fccType = "WAVE"               ' WAVE ファイルであることを示します。
        .ckidFmt = "fmt "               ' fmt チャンクの ID。
        .ckSizeFmt = 16                 ' fmt チャンクのサイズ。
        With .WaveFmt                   ' フォーマット情報。
            With .wf
                .wFormatTag = WAVE_FORMAT_PCM               ' フォーマット タグ。
                .nChannels = WaveIn.Channels                ' チャネル数。
                .nSamplesPerSec = WaveIn.SamplesPerSec      ' サンプリング周波数。
                .nAvgBytesPerSec = WaveIn.AvgBytesPerSec    ' 平均データ レート。
                .nBlockAlign = WaveIn.BlockAlign            ' ブロック アラインメント。
            End With
            .wBitsPerSample = WaveIn.BitsPerSample          ' 量子化ビット数。
        End With
        .ckidData = "data"              ' data チャンクの ID。
        .ckSizeData = DataSize          ' PCM データのサイズ。
    End With
    
    ' ヘッダ情報を書き込みます。
    Put file, , hdr
    
    ' ファイルの書き込みに使用するバッファを確保します。
    ReDim Buffer(BufferSize - 1) As Byte
    
    ' PCM データを書き込みます。
    Do Until EOF(DataFile)
        BytesToWrite = Min(BufferSize, (DataSize - BytesWritten))
        If (BytesToWrite = 0) Then
            Exit Do
        End If
        ReDim Buffer(BytesToWrite - 1)
        Get DataFile, , Buffer
        Put file, , Buffer
        BytesWritten = BytesWritten + BytesToWrite
    Loop
    
    ' ファイルを閉じます。
    Close file
End Sub

' 小さい方の値を返す関数
Private Function Min(a As Long, b As Long) As Long
' a, b のうち、小さい方を返します。

    If (a > b) Then
        Min = b
    Else
        Min = a
    End If
End Function

' WAVE ファイルのフォーマットタグ。
Public Const WAVE_FORMAT_PCM = 1

' WAVEFORMAT 構造体。
Type WAVEFORMAT
    wFormatTag      As Integer
    nChannels       As Integer
    nSamplesPerSec  As Long
    nAvgBytesPerSec As Long
    nBlockAlign     As Integer
End Type

' PCMWAVEFORMAT 構造体。
Type PCMWAVEFORMAT
    wf              As WAVEFORMAT
    wBitsPerSample  As Integer
End Type

' WAVE ファイルのヘッダ。
Type WAVEFILEHEADER
    ckidRIFF    As String * 4
    ckSizeRIFF  As Long
    fccType     As String * 4
    ckidFmt     As String * 4
    ckSizeFmt   As Long
    WaveFmt     As PCMWAVEFORMAT
    ckidData    As String * 4
    ckSizeData  As Long
End Type