Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Полезные функции

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

Ответ
 
Опции темы
Старый 04.09.2013, 16:59   #1
Nerd
Чудо-кот
 
Аватар для Nerd
 
Регистрация: 22.02.2011
Сообщений: 901
Написано 480 полезных сообщений
(для 1,471 пользователей)
Воровской тред

Салют всем блатным!
Сегодня мы будем воровать пикчи из интернета.
SeedRnd MilliSecs()

Graphics 800,600,32,2
SetBuffer BackBuffer()

clr = Rand(0,12) ; 0 - undefined
    AppTitle clr2s(clr)

query$ = "potato"

AutoMidHandle True
While Not KeyHit(1)
    img = GoogleImage(query,clr,"medium","&imgtype=photo") ; Об остальных параметрах можно почитать тут: https://developers.google.com/image-search/v1/jsondevguide?hl=ru
    DrawImage img,400,300
    Flip
    FreeImage img
    Delay 100
Wend

End


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

Global tmp_dir$ = SystemProperty("tempdir")

Function clr2s$(clr)
    Select clr
    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
        Return clr2s(Rand(1,12))
    End Select
End Function

Function GoogleImage(query$,clr,size$,ext$="") ;size - icon, small, medium, large, xlarge, xxlarge, huge
            query = Replace(query," ","%20")
            gq$ = "http://ajax.googleapis.com/ajax/services/search/images?v=1.0&q="+query+"&as_filetype=jpg&start="+Rand(1,10)+"&imgsz="+size+ext
                If clr gq = gq + "&imgcolor="+clr2s(clr)
            r$ = g_Get(gq,"ajax.googleapis.com","ajax.googleapis.com")
            If Mid(r,30,1)="]"
                query = Rand(0,10000)
                Return GoogleImage(query,clr,size)
            EndIf
            For i = 1 To Rand(1,4)
                r = Right(r,Len(r)-Instr(r,"unescapedUrl")-14)
            Next
            r = Left(r,Instr(r,Chr(34))-1)

        BlitzGet(r,tmp_dir,"g_img.jpg") 

        img = LoadImage(tmp_dir+"\g_img.jpg")
        If Not img Then Return GoogleImage(query,clr,size)
    
    DeleteFile tmp_dir+"\g_img.jpg"
    Return img
End Function

;;;;;;;;;;;;;;       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.1\nHost: "+server_host
    getq = getq + "\nConnection: close"
    ;getq = getq + "\n"+head
    ;For i_c.g_Cookie = Each g_Cookie
    ;    getq = getq + "\nCookie: "+i_c\name+" = "+i_c\dat
    ;Next
    getq = getq +"\n"+Chr(10)
    WriteLine ns,Replace(getq,"\n",Chr(13)+Chr(10))
        While ReadAvail(ns)=0
            ;Delay 10
        Wend
        While ReadAvail(ns)
             ;res = res+Chr(ReadByte(ns))
            ln$ = ReadLine(ns)
            ;DebugLog ln
            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)        
    Return res
End Function



