Musansävellysohjelma

Jaa meneillään olevat projektisi tai valmiit pelit muun yhteisön kanssa täällä.
Post Reply
DJ-Filbe
Devoted Member
Posts: 853
Joined: Sat Feb 20, 2010 3:18 pm

Musansävellysohjelma

Post by DJ-Filbe » Thu Jul 14, 2011 11:47 am

Tällainen olisi projektina. Eli kirjoitat biisin nimen ja ohjelma säveltää "kauniin" kappaleen MD5-hashin perusteella (ideaa ei ole lainattu Ohjelmointiputkan kisasta :roll: ). Ohjelmaan lisään bassokuviot, rummut ja lisää sointukuvioita. Nyt tuo kuulostaa kököltä, koska rytmi katoaa, käytetään siniaaltoa jne...
Siitä se lähtee. Jos joku haluaa mukaan tekemään, voi laittaa YV:tä (mutta tunnetusti diizei nöödin projektit kaatuvat, joten älä ihmeessä tule "tiimiin" mukaan).

Code: Select all

// sävellin.CB
SCREEN 800,600

Include "MD5.cb"


Type _nuotti
	Field kesto#
	Field note
	Field oktaavi
	Field tyyppi
EndType


Const debugmode=0 // vain debuggaukseen. Valmiiseen ohjelmaan arvoksi 0
Global hash$
Global notesplayed
Repeat
	sana$=Input("Sana: ")
	DrawScreen
Until KeyUp(28)
CloseInput

Global sins
sins=MakeMEMBlock(1)

Global song
song=MakeMEMBlock(1) // tyhjä biisi

hash=MD5(sana)

root=getRand(1,1,12)
For i=1 To 16 // luodaan 8 kertaa 8 tahtia = 64 tahtia

	Select getRand(i+1,1,5)
		Case 1 // Am - F - G - Am - Em - F - Am - Em
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, -5, 2) // Em
			addChord(root, -4) // F
			addChord(root, 0, 2) // Am
			addChord(root, -5, 2) // Em
		Case 2 // Am - D - Gm - Cm - F - G - Em - Am
			addChord(root, 0, 2) // Am
			addChord(root, 5) // D
			addChord(root, -2, 2) // Gm
			addChord(root, 3, 2) // Cm
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, -5, 2) // Em
			addChord(root, 0, 2) // Am
		Case 3 // F - G - C - Am - F - E - Am - G  || Esim. Eppu Normaali - Vain tahroja paperilla
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, 3) // C
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, -5) // E
			addChord(root, 0, 2) // Am
			addChord(root, -2) // G
		Case 4 // Am - F - C - G - Am - F - C - G ||Esim. Dayfall - Hated in Vain
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, 3) // C
			addChord(root, -2) // G
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, 3) // C
			addChord(root, -2) // G
		Case 5 // Am - Em - F - B - Am - Em - F - B || Esim. Dayfall - When you're alone
			For t=1 To 2
				addChord(root, 0, 2) // Am
				addChord(root, -5, 2) // Em
				addChord(root, -4) // F
				addChord(root, 2) // B
			Next t
	EndSelect

Next i

a=OpenToWrite(sana+".txt")
okt=4
For i=1 To 256
	WriteLine a, getNoteName(getNote(i))

	n._nuotti = New(_nuotti)
	n\kesto = 0.08 // ms
	n\note = getNote(i)
	n\oktaavi = okt
	n\tyyppi = 1
	SinWave(getHz(getNote(i)), 0.1)
	
	notesplayed=notesplayed+1
	Text 300,0,notesplayed
	If debugmode Then
		
		Print getNoteName(getNote(i))
	EndIf
Next i
CloseFile a

makeSong()


