[Nerd]

Я када по хатам лазал, всегда из мафона кассеты тырил, типа ништяк, мойсерам не просечь

SeedRnd MilliSecs()

Graphics 640,480,32,2

Global main_clr = Rand(0,13)

    AppTitle clr2s(main_clr,1)+" madness"


;CreateThread(music_update_fp,0)

get_music()

While Not KeyHit(1)
    music_update()
Wend

End




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Global tmp_dir$ = SystemProperty("tempdir")



Function clr2s$(clr,m=0)
    Select clr
    Case 0
        Return "transparent"
    Case 1
        Return "black"
    Case 2
        Return "blue"
    Case 3
        Return "brown"
    Case 4
        Return "gray"
    Case 5
        Return "green"
    Case 6
        Return "orange"
    Case 7
        Return "pink"
    Case 8
        Return "purple"
    Case 9
        Return "red"
    Case 10
        Return "teal"
    Case 11
        Return "white"
    Case 12
        Return "yellow"
    Case 13
            If m Return "rainbow"
        Return clr2s(Rand(1,12))
    End Select
End Function

Function clr2style$(clr)
    Select clr
    Case 0
        Return "folk"
    Case 1
        Return "ambient"
    Case 2
        Return "electronic"
    Case 3
        Return "hardcore"
    Case 4
        Return "classical"
    Case 5
        Return "punk"
    Case 6
        Return "rock"
    Case 7
        Return "emo"
    Case 8
        Return "pop%20punk"
    Case 9
        Return "metal"
    Case 10
        Return "acoustic"
    Case 11
        Return "blues"
    Case 12
        Return "jazz"
    Case 13
        Return "90s"
    End Select
End Function



;Global get_music_thread,music_update_thread
Global mus_i,mus_lnk$,mus_s,mus_ch
;Global get_music_fp,music_update_fp

Function get_music()
    r$ = g_Get("/music/+free-music-downloads/"+clr2style(main_clr)+"?page="+Rand(1,20),"lastfm.jp","www.lastfm.jp")
    For i = 0 To Rand(0,7)
        r = Right(r,Len(r)-Instr(r,"http://freedownloads.last.fm/download/")-10)
    Next
    r = Right(r,Len(r)-Instr(r,"http://freedownloads.last.fm/download/")+1)
    r = Left(r,Instr(r,Chr(34))-1)
    mus_lnk = r
    ;get_music_thread = CreateThread(get_music_fp,0)
    get_music_
End Function