Function BlitzGet (webFile$, saveDir$, saveFile$)

    ; -------------------------------------------------------------------------
    ; Strip "http://" if provided
    ; -------------------------------------------------------------------------
    If Left (webFile$, 7) = "http://" Then webFile$ = Right (webFile$, Len (webFile$) - 7)

    ; -------------------------------------------------------------------------
    ; Split into hostname and path/filename to download
    ; -------------------------------------------------------------------------
    slash = Instr (webFile$, "/")
    If slash
        webHost$ = Left (webFile$, slash - 1)
        webFile$ = Right (webFile$, Len (webFile$) - slash + 1)
    Else
        webHost$ = webFile$
        webFile$ = "/"
    EndIf
        
    ; -------------------------------------------------------------------------
    ; Add trailing slash to download dir if not given
    ; -------------------------------------------------------------------------
    If Right (saveDir$, 1) <> "\" Then saveDir$ = saveDir$ + "\"

    ; -------------------------------------------------------------------------
    ; Save filename -- get from webFile$ if not provided
    ; -------------------------------------------------------------------------
    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

    ; DEBUG
    ; RuntimeError "Web host: " + webHost$ + Chr (10) + "Web file: " + webFile$ + Chr (10) + "Save dir: " + saveDir$ + Chr (10) + "Save file: " + saveFile$

    www = OpenTCPStream (webHost$, 80)

    If www
    
        WriteLine www, "GET " + webFile$ + " HTTP/1.1" ; GET / gets default page...
        WriteLine www, "Host: " + webHost$
        WriteLine www, "User-Agent: BlitzGet Deluxe"
        WriteLine www, "Accept: */*"
        WriteLine www, ""
        
        ; ---------------------------------------------------------------------
        ; Find blank line after header data, where the action begins...
        ; ---------------------------------------------------------------------
                
        Repeat

            Cls
            
            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

            ;DisplayResponse ()

            Flip
            
        Until header$ = "" Or (Eof (www))
                
        If bytesToRead = 0 Then Goto skipDownLoad
        
        ; ---------------------------------------------------------------------
        ; Create new file to write downloaded bytes into
        ; ---------------------------------------------------------------------
        save = WriteFile (saveDir$ + saveFile$)
        If Not save Then Goto skipDownload

        ; ---------------------------------------------------------------------
        ; Incredibly complex download-to-file routine...
        ; ---------------------------------------------------------------------

        For readWebFile = 1 To bytesToRead
        
            If Not Eof (www) Then WriteByte save, ReadByte (www)
            
            ; Call BytesReceived with position and size every 100 bytes (slows down a LOT with smaller updates)
            
            tReadWebFile = readWebFile
            ;If tReadWebFile Mod 100 = 0 Then BytesReceived (readWebFile, bytesToRead)

        Next

        CloseFile save
        
        ; Fully downloaded?
        If (readWebFile - 1) = bytesToRead
            success = 1
        EndIf
        
        ; Final update (so it's not rounded to nearest 100 bytes!)
        ;BytesReceived (bytesToRead, bytesToRead)
        
        .skipDownload
        CloseTCPStream www
        
    Else
    
        ;RuntimeError "Failed to connect"
        
    EndIf
    
    Return success
    
End Function

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
__________________

(Offline)
 
Ответить с цитированием
Эти 4 пользователя(ей) сказали Спасибо Nerd за это полезное сообщение:
Кирпи4 (05.09.2013), LLI.T.A.L.K.E.R. (04.09.2013), Randomize (04.09.2013), tirarex (04.09.2013)
Старый 04.09.2013, 17:31   #2
ABTOMAT
Ференька
 
Аватар для ABTOMAT
 
Регистрация: 26.01.2007
Адрес: улица Пушкина дом Колотушкина
Сообщений: 10,741
Написано 5,461 полезных сообщений
(для 15,675 пользователей)
Ответ: Воровской тред

В Гугл раз или Яндекс в глаз?
__________________
Мои проекты:
Анальное Рабство
Зелёный Слоник
Дмитрий Маслов*
Различие**
Клюква**

* — в стадии разработки
** — в стадии проектирования
Для проектов в стадии проектирования приведены кодовые имена

(Offline)
 
Ответить с цитированием
Эти 7 пользователя(ей) сказали Спасибо ABTOMAT за это полезное сообщение:
ARA (04.09.2013), Crayzi (11.09.2013), Кирпи4 (05.09.2013), Gector (04.09.2013), Mr_F_ (04.09.2013), Phantom (06.09.2013), Wegox (04.09.2013)
Старый 04.09.2013, 18:14   #3
moka
.
 
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений
(для 6,863 пользователей)
Ответ: Воровской тред

Вот жеж зажало в попе..

Наметал то же самое на JS: http://files.moka.co/getGooglePic.html
По стандарту ищет "blitz3d", но можно и что угодно: http://files.moka.co/getGooglePic.html?forest

Да и http://ajax.googleapis.com/ajax/services/search/images - deprecated, и нужно юзать новый поиск.

Юзается так:
loadImage('blitz3d', {
  
color'blue',
  
size'medium'
}, function(errurl) {
  if (!
err) {
    
// url - ссылка на файл
  
} else {
    
// err - объект с ошибкой
  
}
}); 
Код:
<body>
  <
img id='test' />
  <
div id='error'></div>
</
body>

<
script>
  var 
colors = [ 'black''blue''brown''gray''green''orange''pink''purple''red''teal''white''yellow' ];

  var 
callbacks = { };
  var 
callbacksCounter 0;

  var 
query 'blitz3d';
  if (
location.search && location.search.length 0) {
    
query location.search.substr(1);
  }

  
loadImage(query, {
    
colorcolors[Math.floor(Math.random() * colors.length)],
    
size'medium',
    
skipMath.floor(Math.random() * 8)
  }, function(
errurl) {
    if (!
err) {
      
document.getElementById('test').src url;
    } else {
      
document.getElementById('error').innerHTML JSON.stringify(err);
    }
  });

  function 
loadImage(queryoptionsfn) {
    if (
fn) {
      var 
callbackId = ++callbacksCounter;
      
callbacks[callbackId] = fn;

      var 
url 'http://ajax.googleapis.com/ajax/services/search/images?v=1.0&q=' query '&rsz=1&callback=imageLoaded&context=' callbackId;
      if (
options) {
        if (
options.colorurl += '&imgcolor=' options.color;
        if (
options.size)  url += '&imgsz=' options.size;
        if (
options.type)  url += '&imgtype=' options.type;
        if (
options.skip)  url += '&start=' options.skip;
      }

      var 
script document.createElement('script');
      
script.onerror = function() {
        
delete callbacks[callbackId];
        
fn({ errortruemessage'could make a jsonp request' });
      }

      
script.src url;
      
document.body.appendChild(script);
    }
  }
  function 
imageLoaded(contextdatastatusmessage) {
    if (
callbacks[context]) {
      if (
data && data.results && data.results.length == && data.results[0].unescapedUrl) {
        
callbacks[context](nulldata.results[0].unescapedUrl);
      } else {
        
callbacks[context]({ errortruecodestatusmessagemessage });
      }
      
delete callbacks[context];
    }
  }
</script> 
(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо moka за это полезное сообщение:
Gector (04.09.2013), LLI.T.A.L.K.E.R. (04.09.2013)
Старый 04.09.2013, 19:07   #4
tirarex
Бывалый
 
Аватар для tirarex
 
Регистрация: 23.11.2011
Сообщений: 863
Написано 334 полезных сообщений
(для 866 пользователей)
Ответ: Воровской тред

Moka ,после 3-5 обновлений {"error":true,"code":503,"message":"qps rate exceeded"}
(Offline)
 
Ответить с цитированием
Старый 04.09.2013, 19:24   #5
moka
.
 
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений
(для 6,863 пользователей)
Ответ: Воровской тред

Сообщение от tirarex Посмотреть сообщение
Moka ,после 3-5 обновлений {"error":true,"code":503,"message":"qps rate exceeded"}
Потому что Google откатили такой метод и требуют использовать новый способ поиска с ключём приложения.
На текущем методе (что использован в примере), есть ограничение на частоту запросов, мне пофиг :D
(Offline)
 
Ответить с цитированием
Старый 04.09.2013, 19:34   #6
ABTOMAT
Ференька
 
Аватар для ABTOMAT
 
Регистрация: 26.01.2007
Адрес: улица Пушкина дом Колотушкина
Сообщений: 10,741
Написано 5,461 полезных сообщений
(для 15,675 пользователей)
Ответ: Воровской тред

Есть два стула: на одном Гугл точёный, на другом Яндекс сам знаешь какой. Каким поисковиком сам искать будешь, какой матери по дефолту поставишь?
__________________
Мои проекты:
Анальное Рабство
Зелёный Слоник
Дмитрий Маслов*
Различие**
Клюква**

* — в стадии разработки
** — в стадии проектирования
Для проектов в стадии проектирования приведены кодовые имена

(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо ABTOMAT за это полезное сообщение:
ARA (04.09.2013), Кирпи4 (05.09.2013)
Старый 04.09.2013, 19:52   #7
ant0N
Бывалый
 
Аватар для ant0N
 
Регистрация: 10.06.2011
Адрес: В горах
Сообщений: 849
Написано 331 полезных сообщений
(для 853 пользователей)
Ответ: Воровской тред

Автомат, какой яндекс? Чет я не в теме
__________________
Абсолютли!
(Offline)
 
Ответить с цитированием
Старый 04.09.2013, 20:05   #8
Nikich
Бывалый
 
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений
(для 275 пользователей)
Ответ: Воровской тред


В таких перчатках яндексом пользовались.
(Offline)
 
Ответить с цитированием
Эти 5 пользователя(ей) сказали Спасибо Nikich за это полезное сообщение:
ABTOMAT (04.09.2013), Кирпи4 (05.09.2013), Gector (04.09.2013), LLI.T.A.L.K.E.R. (04.09.2013), tormoz (04.09.2013)
Старый 04.09.2013, 20:30   #9
ant0N
Бывалый
 
Аватар для ant0N
 
Регистрация: 10.06.2011
Адрес: В горах
Сообщений: 849
Написано 331 полезных сообщений
(для 853 пользователей)
Ответ: Воровской тред

Гоогле говно, яндэкс рулет!
__________________
Абсолютли!
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
ARA (29.01.2014)
Старый 04.09.2013, 21:13   #10
Nerd
Чудо-кот
 
Аватар для Nerd
 
Регистрация: 22.02.2011
Сообщений: 901
Написано 480 полезных сообщений
(для 1,471 пользователей)
Ответ: Воровской тред

Я када по хатам лазал, всегда из мафона кассеты тырил, типа ништяк, мойсерам не просечь
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

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

(Offline)
 
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо Nerd за это полезное сообщение:
Кирпи4 (05.09.2013), LLI.T.A.L.K.E.R. (19.09.2013), Randomize (04.09.2013)
Старый 29.01.2014, 00:24   #11
Nerd
Чудо-кот
 
Аватар для Nerd
 
Регистрация: 22.02.2011
Сообщений: 901
Написано 480 полезных сообщений
(для 1,471 пользователей)
Ответ: Воровской тред

А эта штука меняет аватарку на булке каждые 6 секунд:

SeedRnd MilliSecs()
Global tmp_dir$ = SystemProperty("tempdir")


login$ = "Nerd"
paswd$ = "ahuehuehue" ;(не настоящий, да)

tag$ = "Konata"

useGoogle = 1
useBoors = 1




paswd_md5$ = md5(paswd)
g_Post("http://forum.boolean.name/login.php?do=login","forum.boolean.name","forum.boolean.name","","vb_login_username="+login+"&cookieuser=1&vb_login_password="+paswd+"&s=&do=login&vb_login_md5password="+paswd_md5+"&vb_login_md5password_utf="+paswd_md5)


While Not KeyHit(1)
    Delay 6000
        
        
        SearchImage(tag,useGoogle,useBoors)
        
        
            q$ =        "--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"s"+Chr(34)
             q = q + "~"
             q = q + "~"
             q = q + "~--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"do"+Chr(34)
             q = q + "~"
             q = q + "~updateavatar"
             q = q + "~--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"avatarid"+Chr(34)
             q = q + "~"
             q = q + "~0"
             q = q + "~--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"avatarurl"+Chr(34)
             q = q + "~"
             q = q + "~http://www."
             q = q + "~--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"MAX_FILE_SIZE"+Chr(34)
             q = q + "~"
             q = q + "~2097152000"
             q = q + "~--"+POST_BOUND
             q = q + "~Content-Disposition: form-Data; name="+Chr(34)+"upload"+Chr(34)+"; filename="+Chr(34)+"g_img.jpg"+Chr(34)
             q = q + "~Content-Type: image/jpeg"
             q = q + "~"
             q = q + "~"
        
        g_Post2("/profile.php?do=updateavatar","forum.boolean.name","forum.boolean.name","",q,tmp_dir+"\g_img.jpg")
        
Wend

End





Function SearchImage$(tag$,google,boors)
    src = Rand(0,1)
    If (src=0 And google) Or (boors=0)
        ;google

                            tag = Replace(tag," ","%20")
                            gq$ = "http://ajax.googleapis.com/ajax/services/search/images?v=1.0&q="+tag+"&as_filetype=jpg&start="+Rand(1,10)+"&imgsz=medium"
                            r$ = g_Get(gq,"ajax.googleapis.com","ajax.googleapis.com")
                            If Mid(r,30,1)="]"
                                tag = Rand(0,10000)
                                Return SearchImage(tag,1,0)
                            EndIf
                            For i = 1 To Rand(1,4)
                                r = Right(r,Len(r)-Instr(r,"unescapedUrl")-14)
                            Next
                            r = Left(r,Instr(r,Chr(34))-1)
                
                        BlitzGet(r,tmp_dir,"g_img.jpg")
                
                        img = LoadImage(tmp_dir+"\g_img.jpg")
                        If Not img Then Return SearchImage(tag,1,0)
                        FreeImage img
                        
                        Return tmp_dir+"\g_img.jpg"
                        
    Else
        ;boorz
        
                Select Rand(0,0)
                
                    Case 0 ;DANBOORU
                    
                        pg$ = g_Get("http://danbooru.donmai.us/posts?utf8=0&tags="+tag,"danbooru.donmai.us","danbooru.donmai.us","")                        
                                pg = Right(pg,Len(pg)-Instr(pg,"...</li><li><a href="+Chr(34)+"/posts?&page="))
                                pg = Right(pg,Len(pg)-Instr(pg,"utf8=0"+Chr(34)+">")-7)
                                pg = Left(pg,Instr(pg,"<")-1)
                            pages = pg
                                If pages = 0 Then Return SearchImage(tag,1,0)
                                
                        pg = g_Get("http://danbooru.donmai.us/posts?utf8=0&tags="+tag+"&page="+Rand(1,pages),"danbooru.donmai.us","danbooru.donmai.us","")
                                delimeter$ = "<div id="+Chr(34)+"posts"+Chr(34)+">"
                            For i = 0 To Rand(0,16)
                                pgo$ = pg
                                pg = Right(pg,Len(pg)-Instr(pg,delimeter))
                                If Instr(pg,delimeter)=0 Then
                                    pg = pgo
                                    Exit
                                EndIf
                            Next
                                pg = Right(pg,Len(pg)-Instr(pg,"<article id=")-17)
                                pg = Left(pg,Instr(pg,Chr(34)))
                                postnum = pg
                            
                            pg = g_Get("http://danbooru.donmai.us/posts/"+postnum,"danbooru.donmai.us","danbooru.donmai.us","")
                                pg = Right(pg,Len(pg)-Instr(pg,"Size: <a href=")-14)
                                pg = Left(pg,Instr(pg,Chr(34)+">")-1)
                                
                            BlitzGet("http://danbooru.donmai.us"+pg,tmp_dir,"g_img.jpg")
                                
                End Select
    EndIf
End Function






    
Type g_Cookie
    Field name$,dat$
End Type

Function SetCookie(name$,dat$)
    For i_c.g_Cookie = Each g_Cookie
        If i_c\name = name Then
            i_c\dat = dat
            Return
        EndIf
    Next
        i_c = New g_Cookie
            i_c\name = name
            i_c\dat = dat
End Function

Function GetCookie$(name$)
    For i_c.g_Cookie = Each g_Cookie
        If i_c\name = name Then
            Return i_c\dat
        EndIf
    Next
End Function


Function g_Get$(url$,server_ip$,server_host$,head$="")
    
    st = MilliSecs()
    timeout = 8000
    
        Local res$
    Local ns = OpenTCPStream(server_ip,80)
        If ns = 0 Then Return

    Local getq$ = "GET "+url+" HTTP/1.1\nHost: "+server_host
    
    getq = getq + "\nUser-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64; rv:26.0) Gecko/20100101 Firefox/26.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"
    
    getq = getq + "\nConnection: close"
    ;getq = getq + "\n"+head
    
    getq = getq + "\nCookie: "
    For i_c.g_Cookie = Each g_Cookie
        ;getq = getq + "\nCookie: "+i_c\name+" = "+i_c\dat
        getq = getq + i_c\name+"="+i_c\dat+";"
    Next
    getq = Left(getq,Len(getq)-1)
    
    getq = getq +"\n"+Chr(10)
    WriteLine ns,Replace(getq,"\n",Chr(13)+Chr(10))

        While ReadAvail(ns)=0
            ;Delay 10
            If (MilliSecs()-st)>timeout Then Return ""
        Wend

        While ReadAvail(ns)
            If (MilliSecs()-st)>timeout Then Return ""
             ;res = res+Chr(ReadByte(ns))
            ln$ = ReadLine(ns)
            ;DebugLog ln
            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,"=") )
                              cd = Left(cd,Instr(cd,";")-1)
                        SetCookie(cn,cd)
                        ;DebugLog "COOKIE: "+cn+" = "+cd
                    Wend
                    
                res = Right(res,Len(res)-(Instr(res,Chr(13)+Chr(10)+Chr(13)+Chr(10)))-3)
                
                
    Return res
End Function


Function g_Post$(url$,server_ip$,server_host$,head$,post$,fileupload$="")
        Local res$
    Local ns = OpenTCPStream(server_ip,80)
        If ns = 0 Then Return

    Local getq$ = "POST "+url+" HTTP/1.1\nHost: "+server_host

    getq = getq + "\nUser-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64; rv:26.0) Gecko/20100101 Firefox/26.0"
    getq = getq + "\nContent-Type: application/x-www-form-urlencoded"
    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"
    ;getq = getq + "\nAccept-Encoding: gzip, deflate"
    
    ;Print Len(post)
    
    getq = getq + "\nConnection: close"
    getq = getq + "\nContent-Length: "+(Len(post)+FileSize(fileupload))
    
    
    ;getq = getq + "\n"+head
    
    
    
    getq = getq + "\nCookie: "
    For i_c.g_Cookie = Each g_Cookie
        ;getq = getq + "\nCookie: "+i_c\name+" = "+i_c\dat
        getq = getq + i_c\name+"="+i_c\dat+";"
    Next
    getq = Left(getq,Len(getq)-1)
    

    getq = getq + "\n\n"+post

    If fileupload=""
        WriteLine ns,Replace(getq,"\n",Chr(13)+Chr(10))
    Else
        getq = Replace(getq,"\n",Chr(13)+Chr(10))
        For i = 0 To Len(getq)-1
            WriteByte(ns,Mid(getq,i,1))
        Next
        f = ReadFile(fileupload)
        While Not Eof(f)
            WriteByte(ns,ReadByte(f))
        Wend
        WriteByte(ns,13)
        WriteByte(ns,10)
    EndIf
    
        ;Print Len(getq)

        While ReadAvail(ns)=0
            ;Delay 10
        Wend
            Delay 300
        While ReadAvail(ns)
             ;res = res+Chr(ReadByte(ns))
            ln$ = ReadLine(ns)
            ;DebugLog ln
            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,"=") )
                              cd = Left(cd,Instr(cd,";")-1)
                        SetCookie(cn,cd)
                        ;DebugLog "COOKIE: "+cn+" = "+cd
                    Wend
                
                    
                ;res = Right(res,Len(res)-(Instr(res,Chr(13)+Chr(10)+Chr(13)+Chr(10)))-3)
                res = Right(res,Len(res)-(Instr(res,Chr(10)+Chr(10)))-3)
                
                
    Return res