Function getRand(r, beg#=0.0, en#=16.0) // hakee numeroidun hashin. MUISTA JÄRJESTYS! Ei oikeaa randia
	scale#=en-beg
	val=Asc(Mid(hash,r,1))
	If val >= 48 And val <= 57 Then
		val=val-48
	Else
		val=val-86
	EndIf
	Return RoundDown(beg+(   (val+1)   /   (16.0/scale)))
EndFunction

Function getHz(nuotti, oktaavi=3)
	Return RoundDown(275*(2^oktaavi)*(1.059463^nuotti))/10
EndFunction

Function getNoteName$(notenum)

	Select notenum Mod 12
		Case 0
			Return "A"
		Case 1
			Return "A#"
		Case 2
			Return "B"
		Case 3
			Return "C"
		Case 4
			Return "C#"
		Case 5
			Return "D"
		Case 6
			Return "D#"
		Case 7
			Return "E"
		Case 8
			Return "F"
		Case 9
			Return "F#"
		Case 10
			Return "G"
		Case 11
			Return "G#"
	EndSelect
	Return -1
EndFunction

Function addChord(rootnote, plusnote, chrd=1)// 1=duuri, 2 = molli
	ms=MEMBlockSize(song)
	ResizeMEMBlock song, ms+3*4
	PokeInt song, ms, rootnote
	PokeInt song, ms+4, plusnote
	PokeInt song, ms+8, chrd
	If debugmode = 1 Then 
		Print "Plusnote = "+plusnote
		If chrd = 1 Then Print "Duuri" Else Print "Molli"
		Print "______________________"
	EndIf
EndFunction

Function getNote(num)
	npc=4
	tmp=rounddown((num-1) / npc)+1
	
	curchordrn=PeekInt(song, (tmp*3-2)*4-3) // 3 tietoa per sointu, 4 nuottia per sointu (tahti)
	curchordpn=PeekInt(song, (tmp*3-1)*4-3)
	curchordtype=PeekInt(song, (tmp*3)*4-3)
	
	If debugmode Then
		Print ""+(tmp*3-2) + " - " + (tmp*3)
		Print "ccn = "+curchordrn
		Print "ccp = "+curchordpn
		Print "cct = "+curchordtype
		//Wait 500
	EndIf
	
	If curchordtype = 1 Then // duuri
		rn=getRand(num Mod 10 + 1, 1,4)
		Select rn
			Case 1
				Return curchordrn+curchordpn // C
			Case 2
				Return curchordrn+curchordpn+4 // E
			Case 3
				Return curchordrn+curchordpn+7 // G
			Case 4
				Return curchordrn+curchordpn+12 // c
		EndSelect
	Else // molli
		rn=getRand(num Mod 10 + 1, 1,4)
		Select rn
			Case 1
				Return curchordrn+curchordpn // C
			Case 2
				Return curchordrn+curchordpn+3 // D#
			Case 3
				Return curchordrn+curchordpn+7 // G
			Case 4
				Return curchordrn+curchordpn+12 // c
		EndSelect
	EndIf
	MakeError "GetNote Failed!"
EndFunction










Function SinWave(taajuus#, pituus#, voimakkuus#=100)
	taajuus=RoundDown(taajuus)
    fq=44100
    length=pituus*fq
    f=OpenToWrite("tmpwav.tmp")
    WriteInt f,$52494646
    WriteInt f,0
    WriteInt f,$57415645
    WriteInt f,$666d7420
    WriteInt f,16
    WriteShort f,1
    WriteShort f,1
    WriteInt f,fq
    WriteInt f,fq*2
    WriteShort f,2
    WriteShort f,16
    WriteInt f,$64617461
    WriteInt f,length*2
    vokke = voimakkuus/100*32767
    For i = 0 To length-1
		val=Sin(360.0*taajuus/fq*(i Mod fq))*vokke
        WriteShort f, val
		ms=MEMBlockSize(sins)
		ResizeMEMBlock sins, ms+4
		PokeInt sins, ms, val*100
    Next i
    fs=FileOffset(f)-8
    SeekFile f,4
    WriteInt f,fs
    CloseFile f
    
	If debugmode Then 
		tmpsnd=LoadSound("tmpwav.tmp")
		DeleteFile "tmpwav.tmp"
		s=PlaySound(tmpsnd)
		Repeat
		
		Until SoundPlaying(s) = 0
		DeleteSound tmpsnd
	EndIf
End Function

Function makeSong()
	WriteWav("tmp.wav", sins)
	s=PlaySound("tmp.wav")
	Repeat
	
	Until SoundPlaying(s)=0
EndFunction






Function WriteWav(path$,data1, samplerate=44100,data2=0)
    datalen = MEMBlockSize(data1)
    If data2 <> 0 Then channels = 2 Else channels = 1
    f = OpenToWrite(path$)
    WriteByte f,$52 : WriteByte f,$49 : WriteByte f,$46 : WriteByte f,$46//RIFF
    WriteInt f,4 + (8+16)+(8 + datalen/4 * channels * 4)
	WriteByte f,$57 : WriteByte f,$41 : WriteByte f,$56 : WriteByte f,$45//WAVE
	WriteByte f,$66 : WriteByte f,$6d : WriteByte f,$74 : WriteByte f,$20 //FMT
	WriteInt f,16
    WriteShort f,1
	WriteShort f,channels
    WriteInt f,samplerate
    WriteInt f,samplerate * channels * 4
    WriteShort f,channels * 4
    WriteShort f,32
	WriteByte f,$64 : WriteByte f,$61 : WriteByte f,$74 : WriteByte f,$61 //Data
    WriteInt f,datalen/4*channels*4
    If channels = 1 Then
        For i = 0 To datalen-4 Step 4
            WriteInt f,PeekInt(data1,i)
        Next i
    ElseIf channels = 2
        For i = 0 To datalen-4 Step 4
            WriteInt f,PeekInt(data1,i)
            WriteInt f,PeekInt(data2,i)
        Next i
    EndIf
    CloseFile f
EndFunction

Code: Select all

// MD5.CB
Function MD5(jono$)
 
nblk = ((Len(jono$) + 8) Shr 6) + 1
 
Dim MD5_x(nblk * 16 - 1)
 
For i = 0 To nblk * 16 - 1
MD5_x(i) = 0
Next i
 
For i = 0 To (Len(jono$) - 1)
MD5_x(i Shr 2) = BinOr(MD5_x(i Shr 2), (Asc(Mid(jono$, (i + 1), 1)) Shl ((i Mod 4) * 8)))
Next i
 
MD5_x(i Shr 2) = BinOr(MD5_x(i Shr 2), (128 Shl (((i) Mod 4) * 8)))
MD5_x(nblk * 16 - 2) = Len(jono$) * 8
 
MD5_a = 1732584193 //&H67452301
MD5_b = -271733879 //&HEFCDAB89
MD5_c = -1732584194 //&H98BADCFE
MD5_d = 271733878 //&H10325476
 
// Käydään sanat läpi
For k = 0 To (nblk * 16 - 1) Step 16
MD5_AA = MD5_a
MD5_BB = MD5_b
MD5_CC = MD5_c
MD5_DD = MD5_d
 
// Kierros 1
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 0), 7, -680876936) //&HD76AA478
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 1), 12, -389564586) //&HE8C7B756
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 2), 17, 606105819 )//&H242070DB
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 3), 22, -1044525330) //&HC1BDCEEE
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 4), 7, -176418897) //&HF57C0FAF
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 5), 12, 1200080426 )//&H4787C62A
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 6), 17, -1473231341) //&HA8304613
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 7), 22, -45705983) //&HFD469501
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 8), 7, 1770035416) //&H698098D8
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 9), 12, -1958414417 )//&H8B44F7AF
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 10), 17, -42063 )//&HFFFF5BB1
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 11), 22, -1990404162) //&H895CD7BE
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 12), 7, 1804603682) //&H6B901122
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 13), 12, -40341101) //&HFD987193
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 14), 17, -1502002290) //&HA679438E
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 15), 22, 1236535329) //&H49B40821
 
