Сегодня мы будем воровать пикчи из интернета.
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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;