Показать сообщение отдельно
Старый 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)