// Kierros 2
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 1), 5, -165796510) //&HF61E2562
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 6), 9, -1069501632) //&HC040B340
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 11), 14, 643717713) //&H265E5A51
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 0), 20, -373897302) //&HE9B6C7AA
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 5), 5, -701558691) //&HD62F105D
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 10), 9, 38016083) //&H2441453
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 15), 14, -660478335) //&HD8A1E681
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 4), 20, -405537848) //&HE7D3FBC8
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 9), 5, 568446438) //&H21E1CDE6
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 14), 9, -1019803690) //&HC33707D6
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 3), 14, -187363961) //&HF4D50D87
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 8), 20, 1163531501) //&H455A14ED
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 13), 5, -1444681467) //&HA9E3E905
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 2), 9, -51403784) //&HFCEFA3F8
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 7), 14, 1735328473) //&H676F02D9
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 12), 20, -1926607734) //&H8D2A4C8A
 
// Kierros 3
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 5), 4, -378558) //&HFFFA3942
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 8), 11, -2022574463) //&H8771F681
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 11), 16, 1839030562) //&H6D9D6122
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 14), 23, -35309556) //&HFDE5380C
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 1), 4, -1530992060) //&HA4BEEA44
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 4), 11, 1272893353) //&H4BDECFA9
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 7), 16, -155497632) //&HF6BB4B60
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 10), 23, -1094730640) //&HBEBFBC70
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 13), 4, 681279174) //&H289B7EC6
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 0), 11, -358537222) //&HEAA127FA
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 3), 16, -722521979) //&HD4EF3085
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 6), 23, 76029189) //&H4881D05
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 9), 4, -640364487) //&HD9D4D039
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 12), 11, -421815835) //&HE6DB99E5
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 15), 16, 530742520) //&H1FA27CF8
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 2), 23, -995338651) //&HC4AC5665
 
// Kierros 4
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 0), 6, -198630844) //&HF4292244
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 7), 10, 1126891415) //&H432AFF97
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 14), 15, -1416354905) //&HAB9423A7
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 5), 21, -57434055) //&HFC93A039
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 12), 6, 1700485571) //&H655B59C3
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 3), 10, -1894986606) //&H8F0CCC92
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 10), 15, -1051523) //&HFFEFF47D
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 1), 21, -2054922799) //&H85845DD1
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 8), 6, 1873313359) //&H6FA87E4F
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 15), 10, -30611744) //&HFE2CE6E0
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 6), 15, -1560198380 )//&HA3014314
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 13), 21, 1309151649) //&H4E0811A1
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 4), 6, -145523070) //&HF7537E82
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 11), 10, -1120210379) //&HBD3AF235
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 2), 15, 718787259) //&H2AD7D2BB
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 9), 21, -343485551) //&HEB86D391
 
MD5_a = MD5_a + MD5_AA
MD5_b = MD5_b + MD5_BB
MD5_c = MD5_c + MD5_CC
MD5_d = MD5_d + MD5_DD
Next k
 
Return Lower(Str(WordToHex(MD5_a)) + Str(WordToHex(MD5_b)) + Str(WordToHex(MD5_c)) + Str(WordToHex(MD5_d)))
End Function
 
 
Function MD5_F(x, y, z)
Return BinOr(BinAnd(x, y), BinAnd(BinNot(x), z))
End Function
 
Function MD5_G(x, y, z)
Return BinOr(BinAnd(x, z), BinAnd(y, BinNot(z)))
End Function
 