End Function


Const POST_BOUND$ = "---------------------------155691459114627"

Function g_Post2$(url$,server_ip$,server_host$,head$,post$,fileupload$="")

        Local res$
    Local ns = OpenTCPStream(server_ip,80)
        If ns = 0 Then Return

    Local getq$ = "POST "+url+" HTTP/1.1~Host: "+server_host
    getq = getq + "~User-Agent: Mozilla/5.0 (Windows NT 6.2; WOW64; rv:26.0) Gecko/20100101 Firefox/26.0"
    getq = getq + "~Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
    getq = getq + "~Accept-Language: ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3"
    getq = getq + "~Accept-Encoding: gzip, deflate"
    getq = getq + "~Referer: http://forum.boolean.name/profile.php?do=editavatar"

    getq = getq + "~Cookie: "
    For i_c.g_Cookie = Each g_Cookie
        getq = getq + i_c\name+"="+i_c\dat+";"
    Next
    getq = Left(getq,Len(getq)-1)
    
    getq = getq + "~Connection: close"
    getq = getq + "~Content-Type: multipart/form-data; boundary="+POST_BOUND
    

    
    getq = getq + "~Content-Length: "+(57230-56515+FileSize(fileupload)) ;(Len(post)+FileSize(fileupload))+Len(POST_BOUND)+8
