Option Explicit
'This prgram creates a WAV file and plays it.
'Note that it may not work properly on double byte systems, since the WriteOut function assume we are
'running on a single byte system. This probably will not work on a Chinese or Japanese system.

Dim fso, f
Set fso=createObject("Scripting.FileSystemObject")
Set f=fso.CreateTextFile("e:\test.wav", True)

Sub CommandButton1_Click
    Dim RIFF: RIFF = &h46464952
    Dim WAVE: WAVE = &h45564157
    Dim formatChunkSize: formatChunkSize = 16
    Dim headerSize: headerSize = 8
    Dim format: format = &h20746D66
    Dim formatType: formatType = 1
    Dim tracks: tracks = 1
    Dim samplesPerSecond: samplesPerSecond = 44100
    Dim bitsPerSample: bitsPerSample = 16
    Dim frameSize: frameSize = int(tracks * ((bitsPerSample + 7)/8))
    Dim bytesPerSecond: bytesPerSecond = samplesPerSecond * frameSize
    Dim waveSize: waveSize = 4
    Dim data: data = &h61746164
    Dim samples: samples = 88200 * 4
    Dim dataChunkSize: dataChunkSize = samples * frameSize
    Dim fileSize: fileSize = waveSize + headerSize + formatChunkSize + headerSize + dataChunkSize
    Dim tempCaption
    tempCaption=commandbutton1.caption
    commandbutton1.caption="Generating...."
    WriteOut RIFF, 4
    WriteOut fileSize, 4 
    WriteOut WAVE, 4
    WriteOut format, 4
    WriteOut formatChunkSize, 4
    WriteOut formatType, 2
    WriteOut tracks, 2
    WriteOut samplesPerSecond, 4
    WriteOut bytesPerSecond, 4
    WriteOut frameSize, 2
    WriteOut bitsPerSample, 2
    WriteOut data, 4
    WriteOut dataChunkSize, 4
    Dim aNatural: aNatural = 220.0
    Dim ampl: ampl = 10000
    Dim perfect: perfect = 1.5
    Dim concert: concert = 1.498307077
    Dim freq: freq = aNatural * perfect
    Dim PI: PI = 4 * atn(1)
    Dim i, t, s
    For i = 0 to samples / 4
        t = i / samplesPerSecond
        s = int(ampl * (Sin(t * freq * 2.0 * PI)))
        'If s<0 Then MsgBox ampl & " " & t & " " & freq & " " & pi & " " & t * freq * 2.0 * PI
        WriteOut s, 2
    Next
    freq = aNatural * concert
    For i = 0 to samples / 4
        t = i / samplesPerSecond
        s = int(ampl * (Sin(t * freq * 2.0 * PI)))
         WriteOut s, 2
    Next
    For i = 0 to samples / 4
        t = i / samplesPerSecond
        s = int(ampl * (Sin(t * freq * 2.0 * PI) + Sin(t * freq * perfect * 2.0 * PI)))
        WriteOut s, 2
    Next
    For i = 0 to samples / 4
        t = i / samplesPerSecond
        s = int(ampl * (Sin(t * freq * 2.0 * PI) + Sin(t * freq * concert * 2.0 * PI)))
        WriteOut s, 2
    Next
    f.Close
    commandButton1.Caption=tempCaption
    MsgBox "Done"
End Sub

Sub WriteOut(byval x,n) 'write out an n bit integer
    Dim i,c,x1
    x1=x
    'the next line overflows - VBSscript cannot handle a number this big.
    If x<0 Then x=(&hFFFFFFFF+x)+1
    For i=1 to n
        c=abs(x mod 256)
        x=int(x/256)
        f.Write chr(c)
    Next
End Sub

Sub CommandButton2_Click
    shellExecute "Open","e:\test.wav"
End Sub


Sub CommandButton3_Click
PlaySound "e:\test.wav",0,0
End Sub









Sub Form1_Load

End Sub


'*** Begin Generated Code ***

Dim AppEXEName: AppEXEName = "MakeWav"
Dim AppPath: AppPath = "E:\NSBD2\Files\technotes\TN05\MakeWav.txt"

Form1_Show 'Default Form

Dim Form1_Temp
Sub Form1_Show
   On Error Resume Next

   UpdateScreen

   If Not IsObject(Form1_Temp) Then
      AddObject "Form", "Form1", 0, 0, 240, 300
      Form1.Visible = False
      Form1.Caption = "Form1"
      Set Form1_Temp = Form1

      AddObject "CommandButton", "CommandButton1", 60, 36, 108, 21, Form1
      CommandButton1.Caption = "Make WAV File"
      CommandButton1.FontSize =  8.25
      '--------
      AddObject "CommandButton", "CommandButton2", 44, 96, 144, 20, Form1
      CommandButton2.Caption = "Play Sound File with WMP"
      CommandButton2.FontSize =  8.25
      '--------
      AddObject "CommandButton", "CommandButton3", 44, 136, 144, 20, Form1
      CommandButton3.Caption = "Use PlaySound Command"
      CommandButton3.FontSize =  8.25
      '--------
   End If
   Form1.Visible = True
   Form1_Load
End Sub  'Form1_Show

Sub Form1_Hide
   If Not IsObject(Form1_Temp) Then
      Err.Raise 44000, , "Form not loaded"
      Exit Sub
   End If

   On Error Resume Next
   Form1.Visible = False
   Form1_Unload
End Sub  'Form1_Hide
'*** End Generated Code ***