Function MD5_H(x, y, z)
Return BinXor(BinXor(x, y), z)
End Function
 
Function MD5_I(x, y, z)
Return BinXor(y, BinOr(x, BinNot(z)))
End Function
 
Function MD5_FF(a, b, c, d, x, s, ac)
a = (a + ((MD5_F(b, c, d)+ x)+ ac))
a = RotateLeft(a, s)
Return a + b
End Function
 
Function MD5_GG(a, b, c, d, x, s, ac)
a = (a + ((MD5_G(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function
 
Function MD5_HH(a, b, c, d, x, s, ac)
a = (a + ((MD5_H(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function
 
Function MD5_II(a, b, c, d, x, s, ac)
a = (a + ((MD5_I(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function
 
Function RotateLeft(lValue, iShiftBits)
Return BinOr(lValue Shl iShiftBits, lValue Shr (32 - iShiftBits))
End Function
 
Function WordToHex(lValue)
For lCount = 0 To 3
lByte = BinAnd(lValue Shr lCount * 8, 255)
ToHex$ = ToHex$ + Right("0" + Hex(lByte), 2)
Next lCount
Return ToHex$
End Function
 
Function BinAnd(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) And ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function
 
Function BinNot(luku1)
For i = 0 To 31
luku3 = luku3 + (Not ((luku1 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function
 
Function BinXor(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) Xor ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function
 
Function BinOr(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) Or ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function
 
Function Bin2Dec(jono$)
For i = Len(jono$) To 1 Step -1
arvo = Int(Mid(jono$, i, 1))
If arvo = 1 Then
luku = luku + 2 ^ (Len(jono$) - i)
EndIf
Next i
Return luku
End Function 

User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Musansävellysohjelma

Post by axu » Thu Jul 14, 2011 9:22 pm

Ihan mielenkiintoinen idea, vaikkei tämä yllä useimpien putkassa julkaistujen tasolle. Biisissä voisi olla enemmänkin järkeä kuin vain randomit piippaukset. Ainakin soinnut olisi hyvä lisä ja jonkinsortin vaihtelua tuohon rumpu joka iskulla-systeemiin. Ei tätä vielä ilokseen kuuntele :d
Niin ja semmoinen vielä, miksi tuo koodi pitää olla kahdessa osassa?
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image

DJ-Filbe
Devoted Member
Posts: 853
Joined: Sat Feb 20, 2010 3:18 pm

Re: Musansävellysohjelma

Post by DJ-Filbe » Thu Jul 14, 2011 10:00 pm

axu wrote:Ihan mielenkiintoinen idea, vaikkei tämä yllä useimpien putkassa julkaistujen tasolle. Biisissä voisi olla enemmänkin järkeä kuin vain randomit piippaukset. Ainakin soinnut olisi hyvä lisä ja jonkinsortin vaihtelua tuohon rumpu joka iskulla-systeemiin. Ei tätä vielä ilokseen kuuntele :d
Niin ja semmoinen vielä, miksi tuo koodi pitää olla kahdessa osassa?
Piippaukset eivät ole täysin randomeita - sointukuvioita on ennalta määritelty. Tosin ne eivät ole täysin yhteensopivia keskenään :D
Soinnut paljastuvat kun lisään basson - ominaisuus on jo valmis ja tuossa yötä vasten ajattelinkin laittaa sen version tänne.
Rummut? No joo. Sinifunktio kusee kun vaihdetaan nuottia, se hyppää monta arvoa alaspäin :/ tähän olisi kiva saada helppiä.

Tulossa kanttiaalto, saha-aalto ja yhdistelmäaaltoja, sekä bassoääni taustalle. Julkaisen enemmän sitten kun on ainakin kolme kertaa enemmän näytettävää :D

DJ-Filbe
Devoted Member
Posts: 853
Joined: Sat Feb 20, 2010 3:18 pm

Re: Musansävellysohjelma

Post by DJ-Filbe » Fri Jul 15, 2011 2:42 pm

Päivitystä. Jonkinlainen metronomi, muutama äänivaihtoehto ja yksinkertainen basso taustalle.
Huomattavasti parempi kuin edellinen.
Koko koodi yhdessä nipussa, voi ajaa suoraan.

Code: Select all

SCREEN 800,600


Type _nuotti
	Field kesto#
	Field note
	Field oktaavi
	Field tyyppi
EndType

Global ekataajuus#

Const debugmode=0 // vain debuggaukseen. Valmiiseen ohjelmaan arvoksi 0
Global hash$
Global notesplayed
Repeat
	sana$=Input("Sana: ")
	DrawScreen
Until KeyUp(28)
CloseInput

Global sins
sins=MakeMEMBlock(1)


Global song
song=MakeMEMBlock(1) // tyhjä biisi

hash=MD5(sana)

root=getRand(1,1,12)
ntype=getRand(8, 1,4) // Aaltotyyppi: 1=siniaalto, 2=kanttiaalto, 3=seka, 4=seka
For i=1 To 16 // luodaan tahteja

	Select getRand(i+1,1,9)
		Case 1 // Am - F - G - Am - Em - F - Am - Em
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, -5, 2) // Em
			addChord(root, -4) // F
			addChord(root, 0, 2) // Am
			addChord(root, -5, 2) // Em
		Case 2 // Am - D - Gm - Cm - F - G - Em - Am
			addChord(root, 0, 2) // Am
			addChord(root, 5) // D
			addChord(root, -2, 2) // Gm
			addChord(root, 3, 2) // Cm
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, -5, 2) // Em
			addChord(root, 0, 2) // Am
		Case 3 // F - G - C - Am - F - E - Am - G  || Esim. Eppu Normaali - Vain tahroja paperilla
			addChord(root, -4) // F
			addChord(root, -2) // G
			addChord(root, 3) // C
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, -5) // E
			addChord(root, 0, 2) // Am
			addChord(root, -2) // G
		Case 4 // Am - F - C - G - Am - F - C - G ||Esim. Dayfall - Hated in Vain
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, 3) // C
			addChord(root, -2) // G
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, 3) // C
			addChord(root, -2) // G
		Case 5 // Am - Em - F - B *2 || Esim. Dayfall - When you're alone
			For t=1 To 2
				addChord(root, 0, 2) // Am
				addChord(root, -5, 2) // Em
				addChord(root, -4) // F
				addChord(root, 2) // B
			Next t
		Case 6 // Am - F - C - G *2 || Esim. Poju - Poika saunoo (intro)
			For t=1 To 2
				addChord(root, 0, 2) // Am
				addChord(root, 0, 2) // F
				addChord(root, 3) // C
				addChord(root, -2) // G
			Next t
		Case 7 // Am - C - G - F || Esim. Poju - Poika saunoo
			For t=1 To 2
				addChord(root, 0, 2) // Am
				addChord(root, 3) // C
				addChord(root, -2) // G
				addChord(root, -4) // F
			Next t
		Case 8 // C - G - Am - F - C - G - Am - Am || Esim. Justin Bieber - Baby
				// ja en ottanut tätä mukaan laulun vuoksi vaan sen takia että
				// pop -melodiat saattavat tuoda oman lisäyksensä ohjelmaan
			addChord(root, 3) // C
			addChord(root, -2) // G
			addChord(root, 0, 2) // Am
			addChord(root, -4) // F
			addChord(root, 3) // C
			addChord(root, -2) // G
			addChord(root, 0, 2) // Am
			addChord(root, 0, 2) // Am
		Case 9 // F - G - Am - G - F - G - Am - G || Esim. Petri Nygård - Selvä päivä
				// tämäkin vain huvikseen. Petri ON perseestä.
			For t=1 To 2
				addChord(root, -4) // F
				addChord(root, -2) // G
				addChord(root, 0, 2) // Am
				addChord(root, -2) // G
			Next t
	EndSelect

Next i

a=OpenToWrite(sana+".txt")
okt=4
kerroin#=0.8
Global nuotteja
nuotteja=256
Global kokokesto#

For i=1 To nuotteja
	WriteLine a, getNoteName(getNote(i))

	n._nuotti = New(_nuotti)
	Select getRand(i Mod 4 + 1,  1,16) // RYTMI
		Case 1,2,3,4,5
			n\kesto = 0.2*kerroin
		Case 6,7,8,9
			n\kesto = 0.4*kerroin
		Case 10,11
			n\kesto = 0.3*kerroin
		Case 12
			n\kesto = 0.25*kerroin
		Case 13,14,15
			n\kesto = 0.6*kerroin
	EndSelect
	
	n\note = getNote(i)
	n\oktaavi = okt
	n\tyyppi = ntype
	If i Mod 4 = 1 Then ekataajuus = getHz(getNote(i)) // 1. iskulla bassoääni (ekataajuus)
	SinWave(getHz(getNote(i)), n\kesto, n\tyyppi)
	
	notesplayed=notesplayed+1
	Text 300,0,notesplayed
	If debugmode Then
		
		Print getNoteName(getNote(i))
	EndIf
	pc#=i*100/nuotteja
	Text 200,100,"Odota, biisiä tehdään...!  "+pc+"%"
	DrawScreen
Next i

CloseFile a

makeSong()


Function getRand(r, beg#=0.0, en#=16.0) // hakee numeroidun hashin. MUISTA JÄRJESTYS! Ei oikeaa randia
	scale#=en-beg
	val=Asc(Mid(hash,r,1))
	If val >= 48 And val <= 57 Then
		val=val-48
	Else
		val=val-86
	EndIf
	Return RoundDown(beg+(   (val+1)   /   (16.0/scale)))
EndFunction

Function getHz(nuotti, oktaavi=3)
	Return RoundDown(275*(2^oktaavi)*(1.059463^nuotti))/10
EndFunction

Function getNoteName$(notenum)

	Select notenum Mod 12
		Case 0
			Return "A"
		Case 1
			Return "A#"
		Case 2
			Return "B"
		Case 3
			Return "C"
		Case 4
			Return "C#"
		Case 5
			Return "D"
		Case 6
			Return "D#"
		Case 7
			Return "E"
		Case 8
			Return "F"
		Case 9
			Return "F#"
		Case 10
			Return "G"
		Case 11
			Return "G#"
	EndSelect
	Return -1
EndFunction

Function addChord(rootnote, plusnote, chrd=1)// 1=duuri, 2 = molli
	ms=MEMBlockSize(song)
	ResizeMEMBlock song, ms+3*4
	PokeInt song, ms, rootnote
	PokeInt song, ms+4, plusnote
	PokeInt song, ms+8, chrd
	If debugmode = 1 Then 
		Print "Plusnote = "+plusnote
		If chrd = 1 Then Print "Duuri" Else Print "Molli"
		Print "______________________"
	EndIf
EndFunction

Function getNote(num)
	npc=4
	tmp=RoundDown((num-1) / npc)+1
	
	curchordrn=PeekInt(song, (tmp*3-2)*4-3) // 3 tietoa per sointu, 4 nuottia per sointu (tahti)
	curchordpn=PeekInt(song, (tmp*3-1)*4-3)
	curchordtype=PeekInt(song, (tmp*3)*4-3)
	
	If debugmode Then
		Print ""+(tmp*3-2) + " - " + (tmp*3)
		Print "ccn = "+curchordrn
		Print "ccp = "+curchordpn
		Print "cct = "+curchordtype
		//Wait 500
	EndIf
	
	If curchordtype = 1 Then // duuri
		rn=getRand(num Mod 10 + 1, 1,4)
		Select rn
			Case 1
				Return curchordrn+curchordpn // C
			Case 2
				Return curchordrn+curchordpn+4 // E
			Case 3
				Return curchordrn+curchordpn+7 // G
			Case 4
				Return curchordrn+curchordpn+12 // c
		EndSelect
	Else // molli
		rn=getRand(num Mod 10 + 1, 1,4)
		Select rn
			Case 1
				Return curchordrn+curchordpn // C
			Case 2
				Return curchordrn+curchordpn+3 // D#
			Case 3
				Return curchordrn+curchordpn+7 // G
			Case 4
				Return curchordrn+curchordpn+12 // c
		EndSelect
	EndIf
	MakeError "GetNote Failed!"
EndFunction










Function SinWave(taajuus#, pituus#, tyyppi=1, voimakkuus#=100)
	kokokesto=kokokesto+pituus
	taajuus=RoundDown(taajuus)
    fq=44100
    length=pituus*fq
    f=OpenToWrite("tmpwav.tmp")
    WriteInt f,$52494646
    WriteInt f,0
    WriteInt f,$57415645
    WriteInt f,$666d7420
    WriteInt f,16
    WriteShort f,1
    WriteShort f,1
    WriteInt f,fq
    WriteInt f,fq*2
    WriteShort f,2
    WriteShort f,16
    WriteInt f,$64617461
    WriteInt f,length*2
    vokke = voimakkuus/100*32767
	if debugmode then Print "TYYPPI = "+tyyppi
    For i = 0 To length-1
		
		If tyyppi = 1 Then // siniaalto
			val=Sin(360.0*taajuus/fq*(i Mod fq))*vokke
		ElseIf tyyppi = 2 Then
			val=kantti(360.0*taajuus/fq*(i Mod fq))*vokke
		ElseIf tyyppi = 3 Then
			val=kantti(360.0*taajuus/fq*(i Mod fq))*vokke + (Sin(360.0*taajuus*1.5/fq*(i Mod fq))*vokke/2)
		ElseIf tyyppi = 4 Then
			val=kantti(360.0*taajuus*1.5/fq*(i Mod fq))*vokke/2 + (Sin(360.0*taajuus/fq*(i Mod fq))*vokke)
		EndIf
		bassoraita#=Sin(360.0*ekataajuus*0.25/fq*(i Mod fq))*vokke*0.8
		
		val = val + bassoraita
        WriteShort f, val
		ms=MEMBlockSize(sins)
		ResizeMEMBlock sins, ms+4
		PokeInt sins, ms, val*100
    Next i
    fs=FileOffset(f)-8
    SeekFile f,4
    WriteInt f,fs
    CloseFile f
    
	If debugmode Then 
		tmpsnd=LoadSound("tmpwav.tmp")
		DeleteFile "tmpwav.tmp"
		s=PlaySound(tmpsnd)
		Repeat
		
		Until SoundPlaying(s) = 0
		DeleteSound tmpsnd
	EndIf
End Function

Function makeSong()
	addDrums()
	WriteWav("tmp.wav", sins)
	s=PlaySound("tmp.wav")
	Repeat
		DrawScreen
	Until SoundPlaying(s)=0
EndFunction


Function addDrums()
	ms=MEMBlockSize(sins)
	tmpp=0
	Print "RUMMUT..."
	tp=RoundUp(kokokesto/nuotteja*8*44100)/getrand(3, 1,3)
	tmp=getRand(12, 1,10)
		
	For i=0 To ms-1
		If i Mod 100000 = 0 Then tmp=getRand(i Mod 7 + 1, 1,10)
		
			If i Mod tp < 1000 Then
				PokeInt sins, i+1, PeekInt(sins,i+1)+Sin(i Mod tp)*32767
			EndIf
	Next i
	Print "TEHTY"
	AddText "tmpp="+tmpp
EndFunction



Function WriteWav(path$,data1, samplerate=44100,data2=0)
    datalen = MEMBlockSize(data1)
    If data2 <> 0 Then channels = 2 Else channels = 1
    f = OpenToWrite(path$)
    WriteByte f,$52 : WriteByte f,$49 : WriteByte f,$46 : WriteByte f,$46//RIFF
    WriteInt f,4 + (8+16)+(8 + datalen/4 * channels * 4)
	WriteByte f,$57 : WriteByte f,$41 : WriteByte f,$56 : WriteByte f,$45//WAVE
	WriteByte f,$66 : WriteByte f,$6d : WriteByte f,$74 : WriteByte f,$20 //FMT
	WriteInt f,16
    WriteShort f,1
	WriteShort f,channels
    WriteInt f,samplerate
    WriteInt f,samplerate * channels * 4
    WriteShort f,channels * 4
    WriteShort f,32
	WriteByte f,$64 : WriteByte f,$61 : WriteByte f,$74 : WriteByte f,$61 //Data
    WriteInt f,datalen/4*channels*4
    If channels = 1 Then
        For i = 0 To datalen-4 Step 4
            WriteInt f,PeekInt(data1,i)
        Next i
    ElseIf channels = 2
        For i = 0 To datalen-4 Step 4
            WriteInt f,PeekInt(data1,i)
            WriteInt f,PeekInt(data2,i)
        Next i
    EndIf
    CloseFile f
EndFunction

Function kantti#(arvo)
	arvo = arvo Mod 360
	If arvo < 180 Then Return -1 Else Return 1
EndFunction








// MD5.CB
Function MD5(jono$)

nblk = ((Len(jono$) + 8) Shr 6) + 1

Dim MD5_x(nblk * 16 - 1)

For i = 0 To nblk * 16 - 1
MD5_x(i) = 0
Next i

For i = 0 To (Len(jono$) - 1)
MD5_x(i Shr 2) = BinOr(MD5_x(i Shr 2), (Asc(Mid(jono$, (i + 1), 1)) Shl ((i Mod 4) * 8)))
Next i

MD5_x(i Shr 2) = BinOr(MD5_x(i Shr 2), (128 Shl (((i) Mod 4) * 8)))
MD5_x(nblk * 16 - 2) = Len(jono$) * 8

MD5_a = 1732584193 //&H67452301
MD5_b = -271733879 //&HEFCDAB89
MD5_c = -1732584194 //&H98BADCFE
MD5_d = 271733878 //&H10325476

// Käydään sanat läpi
For k = 0 To (nblk * 16 - 1) Step 16
MD5_AA = MD5_a
MD5_BB = MD5_b
MD5_CC = MD5_c
MD5_DD = MD5_d

// Kierros 1
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 0), 7, -680876936) //&HD76AA478
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 1), 12, -389564586) //&HE8C7B756
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 2), 17, 606105819 )//&H242070DB
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 3), 22, -1044525330) //&HC1BDCEEE
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 4), 7, -176418897) //&HF57C0FAF
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 5), 12, 1200080426 )//&H4787C62A
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 6), 17, -1473231341) //&HA8304613
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 7), 22, -45705983) //&HFD469501
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 8), 7, 1770035416) //&H698098D8
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 9), 12, -1958414417 )//&H8B44F7AF
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 10), 17, -42063 )//&HFFFF5BB1
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 11), 22, -1990404162) //&H895CD7BE
MD5_a = MD5_FF(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 12), 7, 1804603682) //&H6B901122
MD5_d = MD5_FF(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 13), 12, -40341101) //&HFD987193
MD5_c = MD5_FF(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 14), 17, -1502002290) //&HA679438E
MD5_b = MD5_FF(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 15), 22, 1236535329) //&H49B40821

