Option Explicit
 
' API Deklarationen
Public 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
 
' Aufnahmeformate
Public Enum BitsPerSec
  Bits16 = 16
  Bits8 = 8
End Enum
 
Public Enum SampelsPerSec
  Sampels8000 = 8000
  Sampels11025 = 11025
  Sampels12000 = 12000
  Sampels16000 = 16000
  Sampels22050 = 22050
  Sampels24000 = 24000
  Sampels32000 = 32000
  Sampels44100 = 44100
  Sampels48000 = 48000
End Enum
 
Public Enum Channels
  Mono = 1
  Stereo = 2
End Enum
 
Public Sub StartRecord(ByVal BPS As BitsPerSec, _
  ByVal SPS As SampelsPerSec, ByVal Mode As Channels)
 
  Dim retStr As String
  Dim cBack As Long
  Dim BytesPerSec As Long
 
  retStr = Space$(128)
  BytesPerSec = (Mode * BPS * SPS) / 8
  mciSendString "open new type waveaudio alias capture", retStr, 128, cBack
  mciSendString "set capture time format milliseconds" & _
    " bitspersample " & CStr(BPS) & _
    " samplespersec " & CStr(SPS) & _
    " channels " & CStr(Mode) & _
    " bytespersec " & CStr(BytesPerSec) & _
    " alignment 4", retStr, 128, cBack
  mciSendString "record capture", retStr, 128, cBack
End Sub
 
Public Sub SaveRecord(strFile)
  Dim retStr As String
  Dim TempName As String
  Dim cBack As Long
  Dim fs, F
 
  ' Speichern im Root als Temp
  TempName = Left$(strFile, 3) & "Temp.wav"
  retStr = Space$(128)
  mciSendString "stop capture", retStr, 128, cBack
  mciSendString "save capture " & TempName, retStr, 128, cBack
  mciSendString "close capture", retStr, 128, cBack
 
  ' Datei verschieben
  Set fs = CreateObject("scripting.filesystemobject")
  Set F = fs.GetFile(TempName)
  F.Move (strFile)
End Sub

Option Explicit
 
Private Sub Form_Load()
  ' Buttons initialisieren
  Command1.Caption = "Start Aufnahme"
  Option1.Caption = "Telefonqualität"
  Option2.Caption = "Radioqualität"
  Option3.Caption = "CD Qualität"
  Option3.Value = True
End Sub
 
Private Sub Command1_Click()
  Dim strFileName As String
  Dim zeit As String
  zeit = Text1.Text
 
 
  ' Dateiname
  strFileName = App.Path & "\Aufnahme.wav"
 
  ' Aufnahme starten
  If Command1.Caption = "Start Aufnahme" Then
    ' Aufnahmeformat festlegen
    If Option1.Value = True Then
      StartRecord Bits8, Sampels11025, Mono
    ElseIf Option2.Value = True Then
      StartRecord Bits8, Sampels22050, Mono
    ElseIf Option3.Value = True Then
      StartRecord Bits16, Sampels44100, Stereo
    End If
 
    ' Options sperren & Buttontext ändern
    Option1.Enabled = False
    Option2.Enabled = False
    Option3.Enabled = False
    Command1.Caption = "Stop Aufnahme"
  Else
 
 
      ' Aufnahme stoppen & Datei speichern/überschreiben
    If Dir(strFileName) <> "" Then Kill strFileName
    SaveRecord strFileName
 
 
    ' Options freigeben und Buttontext ändern
    Option1.Enabled = True
    Option2.Enabled = True
    Option3.Enabled = True
    Command1.Caption = "Start Aufnahme"
  End If
End Sub
 
Private Sub Timer1_Timer()
Text1.Text = Format(Now, "hh:mm:ss")
End Sub