;Print (Len(post)+FileSize(fileupload))+Len(POST_BOUND)+8
    getq = getq + "~~"+post


        getq_b = CreateBank(Len(getq))
        i2 = -1
        For i = 1 To Len(getq)
            i2 = i2 + 1
                If Mid(getq,i,1)="~" Then
                        If (i2+2)>BankSize(getq_b) Then ResizeBank(getq_b,BankSize(getq_b)+3)
                    PokeByte getq_b,i2,13
                    PokeByte getq_b,i2+1,10
                    i2 = i2 + 1
                Else
                        If (i2+1)>BankSize(getq_b) Then ResizeBank(getq_b,BankSize(getq_b)+2)
                        ;Print i2+"/"+BankSize(getq_b)
                    PokeByte getq_b,i2,Asc(Mid(getq,i,1))
                EndIf
        Next
    


    If fileupload=""
        WriteLine ns,Replace(getq,"~",Chr(13)+Chr(10))
    Else
    
            ;ns = WriteFile("test.txt")
    
        ;getq = Replace(getq,"\n",Chr(13)+Chr(10))
        

        
            ;Print Len(getq)
        ;For i = 1 To Len(getq)
        ;    WriteByte(ns,Mid(getq,i,1))
        ;Next
        For i = 0 To BankSize(getq_b)-1
            ;If PeekByte(getq_b,i)=0 Then Exit
            WriteByte(ns,PeekByte(getq_b,i))
        Next
        f = ReadFile(fileupload)
        While Not Eof(f)
            WriteByte(ns,ReadByte(f))
        Wend
        WriteByte(ns,13)
        WriteByte(ns,10)
        WriteLine(ns,"--"+POST_BOUND+"--")

    EndIf


        While ReadAvail(ns)=0
            ;Delay 10
        Wend
            Delay 300
        While ReadAvail(ns)
             ;res = res+Chr(ReadByte(ns))
            ln$ = ReadLine(ns)
            ;DebugLog ln
            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,"=") )
                              cd = Left(cd,Instr(cd,";")-1)
                        SetCookie(cn,cd)
                        ;DebugLog "COOKIE: "+cn+" = "+cd
                    Wend
                
                    
                ;res = Right(res,Len(res)-(Instr(res,Chr(13)+Chr(10)+Chr(13)+Chr(10)))-3)
                res = Right(res,Len(res)-(Instr(res,Chr(10)+Chr(10)))-3)
                
                
    Return res
