I got reall damn bored (I mean REALLY) so I started thinking of somthing to do.
You know, not somthing you want to comit to, but somthing really.. retarded and random. :p
Then I started to think about how most media players, when playing just audio, generate graphical patterns based on the sound.
So then I thought, why not generate sound patterns, based on graphical data?
Why graphical data, why not network data? why not bnet data? Perfect! The idea is random and retarded, I couldn't seriously comit to such a project.
With the critierias met, I started wundering on how to generate such wave patterns, and what parts of bnet traffic should seed them etc etc.
But before I jump into the deep end, I thought I would have a play around with the with the kernel beep() function and feed bnet traffic into it, to see what kind of tones it would generate.
Infact, I have a bot running in the background why i'm typeing this post, and I must say, its annoying to listen to -- it's like a 56k modem on smack.. in a retarded way ofc. Each packet has a more less unique array of beeps :p
If you're REALLY*100 suffering from bordom and wanna listen to the *sounds of bnet*, the code is below:
Every time you send or recv a packet, pass the data to the AddBeepData() sub.
Put a timer on the form, set it to 1ms interval and call PlayBeep()
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private m_Data As String
Private m_Pos As Long
Public Sub AddBeepData(ByRef S As String)
m_Data = m_Data & S
End Sub
Public Sub PlayBeep()
Dim B As Integer
If Len(m_Data) = 0 Then Exit Sub
B = PullBeep()
Beep B, 1
'DoEvents
End Sub
Private Function PullBeep() As Integer
Dim i As Integer
Dim B As Long
For i = 1 To (Len(m_Data) / 20) + 1
m_Pos = m_Pos + 1
If m_Pos > Len(m_Data) Then: m_Data = vbNullString: m_Pos = 0: Exit For
B = B + Asc(Mid$(m_Data, m_Pos, 1))
Next i
If m_Pos > 1024 Then
m_Pos = 0
m_Data = Mid$(m_Data, 1026)
End If
PullBeep = 500 + ((B / i) * 8)
End Function
Think it would be annoying, to have sound patterns generated from bnet data, like when ppl talk etc -- giving each persion a unique sound/music plus speach sound/music?
Or, would it be retardedly fantastic option to have a bnet chat bot?
edit:
should of probly posted this in the fun forum, or the trash can -- was ment as humor :p
Quote from: Ringo on November 14, 2008, 08:57 AMwould it be retardedly fantastic option to have a bnet chat bot?
NO.
I have to agree with Falcon. :P
I was wondering why it didn't work for a while til I found:
QuoteBeginning with Windows Vista and Windows XP 64-Bit Edition: This function is not supported.
:(
heh :D
here's my variation:
bnetlen = *(unsigned short *)(data + 2);
int bleep;
int i2, i3;
bleep = 0;
i3 = 0;
for (i2 = 0; i2 != bnetlen; i2++) {
i3++;
bleep += data[i2] << 1;
if (i3 == 5) {
Beep((bleep << 3) + 300, 20);
i3 = 0;
bleep = 0;
}
}
Much more fun with 20ms beeps imo
You were really bored.
Quote from: Ringo on November 14, 2008, 08:57 AM
Or, would it be retardedly fantastic option to have a bnet chat bot?
Hell yes! That'd be epic.
You my friend, are a hilarious individual.
After toying around with this idea for the past few days, the time has come! By unpopular demand, Sounds of Bnet On you're iBotPlayer is finaly here!
It includes such smash hits, as:
The sound of load bots.
I Press'ed you're key, and you made a sound.
My tune, you're tune, cardboard box.
I Like Cheese!
Worship the void.
And who could forget the great chart topper, the theme tune to sixth sence:
I see warden packets.... ALL THE TIME!
It is rumored, that michael jackson was on the battle.net one day, pretending to be a 10 year old girl, when he heard the sound of bnet!
It inspired him to stop fiddleing with the battle.net kiddies, and write a new song, in the style of Sound of bnet!
AWSOME! you say? Then you're nuts!
Here is a demo of the sounds of battle.net you can try before you die (of revolsion):
SoundOfBnet.Wav (http://d2bot.cjb.net/SoundOfBnet.zip)
You MUST listen to all 1min 40 seconds of it, because theres a reall funky bit at 01:00 to 01:15!
This demo, is the sound of a logon and a short idle in clan recruitment on useast.battle.net.
Note: you need to extract the .wav file with you're winzip player, before you can listen to it on you're waveplayer!
Note: Bnet chat bot player not included.
Here is the kind of 8bit sound wave patterns that will be generated from bnet data:
(http://d2bot.cjb.net/images/MyWave.gif)
If you would like to add the *sounds of bnet* to you're chatbot player, the code is below!
This is how to use the code:
Create new vb6 module, and call it ModSound
Paste the below code into said module!
When you're bot loads, you must call the SoundLoad() function
Example:
If modSound.SoundLoad() = False then msgbox "Failed to init sounds of bnet"
When you're chatbot player closes, you must make a call to the SoundUnload() sub
Example:
Call modSound.SoundUnload()
When you recv or send a bnet packet, pass it to the AddSoundData() sub.
Example:
Call AddSoundData(strData)
If you would like to save the sound's of bnet music you're chatbot player is generating, you can now use the StartRecording() and StopRecording() functions!
StartRecording() takes a path to a .wav file, where it will be created as new, and save the sounds of battle.net to it, in 7500khz, 8bit mono!
Because the sounds of battle.net operates at 7500khz, 8bit mono, the quality is not so great :p
Heres code:
Private Type WAVEFORMAT
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
End Type
Private Type WAVEHDR
lpData As Long
dwBufferLength As Long
dwBytesRecorded As Long
dwUser As Long
dwFlags As Long
dwLoops As Long
lpNext As Long
Reserved As Long
End Type
Private Declare Function waveOutOpen Lib "winmm" (hWaveOut As Long, ByVal uDeviceID As Long, format As Any, ByVal dwCallback As Long, ByRef fPlaying As Boolean, ByVal dwFlags As Long) As Long
Private Declare Function waveOutPrepareHeader Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function waveOutReset Lib "winmm" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutUnprepareHeader Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function waveOutClose Lib "winmm" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutWrite Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal NumBytes As Long)
Private Declare Sub RtlFillMemory Lib "kernel32" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DefWindowProcA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
'//Window handle/proc
Private hWndHandle As Long
Private hWndProc As Long
'//Class is loaded
Private hModInit As Boolean
'//Wave handle/header/buffer
Private wHandle As Long
Private wHdr As WAVEHDR
Private wBuf(999) As Byte
Private wFadeCount As Long
'//Input data
Private hData(15) As String
Private hDataPos As Long
'//Playlist
Private hPlay(15) As Boolean
Private hPlayPos As Long
'//Sound recorder
Private hRecordPath As String
Private hRecording As Boolean
Private Const FADE_MAX As Long = 7
Public Function SoundLoad() As Boolean
Dim wFormat As WAVEFORMAT
If hModInit Then Exit Function
hModInit = True
'//Fill the buffer with silence
Call RtlFillMemory(wBuf(0), UBound(wBuf) + 1, &H80)
'//Create a message window to handle the callbacks
hWndHandle = CreateWindowExA(0&, ByVal "STATIC", ByVal "SOUNDWINDOW", 0&, 0&, 0&, 0&, 0&, &HFFFFFFFD, 0&, App.hInstance, ByVal 0&)
If (hWndHandle = 0) Then Exit Function
hWndProc = SetWindowLongA(hWndHandle, &HFFFFFFFC, AddressOf WaveProc)
With wFormat
.wFormatTag = 1
.nChannels = 1
.nSamplesPerSec = 7500
.nBlockAlign = 1
.wBitsPerSample = 8
.nAvgBytesPerSec = .nSamplesPerSec * (.wBitsPerSample / 8)
End With
Call waveOutOpen(wHandle, 0, wFormat, hWndHandle, True, &H10000) 'callback
wHdr.lpData = VarPtr(wBuf(0)) 'memory pointer
wHdr.dwBufferLength = UBound(wBuf) 'size of memory block
Call waveOutPrepareHeader(wHandle, wHdr, 32)
Call waveOutWrite(wHandle, wHdr, 32)
SoundLoad = True
End Function
Public Function SoundUnload() As Boolean
Dim i As Long
If (hModInit = False) Then Exit Function
hModInit = False
'//Close the waveout
Call waveOutUnprepareHeader(wHandle, wHdr, 32)
Call waveOutClose(wHandle)
Call waveOutReset(wHandle)
'//Return previous window proc and destroy the window
Call SetWindowLongA(hWndHandle, &HFFFFFFFC, hWndProc)
Call DestroyWindow(hWndHandle)
hWndHandle = 0
hWndProc = 0
For i = 0 To UBound(hData): hData(i) = vbNullString: Next i
hDataPos = 0
For i = 0 To UBound(hPlay): hPlay(i) = False: Next i
hPlayPos = 0
hRecording = False
SoundUnload = True
End Function
Private Function WaveProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If (Not hWndProc = 0) Then
If (uMsg = &H3BD) Then
'//Update the buffer
Call NextPlay
'//Save buffer to .wav if recording
If hRecording Then Call BufferRecording
'//Rewrite the buffer to loop once more (wave header in lParam)
Call waveOutWrite(wHandle, ByVal lParam, 32)
End If
WaveProc = CallWindowProcA(hWndProc, hWnd, uMsg, wParam, lParam)
Else
WaveProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
End If
End Function
Public Sub AddSoundData(ByRef S As String)
Dim i As Long
Dim intFlag As Integer
If (hModInit = False) Then Exit Sub
If (Len(S) = 0) Then Exit Sub
For i = UBound(hData) To 1 Step -1
hData(i) = hData(i - 1)
Next i
hData(0) = S
'//Seed the *tune* with the 1st 16bits of the tickcount
Call RtlMoveMemory(intFlag, GetTickCount(), 2)
For i = 0 To 15
hPlay(i) = intFlag And (2 ^ i)
Next i
End Sub
Private Sub NextPlay()
'//Move to next playing key
hPlayPos = hPlayPos + 1
If (hPlayPos > UBound(hPlay)) Then hPlayPos = 0
'//Move the next data
hDataPos = hDataPos + 1
If (hDataPos > UBound(hData)) Then hDataPos = 0
'//Check if we can play or have data to play
If (hPlay(hPlayPos) = False) Or (Len(hData(hDataPos)) = 0) Then
If (wFadeCount = FADE_MAX) Then
'//Make the buffer stfu
wFadeCount = FADE_MAX + 1
Call RtlFillMemory(wBuf(0), UBound(wBuf) + 1, &H80)
ElseIf (wFadeCount < FADE_MAX) Then
'//Fade/ecco the buffer into silence
wFadeCount = wFadeCount + 1
Call FadeBuffer
End If
Exit Sub
End If
'//Play the sound
wFadeCount = 0
Call TextToBuffer(hData(hDataPos))
End Sub
Private Sub FadeBuffer()
Dim i As Long
For i = 0 To UBound(wBuf)
If wBuf(i) > &H80 Then
wBuf(i) = wBuf(i) - ((wBuf(i) - &H80) / 2)
ElseIf wBuf(i) < &H80 Then
wBuf(i) = wBuf(i) + ((&H80 - wBuf(i)) / 2)
End If
Next i
End Sub
Private Sub TextToBuffer(ByRef strText As String)
Dim i As Long
Dim Width As Long
Dim Dist As Long
Dim Ball As Integer
Dim Speed As Integer
Dim Pos As Integer 'strText pos
Width = 1
Ball = &H80
Speed = 0
For i = 0 To UBound(wBuf)
'//add force to center
Dist = (&H80 - Ball)
Speed = Speed + (Dist / Width)
If Speed > &H20 Then Speed = &H20
If Speed < -&H20 Then Speed = -&H20
Ball = Ball + Speed
If ((i Mod Width) = 0) Then
'//Move to next byte
Pos = Pos + 1
If (Pos > Len(strText)) Then Pos = 1
'//Kick wave
Speed = Speed + ((&H80 - Asc(Mid$(strText, Pos, 1))) / (Width * 2))
End If
wBuf(i) = (Ball And &HFF)
Next i
End Sub
Public Function StartRecording(ByRef strWavPath As String) As Boolean
If hRecording Then Exit Function
hRecordPath = strWavPath
hRecording = OpenRecording()
StartRecording = hRecording
End Function
Public Function IsRecording() As Boolean
IsRecording = hRecording
End Function
Public Function StopRecording() As Boolean
hRecording = False
StopRecording = True
End Function
Private Function OpenRecording() As Boolean
Dim i As Integer
On Error GoTo OpenRecordingErr
If (Not Len(Dir$(hRecordPath)) = 0) Then
Call Kill(hRecordPath)
End If
Dim wFormat As WAVEFORMAT
With wFormat
.wFormatTag = 1
.nChannels = 1
.nSamplesPerSec = 6500
.nBlockAlign = 1
.wBitsPerSample = 8
.nAvgBytesPerSec = .nSamplesPerSec * (.wBitsPerSample / 8)
End With
i = FreeFile
Open hRecordPath For Binary As #i
Put #i, , &H46464952 'RIFF
Put #i, , 0&
Put #i, , &H45564157 'WAVE
Put #i, , &H20746D66 'fmt
Put #i, , &H12&
Put #i, , wFormat
Put #i, , &H61746164 'data
Put #i, , 0&
Close #i
OpenRecording = True
Exit Function
OpenRecordingErr:
OpenRecording = False
End Function
Private Sub BufferRecording()
Dim i As Integer
On Error Resume Next
i = FreeFile
Open hRecordPath For Binary As #i
Put #i, LOF(i) + 1, wBuf
Put #i, 5, CLng(LOF(i) - 8)
Put #i, &H2B, CLng(LOF(i) - &H2E)
Close #i
End Sub
A quick description of how it works:
It take's around 15 bnet packets to give it enough flavor to generate a tune.
The tune it's self is reseeded with the tickcount, everytime a new message is handed to the module!
It will generate sounds, guaranteed to bring out the bnet raver in anyone!
If you think, the sounds of bnet is the best thing since Jesus, then you are most definitely alone on that one!
Did you run it in Brood War Ladder on Asia?
Sounds like old, old Pokémon music all jumbled up.
I can't believe I actually listened to that whole thing....
Odly enough I actually liked it, speed it up about 25% and it'd be some kick ass electronica.
I like it but not enough to spend time writing a bot for it.
lol
mmm i liked the tune.
Im sure it will make it to the top #5 valhalla tunes in no time.
i lol'd. this is srs bsns...
Quote from: l2k-Shadow on November 27, 2008, 08:39 PM
i lol'd. this is srs bsns...
You win!
The milky bar's are on you.
Creativity++;
Usefulness--;
printf("A+ for effort, Ringo.\n");
It's nice to see a good bit of humor around here.
Ringo, the more bored you are, the more skills of yours will show up in code :)