// Kierros 2
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 1), 5, -165796510) //&HF61E2562
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 6), 9, -1069501632) //&HC040B340
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 11), 14, 643717713) //&H265E5A51
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 0), 20, -373897302) //&HE9B6C7AA
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 5), 5, -701558691) //&HD62F105D
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 10), 9, 38016083) //&H2441453
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 15), 14, -660478335) //&HD8A1E681
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 4), 20, -405537848) //&HE7D3FBC8
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 9), 5, 568446438) //&H21E1CDE6
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 14), 9, -1019803690) //&HC33707D6
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 3), 14, -187363961) //&HF4D50D87
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 8), 20, 1163531501) //&H455A14ED
MD5_a = MD5_GG(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 13), 5, -1444681467) //&HA9E3E905
MD5_d = MD5_GG(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 2), 9, -51403784) //&HFCEFA3F8
MD5_c = MD5_GG(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 7), 14, 1735328473) //&H676F02D9
MD5_b = MD5_GG(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 12), 20, -1926607734) //&H8D2A4C8A

// Kierros 3
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 5), 4, -378558) //&HFFFA3942
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 8), 11, -2022574463) //&H8771F681
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 11), 16, 1839030562) //&H6D9D6122
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 14), 23, -35309556) //&HFDE5380C
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 1), 4, -1530992060) //&HA4BEEA44
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 4), 11, 1272893353) //&H4BDECFA9
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 7), 16, -155497632) //&HF6BB4B60
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 10), 23, -1094730640) //&HBEBFBC70
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 13), 4, 681279174) //&H289B7EC6
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 0), 11, -358537222) //&HEAA127FA
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 3), 16, -722521979) //&HD4EF3085
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 6), 23, 76029189) //&H4881D05
MD5_a = MD5_HH(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 9), 4, -640364487) //&HD9D4D039
MD5_d = MD5_HH(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 12), 11, -421815835) //&HE6DB99E5
MD5_c = MD5_HH(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 15), 16, 530742520) //&H1FA27CF8
MD5_b = MD5_HH(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 2), 23, -995338651) //&HC4AC5665