End Function






;This array needs to be here for Blitz
Dim MD5_x(0)

;?????? ?????????????

;???????
Function MD5$(sMessage$)

;Pads the String as per the MD5 standard
nblk = ((Len(sMessage$) + 8) Shr 6) + 1  ;number of 16-word blocks

Dim MD5_x(nblk * 16 - 1)
;Zero pad the string
For i = 0 To nblk * 16 - 1
MD5_x(i) = 0
Next
;Convert to array of "words"
For i = 0 To (Len(sMessage$) - 1)
MD5_x((i Shr 2)) = MD5_x((i Shr 2)) Or (Asc(Mid(sMessage$, (i + 1), 1)) Shl ((i Mod 4) * 8))
Next
MD5_x((i Shr 2)) = MD5_x((i Shr 2)) Or (128 Shl (((i) Mod 4) * 8))
MD5_x(nblk * 16 - 2) = Len(sMessage$) * 8

;Set initial values
MD5_a = 1732584193 ;&H67452301
MD5_b = -271733879 ;&HEFCDAB89
MD5_c = -1732584194 ;&H98BADCFE
MD5_d = 271733878 ;&H10325476

;Loop through the words
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
;Round 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
;Round 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
;Round 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
;Round 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

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

Function MD5_F(x, y, z)
Return (x And y) Or (~(x) And z)
End Function

