forum.boolean.name - Показать сообщение отдельно

Tadeus · 08.07.2010, 03:13

Понеслась. Тут функции почти все мои, некоторые переделаны с других языков

Функции для работы с base64

Function base64_encode$(msg$)
    Local alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    Local i=1
    While i<=Len(msg$)
        If i<=Len(msg$)-2
            c1=Asc(Mid$(msg$,i,1))
            c2=Asc(Mid$(msg$,i+1,1))
            c3=Asc(Mid$(msg$,i+2,1))
            e1=c1 Shr 2
            e2=((c1 And 3) Shl 4) Or (c2 Shr 4)
            e3=((c2 And 15) Shl 2) Or (c3 Shr 6)
            e4=c3 And 63
        Else
            If i=Len(i)-1 Then
                e3=64
                e4=63
            Else 
                e4=64
            EndIf 
        EndIf
        i=i+3
        r$=r$+Mid$(alph$,e1+1,1)+Mid$(alph$,e2+1,1)+Mid$(alph$,e3+1,1)+Mid$(alph$,e4+1,1)
    Wend
    Return r$
End Function 

Function base64_decode$(msg$)
    Local alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    Local i=1
    While i<=Len(msg$)
        e1=Instr(alph$,Mid$(msg$,i,1))-1
        e2=Instr(alph$,Mid$(msg$,i+1,1))-1
        e3=Instr(alph$,Mid$(msg$,i+2,1))-1
        e4=Instr(alph$,Mid$(msg$,i+3,1))-1
        c1=(e1 Shl 2) Or (e2 Shr 4)
        c2=((e2 And 15) Shl 4) Or (e3 Shr 2)
        c3=((e3 And 3) Shl 6) Or e4
        r$=r$+Chr$(c1)
        If e3<>64 Then
            r$=r$+Chr$(c2)
        EndIf
        If e4<>64 Then
            r$=r$+Chr$(c3)
        EndIf 
        i=i+4
    Wend
    Return r$
End Function

Проверка года на высокосность

Function isLeapYear(year)
    Local a=year Mod 4
    Local b=year Mod 100
    Local c=year Mod 400
    If (a=0 And b<>0) Or c=0 Then
        Return True
    EndIf 
End Function

Номер дня в году (требует наличия предыдущей функции)

Function yearDay(day,month,year)
    Local temp#
    If month>2 Then
        temp=month+1
        temp=temp*30.6
        temp=temp-(temp Mod 1)
        temp=temp-(63-isLeapYear(year))
    Else
        temp=month-1
        temp=temp*(63-isLeapYear(year))
        temp=temp/2
        temp=temp-(temp Mod 1)
    EndIf
    temp=temp+day
    Return temp
End Function

Получаем данные максимально поддерживаемого графического режима

Function maxWidth()
    Return GfxModeWidth(CountGfxModes())
End Function

Function maxHeight()
    Return GfxModeHeight(CountGfxModes())
End Function

Function maxDepth()
    Return GfxModeDepth(CountGfxModes())
End Function

Перевод в юлианские дни

Function toJulian(day%,month%,year%)
    Local a%,y%,m%
    a=(14-month)/12
    y=year+4800-a
    m=month+12*a-3
    Return day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045
End Function

Функции, возвращающие соответственно день, месяц и год из юлианских дней

Function julianDay(jd%)
    l=jd+68569
    n=(4*l)/146097
    l=l-(146097*n+3)/4
    i=(4000*(l+1))/1461001
    l=l-(1461*i)/4+31
    j=(80*l)/2447
    d=l-(2447*j)/80
    Return d
End Function

Function julianMonth(jd%)
    l=jd+68569
    n=(4*l)/146097
    l=l-(146097*n+3)/4
    i=(4000*(l+1))/1461001
    l=l-(1461*i)/4+31
    j=(80*l)/2447
    l=j/11
    m=j+2-(12*l)
    Return m
End Function

Function julianYear(jd%)
    l=jd+68569
    n=(4*l)/146097
    l=l-(146097*n+3)/4
    i=(4000*(l+1))/1461001
    l=l-(1461*i)/4+31
    j=(80*l)/2447
    d=l-(2447*j)/80
    l=j/11
    y=100*(n-49)+i+l
    Return y
End Function

RYB -> RGB. Правда, задаёт цвет, а не меняет его. Пригодится, если вы делаете программу, где необходимо смешение цветов как в красках.