// Kierros 4
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 0), 6, -198630844) //&HF4292244
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 7), 10, 1126891415) //&H432AFF97
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 14), 15, -1416354905) //&HAB9423A7
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 5), 21, -57434055) //&HFC93A039
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 12), 6, 1700485571) //&H655B59C3
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 3), 10, -1894986606) //&H8F0CCC92
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 10), 15, -1051523) //&HFFEFF47D
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 1), 21, -2054922799) //&H85845DD1
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 8), 6, 1873313359) //&H6FA87E4F
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 15), 10, -30611744) //&HFE2CE6E0
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 6), 15, -1560198380 )//&HA3014314
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 13), 21, 1309151649) //&H4E0811A1
MD5_a = MD5_II(MD5_a, MD5_b, MD5_c, MD5_d, MD5_x(k + 4), 6, -145523070) //&HF7537E82
MD5_d = MD5_II(MD5_d, MD5_a, MD5_b, MD5_c, MD5_x(k + 11), 10, -1120210379) //&HBD3AF235
MD5_c = MD5_II(MD5_c, MD5_d, MD5_a, MD5_b, MD5_x(k + 2), 15, 718787259) //&H2AD7D2BB
MD5_b = MD5_II(MD5_b, MD5_c, MD5_d, MD5_a, MD5_x(k + 9), 21, -343485551) //&HEB86D391