Function MD5_G(x, y, z)
Return (x And z) Or (y And (~(z)))
End Function

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

Function MD5_I(x, y, z)
Return (y Xor (x Or (~(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 (lValue Shl iShiftBits) Or (lValue Shr (32 - iShiftBits))
End Function

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



Function BlitzGet (webFile$, saveDir$, saveFile$)

    ; -------------------------------------------------------------------------
    ; Strip "http://" if provided
    ; -------------------------------------------------------------------------
    If Left (webFile$, 7) = "http://" Then webFile$ = Right (webFile$, Len (webFile$) - 7)

    ; -------------------------------------------------------------------------
    ; Split into hostname and path/filename to download
    ; -------------------------------------------------------------------------
    slash = Instr (webFile$, "/")
    If slash
        webHost$ = Left (webFile$, slash - 1)
        webFile$ = Right (webFile$, Len (webFile$) - slash + 1)
    Else
        webHost$ = webFile$
        webFile$ = "/"
    EndIf
        
    ; -------------------------------------------------------------------------
    ; Add trailing slash to download dir if not given
    ; -------------------------------------------------------------------------
    If Right (saveDir$, 1) <> "\" Then saveDir$ = saveDir$ + "\"

    ; -------------------------------------------------------------------------
    ; Save filename -- get from webFile$ if not provided
    ; -------------------------------------------------------------------------
    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

    ; DEBUG
    ; RuntimeError "Web host: " + webHost$ + Chr (10) + "Web file: " + webFile$ + Chr (10) + "Save dir: " + saveDir$ + Chr (10) + "Save file: " + saveFile$

    www = OpenTCPStream (webHost$, 80)

    If www
    
        WriteLine www, "GET " + webFile$ + " HTTP/1.1" ; GET / gets default page...
        WriteLine www, "Host: " + webHost$
        WriteLine www, "User-Agent: BlitzGet Deluxe"
        WriteLine www, "Accept: */*"
        WriteLine www, ""
        
        ; ---------------------------------------------------------------------
        ; Find blank line after header data, where the action begins...
        ; ---------------------------------------------------------------------
                
        Repeat

            Cls
            
            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

            ;DisplayResponse ()

            Flip
            
        Until header$ = "" Or (Eof (www))
                
        If bytesToRead = 0 Then Goto skipDownLoad
        
        ; ---------------------------------------------------------------------
        ; Create new file to write downloaded bytes into
        ; ---------------------------------------------------------------------
        save = WriteFile (saveDir$ + saveFile$)
        If Not save Then Goto skipDownload

        ; ---------------------------------------------------------------------
        ; Incredibly complex download-to-file routine...
        ; ---------------------------------------------------------------------

        For readWebFile = 1 To bytesToRead
        
            If Not Eof (www) Then WriteByte save, ReadByte (www)
            
            ; Call BytesReceived with position and size every 100 bytes (slows down a LOT with smaller updates)
            
            tReadWebFile = readWebFile
            ;If tReadWebFile Mod 100 = 0 Then BytesReceived (readWebFile, bytesToRead)

        Next

        CloseFile save
        
        ; Fully downloaded?
        If (readWebFile - 1) = bytesToRead
            success = 1
        EndIf
        
        ; Final update (so it's not rounded to nearest 100 bytes!)
        ;BytesReceived (bytesToRead, bytesToRead)
        
        .skipDownload
        CloseTCPStream www
        
    Else
    
        ;RuntimeError "Failed to connect"
        
    EndIf
    
    Return success
    
End Function

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

(Offline)
 
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо Nerd за это полезное сообщение:
Arton (29.01.2014), impersonalis (29.01.2014), Randomize (29.01.2014)
Старый 29.01.2014, 00:52   #12
moka
.
 
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений
(для 6,863 пользователей)
Ответ: Воровской тред

Это на node.js пишется в менее 100 строк... Зачем же мучаться и производить столько говнокода, на том что для этого не предназначено?
(Offline)
 
Ответить с цитированием
Старый 29.01.2014, 01:14   #13
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Ответ: Воровской тред

Сообщение от moka Посмотреть сообщение
Это на node.js пишется в менее 100 строк... Зачем же мучаться и производить столько говнокода, на том что для этого не предназначено?
Это раздел по Blitz3D. Но ты упорно продолжаешь проповедовать ноду. Может не надо?
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti
(Offline)
 
Ответить с цитированием
Эти 4 пользователя(ей) сказали Спасибо Randomize за это полезное сообщение:
Кирпи4 (30.01.2014), impersonalis (29.01.2014), L.D.M.T. (29.01.2014), St_AnGer (29.01.2014)
Старый 29.01.2014, 01:19   #14
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Ответ: Воровской тред

Вот это жесть - прям на конкурс "самое неожиданное использование Блитца": занятно посмотреть на алгоритм "в лоб" без пелены "нескольких строк node.js", хоть и использование на практике нерационально.
Кстати действительно: за последние сутки уже поругали юмор за не серьёзные ролики, тему про политику за политоту,теперь ещё и угарный тред по б3д ругают за б3д и угорелость
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Эти 6 пользователя(ей) сказали Спасибо impersonalis за это полезное сообщение:
ARA (29.01.2014), FireOwl (30.01.2014), L.D.M.T. (29.01.2014), Randomize (29.01.2014), St_AnGer (29.01.2014), tormoz (29.01.2014)
Старый 29.01.2014, 02:06   #15
den
Дэвелопер
 
Аватар для den
 
Регистрация: 13.02.2010
Сообщений: 1,645
Написано 620 полезных сообщений
(для 2,419 пользователей)
Ответ: Воровской тред

Сообщение от moka Посмотреть сообщение
Это на node.js пишется в менее 100 строк... Зачем же мучаться и производить столько говнокода, на том что для этого не предназначено?
Это займет 100 строк на любом языке, при использовании необходимой библиотеки. Хватит уже ноду форсить.
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 12:04.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com