Function setRYB(iR#,iY#,iB#)
    Local x0#,x1#,x2#,x3#,y0#,y1#

    x0=cubicInt(iB,1.0,0.163)
    x1=cubicInt(iB,1.0,0.0)
    x2=cubicInt(iB,1.0,0.5)
    x3=cubicInt(iB,1.0,0.2)
    y0=cubicInt(iY,x0,x1)
    y1=cubicInt(iR,x2,x3)
    red=cubicInt(iR,y0,y1)*255

    x0=cubicInt(iB,1.0,0.373)
    x1=cubicInt(iB,1.0,0.66)
    x2=cubicInt(iB,0.0,0.0)
    x3=cubicInt(iB,0.5,0.094)
    y0=cubicInt(iY,x0,x1)
    y1=cubicInt(iY,x2,x3)
    green=cubicInt(iR,y0,y1)*255

    x0=cubicInt(iB,1.0,0.6)
    x1=cubicInt(iB,0.0,0.2)
    x2=cubicInt(iB,0.0,0.5)
    x3=cubicInt(iB,0.0,0.0)
    y0=cubicInt(iY,x0,x1)
    y1=cubicInt(iY,x2,x3)
    blue=cubicInt(iR,y0,y1)*255

    Color red,green,blue
End Function

Function cubicInt#(t#,a#,b#)
    weight#=t#*t#*(3-2*t#)
    Return a#+weight#*(b#-a#)
End Function

Читаем ID3-теги (первой версии) из MP3

Function ID3_GetInfo(file$)
    FMusic=ReadFile(file$)
    BInfo=CreateBank(127)
    If Not FMusic Then
        FreeBank BInfo
        Return 0
    EndIf
    If Left$(ReadLine$(FMusic),3)<>"ID3" Then
        CloseFile FMusic
        FreeBank BInfo
        Return 0
    EndIf
    SeekFile FMusic,FileSize(file$)-128
    For i=0 To 126
        PokeByte BInfo,i,ReadByte(FMusic)
    Next
    For i=0 To 2
        STag$=STag$+Chr$(PeekByte(BInfo,i))
    Next
    If STag$<>"TAG" Then
        CloseFile FMusic
        FreeBank BInfo
        Return 0
    EndIf
    CloseFile FMusic
    Return BInfo
End Function

Function ID3_GetTitle$(BInfo)
    For i=3 To 30
        IByte=PeekByte(BInfo,i)
        If IByte<>0 Then
            STitle$=STitle$+Chr$(IByte)
        Else
            If Len(STitle$)>0 Then
                Return STitle$
            Else
                Return 0
            EndIf 
        EndIf 
    Next 
End Function

Function ID3_GetInterpreter$(BInfo)
    For i=33 To 63
        IByte=PeekByte(BInfo,i)
        If IByte<>0 Then
            SInterpreter$=SInterpreter$+Chr$(IByte)
        Else
            If Len(SInterpreter$)>0 Then
                Return SInterpreter$
            Else
                Return 0
            EndIf 
        EndIf 
    Next 
End Function

Function ID3_GetAlbum$(BInfo)
    For i=63 To 93
        IByte=PeekByte(BInfo,i)
        If IByte<>0 Then
            SAlbum$=SAlbum$+Chr$(IByte)
        Else
            If Len(SAlbum$)>0 Then
                Return SAlbum$
            Else
                Return 0
            EndIf 
        EndIf 
    Next 
End Function

Function ID3_GetYear$(BInfo)
    For i=93 To 96
        IByte=PeekByte(BInfo,i)
        If IByte>=48 And IByte<=57 Then 
            SYear$=SYear$+Chr$(IByte)
        Else
            Return 0
        EndIf 
    Next
    Return SYear$
End Function

Function ID3_GetComment$(BInfo)
    For i=97 To 127
        IByte=PeekByte(BInfo,i)
        If IByte<>0 Then
            SComment$=SComment$+Chr$(IByte)
        Else
            If Len(SComment$)>0 Then
                Return SComment$
            Else
                Return 0
            EndIf 
        EndIf 
    Next 
End Function

HTTP-запрос. Поддерживает перенаправления

Function httpGetRequest$(http_url$)
    If Left$(http_url$,7)="http://" Then
        http_url$=Mid$(http_url$,8)
    EndIf
    If Instr(http_url$,"/") Then
        http_host$=Left$(http_url$,Instr(http_url$,"/")-1)
        http_file$=Mid$(http_url$,Instr(http_url$,"/"))
    Else
        http_host$=http_url$
        http_file$="/"
    EndIf
    http_stream=OpenTCPStream(http_host$,80)
    If Not http_stream Then Return 0
    WriteLine http_stream,"GET "+http_file$+" HTTP/1.1"
    WriteLine http_stream,"Host: "+http_host$
    WriteLine http_stream,"Connection: close"
    WriteLine http_stream,""
    Repeat
        Delay 1
    Until ReadAvail(http_stream)<>0
    
    Repeat
        http_header$=ReadLine(http_stream)
        If Left(http_header$,9)="Location:"
            If Mid(http_header$,11,4)="http" Then
                Return httpGetRequest(Mid$(http_header$,11))
            Else
                Return httpGetRequest("http://"+http_host$+Mid$(http_header$,11))
            EndIf 
        EndIf 
    Until http_header$=""
    While Not Eof(http_stream)
        http_res$=http_res$+Chr$(ReadByte(http_stream))
    Wend
    
    res$=http_res$
    Return res$
End Function

Скачивание файла по HTTP. Также поддерживает перенаправление

Function httpGetFile(http_url$,savename$)
    If Left$(http_url$,7)="http://" Then
        http_url$=Mid$(http_url$,8)
    EndIf
    If Instr(http_url$,"/") Then
        http_host$=Left$(http_url$,Instr(http_url$,"/")-1)
        http_file$=Mid$(http_url$,Instr(http_url$,"/"))
    Else
        http_host$=http_url$
        http_file$="/"
    EndIf
    http_stream=OpenTCPStream(http_host$,80)
    If Not http_stream Then Return 0
    WriteLine http_stream,"GET "+http_file$+" HTTP/1.1"
    WriteLine http_stream,"Host: "+http_host$
    WriteLine http_stream,"Connection: close"
    WriteLine http_stream,""
    Repeat
        Delay 1
    Until ReadAvail(http_stream)<>0
    
    Repeat
        http_header$=ReadLine(http_stream)
        If Left(http_header$,9)="Location:"
            If Mid(http_header$,11,4)="http" Then
                Return httpGetFile(Mid$(http_header$,11),savename$)
            Else
                Return httpGetFile("http://"+http_host$+Mid$(http_header$,11),savename$)
            EndIf 
        EndIf 
    Until http_header$=""
    
    http_result=WriteFile(savename$)
    
    While Not Eof(http_stream)
        WriteByte http_result,ReadByte(http_stream)
    Wend

    CloseFile http_result
End Function

Получение unixtime из текущего и заданого времени:

Function unixtime()
    day=Int(CurrentDate$())
    year=Int(Right$(CurrentDate$(),4))
    Select Mid$(CurrentDate$(),4,3)
        Case "Jan"
            month=1
        Case "Feb"
            month=2
        Case "Mar"
            month=3
        Case "Apr"
            month=4
        Case "May"
            month=5
        Case "Jun"
            month=6
        Case "Jul"
            month=7
        Case "Aug"
            month=8
        Case "Sep"
            month=9
        Case "Oct"
            month=10
        Case "Nov"
            month=11
        Case "Dec"
            month=12
    End Select
    hour=Int(CurrentTime$())
    minute=Int(Mid(CurrentTime$(),4,2))
    second=Int(Right(CurrentTime$(),2))
    a=(14-month)/12
    y=year+4800-a
    m=month+12*a-3
    temp=day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045
    temp=(temp-2440588)*24*60*60
    temp=temp+60*60*hour+60*minute+second
    Return temp
End Function

Function time(day,month,year,hour=0,minute=0,second=0)
    a=(14-month)/12
    y=year+4800-a
    m=month+12*a-3
    temp=day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045
    temp=(temp-2440588)*24*60*60
    temp=temp+60*60*hour+60*minute+second
    Return temp
End Function

Создаёт квадратное поле размера w на h с шириной квадратной ячейки в sz

Function createField(w%,h%,sz#=1.0)
    m=CreateMesh()
    s=CreateSurface(m)
    For i=-h/2 To h/2
        For j=-h/2 To w/2
            sv#=(1/Float(w))*Float(i)
            su#=(1/Float(h))*Float(j)
            v=AddVertex(s,i*sz#,0,j*sz#,su#,sv#)
        Next 
    Next
    For i=0 To h-1
        For j=0 To w-1
            v1=i*(w+1)+j
            v2=i*(w+1)+j+1
            v3=i*(w+1)+j+w+1
            v4=i*(w+1)+j+w+2
            t1=AddTriangle(s,v1,v2,v3)
            t2=AddTriangle(s,v3,v2,v4)
        Next 
    Next
    UpdateNormals m
    Return m
End Function

Вот вроде бы и всё, если откопаю среди своего го.. добра еще что-нибудь - выложу