MD5_a = MD5_a + MD5_AA
MD5_b = MD5_b + MD5_BB
MD5_c = MD5_c + MD5_CC
MD5_d = MD5_d + MD5_DD
Next k

Return Lower(Str(WordToHex(MD5_a)) + Str(WordToHex(MD5_b)) + Str(WordToHex(MD5_c)) + Str(WordToHex(MD5_d)))
End Function


Function MD5_F(x, y, z)
Return BinOr(BinAnd(x, y), BinAnd(BinNot(x), z))
End Function

Function MD5_G(x, y, z)
Return BinOr(BinAnd(x, z), BinAnd(y, BinNot(z)))
End Function

Function MD5_H(x, y, z)
Return BinXor(BinXor(x, y), z)
End Function

Function MD5_I(x, y, z)
Return BinXor(y, BinOr(x, BinNot(z)))
End Function

Function MD5_FF(a, b, c, d, x, s, ac)
a = (a + ((MD5_F(b, c, d)+ x)+ ac))
a = RotateLeft(a, s)
Return a + b
End Function

Function MD5_GG(a, b, c, d, x, s, ac)
a = (a + ((MD5_G(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function

Function MD5_HH(a, b, c, d, x, s, ac)
a = (a + ((MD5_H(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function

Function MD5_II(a, b, c, d, x, s, ac)
a = (a + ((MD5_I(b, c, d) + x) + ac))
a = RotateLeft(a, s)
Return a + b
End Function

Function RotateLeft(lValue, iShiftBits)
Return BinOr(lValue Shl iShiftBits, lValue Shr (32 - iShiftBits))
End Function

Function WordToHex(lValue)
For lCount = 0 To 3
lByte = BinAnd(lValue Shr lCount * 8, 255)
ToHex$ = ToHex$ + Right("0" + Hex(lByte), 2)
Next lCount
Return ToHex$
End Function

Function BinAnd(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) And ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function

Function BinNot(luku1)
For i = 0 To 31
luku3 = luku3 + (Not ((luku1 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function

Function BinXor(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) Xor ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function

Function BinOr(luku1, luku2)
For i = 0 To 31
luku3 = luku3 + (((luku1 Shr i) Mod 2) Or ((luku2 Shr i) Mod 2)) Shl i
Next i
Return luku3
End Function

Function Bin2Dec(jono$)
For i = Len(jono$) To 1 Step -1
arvo = Int(Mid(jono$, i, 1))
If arvo = 1 Then
luku = luku + 2 ^ (Len(jono$) - i)
EndIf
Next i
Return luku
End Function 

Post Reply

Who is online

Users browsing this forum: No registered users and 9 guests