Function get_music_(i=0)
    mus_i = mus_i + 1
    
    Print "zagruzka..."

    BlitzGet(mus_lnk,tmp_dir,mus_i+".mp3")
    
    Print "zagruzheno!"
        
    If mus_ch Then
        If ChannelPlaying(mus_ch)
            For i = 1 To 8
                ChannelVolume mus_ch,0.8-(i/10.0)
                Delay 100
            Next
        EndIf
        
        StopChannel mus_ch
        FreeSound mus_s
        DeleteFile tmp_dir+"\"+(mus_i-1)+".mp3"
    Else
        cmt = True
    EndIf
    
    mus_s = LoadSound(tmp_dir+"\"+mus_i+".mp3")
    If mus_s = 0 Then
        get_music()
        Return
    EndIf
    mus_ch = PlaySound(mus_s)
    ChannelVolume mus_ch,0.8
    
    ;If cmt = True Then music_update_thread = CreateThread(music_update,0)
    
End Function
;get_music_fp = FunctionPointer()
;    Goto gmfpskip
;    get_music_()
;    .gmfpskip

Function music_update(i=0)
    ;While True
            ;Delay 500
            If ChannelPlaying(mus_ch)=0 Then
                get_music()
                ;Delay 20000
            EndIf
    ;Wend
End Function
;music_update_fp = FunctionPointer()
;    Goto mufpskip
;    music_update()
;    .mufpskip


;;;;;;;;;;;;;;       NETWORK UTILS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Function g_Get$(url$,server_ip$,server_host$,head$="")
        Local res$
    Local ns = OpenTCPStream(server_ip,80)
        If Not ns Then Return
    Local getq$ = "GET "+url+" HTTP/1.0"+Chr(13)+"\nHost: "+server_host
    ;getq = getq + "\nConnection: keep-alive"
    ;getq = getq + "\n"+head
    getq = getq + "\nUser-agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:23.0) Gecko/20100101 Firefox/23.0"
    getq = getq + "\nAccept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
    getq = getq + "\nAccept-Language: ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3\n"
    ;getq = getq + "\nAccept-Encoding: deflate"
    ;For i_c.g_Cookie = Each g_Cookie
    ;    getq = getq + "\nCookie: "+i_c\name+" = "+i_c\dat
    ;Next
    getq = getq +"\n"+Chr(13)+Chr(10)
    ;WriteLine ns,Replace(getq,"\n",Chr(13)+Chr(10))
    WriteLine ns,Replace(getq,"\n",Chr(10))
        While ReadAvail(ns)=0
            Delay 10
        Wend
        While ReadAvail(ns)
             ;res = res+Chr(ReadByte(ns))
            ln$ = ReadLine(ns)
            res = res + ln + Chr(13)+Chr(10)
          Wend

            CloseTCPStream(ns)
                Local header$ = Left(res,Instr(res,Chr(13)+Chr(10)+Chr(13)+Chr(10)))
                    ;While Instr(header,"Set-Cookie")
                    ;        header = Right(header,Len(header)-Instr(header,"Set-Cookie")-11)
                    ;    Local cn$ = Left(header,Instr(header,"=")-1)
                    ;    Local cd$ = Mid(header,Instr(header,"=")+1,Instr(header,Chr(13))-Instr(header,"=") )
                    ;    SetCookie(cn,cd)
                    ;    ;Print cn+" = "+cd
                    ;Wend    
                res = Right(res,Len(res)-(Instr(res,Chr(13)+Chr(10)+Chr(13)+Chr(10)))-3)        
    ;Stop
    Return res
End Function

Function BlitzGet (webFile$, saveDir$, saveFile$)
    If Left (webFile$, 7) = "http://" Then webFile$ = Right (webFile$, Len (webFile$) - 7)
    slash = Instr (webFile$, "/")
    If slash
        webHost$ = Left (webFile$, slash - 1)
        webFile$ = Right (webFile$, Len (webFile$) - slash + 1)
    Else
        webHost$ = webFile$
        webFile$ = "/"
    EndIf
    If Right (saveDir$, 1) <> "\" Then saveDir$ = saveDir$ + "\"
    If saveFile$ = ""
        If webFile = "/"
            saveFile$ = "Unknown file.txt"
        Else
            For findSlash = Len (webFile$) To 1 Step - 1
                testForSlash$ = Mid (webFile$, findSlash, 1)
                If testForSlash$ = "/"
                    saveFile$ = Right (webFile$, Len (webFile$) - findSlash)
                    Exit
                EndIf
            Next
            If saveFile$ = "" Then saveFile$ = "Unknown file.txt"
        EndIf
    EndIf
    www = OpenTCPStream (webHost$, 80)
    If www
    Local getq$ = "GET "+webFile+" HTTP/1.0"+Chr(13)+"\nHost: "+webHost
    ;getq = getq + "\nConnection: keep-alive"
    ;getq = getq + "\n"+head
    getq = getq + "\nUser-agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:23.0) Gecko/20100101 Firefox/23.0"
    getq = getq + "\nAccept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
    getq = getq + "\nAccept-Language: ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3\n"
    getq = getq +"\n"+Chr(13)+Chr(10)
    WriteLine www,Replace(getq,"\n",Chr(10))
               While ReadAvail(www)=0
                    Delay 10
               Wend
                ;DebugLog ReadAvail(www)     
        Repeat
            header$ = ReadLine (www)
            reply$ = ""
            pos = Instr (header$, ": ")
            If pos
                reply$ = Left (header$, pos + 1)
            EndIf
            Select Lower (reply$)
                Case "content-length: "
                    bytesToRead = ReplyContent (header$, reply$)
                Case "date: "
                    date$ = ReplyContent (header$, reply$)
                Case "server: "
                    server$ = ReplyContent (header$, reply$)
                Case "content-type: "
                    contentType$ = ReplyContent (header$, reply$)
                Default
                    If gotReply = 0 Then initialReply$ = header$: gotReply = 1
            End Select
        Until header$ = "" Or (Eof (www))
        If bytesToRead = 0 Then Goto skipDownLoad
        save = WriteFile (saveDir$ + saveFile$)
        If Not save Then Goto skipDownload
        For readWebFile = 1 To bytesToRead
            If Not Eof (www) Then WriteByte save, ReadByte (www)
            tReadWebFile = readWebFile
        Next
        CloseFile save
        If (readWebFile - 1) = bytesToRead
            success = 1
        EndIf
        .skipDownload
        CloseTCPStream www
    Else

    EndIf
    Return success
End Function

Function ReplyContent$ (header$, reply$)
    Return Right (header$, Len (header$) - Len (reply$))
End Function

Загрузка такая медленная из-за кривости сокетов блица. На максе всё за пару секунд грузилось.