Google Image Search - Selective Download

July 20, 2020 at 08:21:42
Specs: Windows 7, 2.2/ 4gb
Help! When Google Image Search returns its results the thumbnails do not have a checkbox (tickbox) overlaid on them. Does anyone know how to achieve that? Is there a setting somewhere? Alternatively, is there any third party software whose image search results is based on the Google image Search results but DOES overlay a checkbox on the thumbnails. As it stands, you can download a single image or a bulk download of all the images one way or another, but not a "selective" bulk download, say 20 or so. Of course you can download the twenty, but you have to go through the motions of laboriously downloading each image separately.

The current settings do not cover what I am looking for so let me explain. When I search for fishing vessels I have to examine each image to establish the registration mark carried by each vessel so that I can download only images of vessels registered at a particular port.

Thank you for any suggestions.


See More: Google Image Search - Selective Download


#1
July 20, 2020 at 16:40:32
This a vbscript to download all images and not selective one :
Search_Img_Google_Download.vbs

Option Explicit
Dim Title,QueryString,WS,URL,WinHttp,LogFile,All_Img_Links,Img_Link,I,DEST,FileName
Title = "Download Images from Google Search by Hackoo 2020"
QueryString = Trim(InputBox("What do you want me to search ?",Title,"fishing vessels"))
If QueryString = "" Then Wscript.Quit()
Set WS = CreateObject("WScript.Shell")
QueryString = Replace(QueryString," ","+")
URL = "https://www.google.com/search?tbm=isch&q=" & QueryString
DEST = ".\Images_Downloaded\" & QueryString
Call SmartCreateFolder(DEST) 
Set WinHttp = CreateObject("Microsoft.XMLHTTP")
LogFile = ".\All_Img_Links_"& QueryString &".txt"
WinHttp.Open "GET", URL, False
WinHttp.send()

All_Img_Links = Extracting_Images(WinHttp.responseText,_
"(https|http):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&/~\+#]*[\w\-\@?^=%&/~\+#])(.png|.jpg|.gif|.jpeg)")

For each Img_Link in All_Img_Links
	FileName = GetFileName(Img_Link)
	I = I & Img_Link & vbCrlf
	Call Download(Img_Link,DEST + "\" + FileName)
Next

Call WriteLog(I,LogFile)
WS.Popup "The Download of images files is completed !",3,Title,vbInformation
Call Explorer(DEST)
'-------------------------------------------------------------------------
Sub Download(URL,Save2File)
	Dim File,Line,BS,ws
	On Error Resume Next
	Set ws = CreateObject("wscript.Shell")
	Set File = CreateObject("WinHttp.WinHttpRequest.5.1")
	File.Open "GET",URL, False
	File.Send()
	If err.number <> 0 then
		Line  = Line &  vbcrlf & "Error Getting File"
		Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf &_
		err.description
		Line  = Line &  vbcrlf & "Source " & err.source
		ws.Popup Get_Date_Time & vbcrlf & Line,3," Error getting file" &" "& Get_Date_Time,vbCritical
		Err.clear
	End If
	If File.Status = 200 Then ' File exists and it is ready to be downloaded
		Set BS = CreateObject("ADODB.Stream")
		BS.type = 1
		BS.open
		BS.Write File.ResponseBody
		BS.SaveToFile Save2File, 2
	ElseIf File.Status = 404 Then
		ws.Popup Get_Date_Time & vbcrlf & "File Not found : " & File.Status,3,"Error File Not Found",vbCritical
	Else
		ws.Popup Get_Date_Time & vbcrlf & "Unknown Error : " & File.Status,3, Get_Date_Time & " Error getting file",vbCritical
	End If
End Sub
'-------------------------------------------------------------------------
Sub WriteLog(strText,LogFile)
	Dim fs,ts
	Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(LogFile,ForWriting,True)
	ts.WriteLine strText
	ts.Close
End Sub
'-------------------------------------------------------------------------
Function Extracting_Images(URL,Pattern)
	Dim regEx, Match, Matches, Array_Images,dico,K
	Set regEx = New RegExp
	regEx.Pattern = Pattern
	regEx.IgnoreCase = True
	regEx.Global = True
	Set Matches = regEx.Execute(URL)
	Array_Images = Array()
	Set dico = CreateObject("Scripting.Dictionary")
	For Each Match in Matches
		If Not dico.Exists(Match.Value) Then
			dico.Add Match.Value,Match.Value
		End If
	Next
	For each K in dico.Keys()
		ReDim Preserve Array_Images(UBound(Array_Images) + 1)
		Array_Images(UBound(Array_Images)) = K
	Next
	Extracting_Images = Array_Images
End Function
'---------------------------------------------------------------------------
Function GetFileName(URL)
	Dim ArrFile,FileName
	ArrFile = Split(URL,"/")
	FileName = ArrFile(UBound(ArrFile))
	GetFileName = FileName
End Function
'---------------------------------------------------------------------------
Sub SmartCreateFolder(strFolder)
	With CreateObject("Scripting.FileSystemObject")
		If Not .FolderExists(strFolder) then
			SmartCreateFolder(.getparentfoldername(strFolder))
			.CreateFolder(strFolder)
		End If
	End With 
End Sub
'---------------------------------------------------------------------------
Function Get_Date_Time()
	Get_Date_Time = LPad(Day(Now),2,"0") & "/" & LPad(Month(Now),2,"0") & "/" & Year(Now) &_
	vbTab & LPad(Hour(Now),2,"0") & ":" & LPad(Minute(Now),2,"0")  & ":" & LPad(Second(Now),2,"0")
End Function
'---------------------------------------------------------------------------
Function LPad(s, l, c)
	Dim n : n = 0
	If l > Len(s) Then n = l - Len(s)
	LPad = String(n, c) & s
End Function
'----------------------------------------------------------------------------
Sub Explorer(sObj)
	Dim ws
	Set ws=CreateObject("wscript.shell")
	ws.run "Explorer "& sObj & "\",1,False
End Sub
'----------------------------------------------------------------------------

message edited by Hackoo


Reply ↓  Report •

#2
July 22, 2020 at 12:43:05
Hi Hackoo, thank you for your quick response. However, when I ran the script it completed almost immediately and there was nothing in the destination folder or the log. Actually, when I need to download the lot I find it easiest to save the results as a Complete Web Page and all the images appear in the folder accompanying the html file.

Reply ↓  Report •

#3
July 22, 2020 at 16:03:12
Did you test it on windows 7 ?
Try this vbscript with a little modification instead !
I have downloaded 81 images in a folder named Images_Downloaded\fishing+vessels

Option Explicit
Dim Title,QueryString,WS,URL,WinHttp,LogFile,All_Img_Links,Img_Link,I,DEST,FileName
Title = "Download Images from Google Search by Hackoo 2020"
QueryString = Trim(InputBox("What do you want me to search ?",Title,"fishing vessels"))
If QueryString = "" Then Wscript.Quit()
Set WS = CreateObject("WScript.Shell")
QueryString = Replace(QueryString," ","+")
URL = "https://www.google.com/search?tbm=isch&q=" & QueryString
DEST = ".\Images_Downloaded\" & QueryString
Call SmartCreateFolder(DEST) 
Set WinHttp = CreateObject("Microsoft.XMLHTTP")
LogFile = ".\All_Img_Links_"& QueryString &".txt"
WinHttp.Open "GET", URL, False
WinHttp.send()

All_Img_Links = Extracting_Images(WinHttp.responseText,_
"(https|http):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&/~\+#]*[\w\-\@?^=%&/~\+#])(.png|.jpg|.gif|.jpeg)")

For each Img_Link in All_Img_Links
	FileName = GetFileName(Img_Link)
	I = I & Img_Link & vbCrlf
	Call Download(Img_Link,DEST + "\" + FileName)
Next

Call WriteLog(I,LogFile)
WS.Popup "The Download of images files is completed !",3,Title,vbInformation
Call Explorer(DEST)
'-------------------------------------------------------------------------
Sub Download(URL,Save2File)
	Dim File,Line,BS,ws
	On Error Resume Next
	Set ws = CreateObject("wscript.Shell")
	Set File = CreateObject("Microsoft.XMLHTTP")
	File.Open "GET",URL, False
	File.Send()
	If err.number <> 0 then
		Line  = Line &  vbcrlf & "Error Getting File"
		Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf &_
		err.description
		Line  = Line &  vbcrlf & "Source " & err.source
		ws.Popup Get_Date_Time & vbcrlf & Line,3," Error getting file" &" "& Get_Date_Time,vbCritical
		Err.clear
	End If
	If File.Status = 200 Then ' File exists and it is ready to be downloaded
		Set BS = CreateObject("ADODB.Stream")
		BS.type = 1
		BS.open
		BS.Write File.ResponseBody
		BS.SaveToFile Save2File, 2
	ElseIf File.Status = 404 Then
		ws.Popup Get_Date_Time & vbcrlf & "File Not found : " & File.Status,3,"Error File Not Found",vbCritical
	Else
		ws.Popup Get_Date_Time & vbcrlf & "Unknown Error : " & File.Status,3, Get_Date_Time & " Error getting file",vbCritical
	End If
End Sub
'-------------------------------------------------------------------------
Sub WriteLog(strText,LogFile)
	Dim fs,ts
	Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(LogFile,ForWriting,True)
	ts.WriteLine strText
	ts.Close
End Sub
'-------------------------------------------------------------------------
Function Extracting_Images(URL,Pattern)
	Dim regEx, Match, Matches, Array_Images,dico,K
	Set regEx = New RegExp
	regEx.Pattern = Pattern
	regEx.IgnoreCase = True
	regEx.Global = True
	Set Matches = regEx.Execute(URL)
	Array_Images = Array()
	Set dico = CreateObject("Scripting.Dictionary")
	For Each Match in Matches
		If Not dico.Exists(Match.Value) Then
			dico.Add Match.Value,Match.Value
		End If
	Next
	For each K in dico.Keys()
		ReDim Preserve Array_Images(UBound(Array_Images) + 1)
		Array_Images(UBound(Array_Images)) = K
	Next
	Extracting_Images = Array_Images
End Function
'---------------------------------------------------------------------------
Function GetFileName(URL)
	Dim ArrFile,FileName
	ArrFile = Split(URL,"/")
	FileName = ArrFile(UBound(ArrFile))
	GetFileName = FileName
End Function
'---------------------------------------------------------------------------
Sub SmartCreateFolder(strFolder)
	With CreateObject("Scripting.FileSystemObject")
		If Not .FolderExists(strFolder) then
			SmartCreateFolder(.getparentfoldername(strFolder))
			.CreateFolder(strFolder)
		End If
	End With 
End Sub
'---------------------------------------------------------------------------
Function Get_Date_Time()
	Get_Date_Time = LPad(Day(Now),2,"0") & "/" & LPad(Month(Now),2,"0") & "/" & Year(Now) &_
	vbTab & LPad(Hour(Now),2,"0") & ":" & LPad(Minute(Now),2,"0")  & ":" & LPad(Second(Now),2,"0")
End Function
'---------------------------------------------------------------------------
Function LPad(s, l, c)
	Dim n : n = 0
	If l > Len(s) Then n = l - Len(s)
	LPad = String(n, c) & s
End Function
'----------------------------------------------------------------------------
Sub Explorer(sObj)
	Dim ws
	Set ws=CreateObject("wscript.shell")
	ws.run "Explorer "& sObj & "\",1,False
End Sub
'----------------------------------------------------------------------------


Reply ↓  Report •

Related Solutions

#4
July 24, 2020 at 03:24:59
Here is another code but in HTA = HTML Application
You should copy and paste the code in your Notepad or Notepad++ as Google Image Search.hta

Reply ↓  Report •

#5
July 24, 2020 at 08:34:39
Hi Hackoo, finally got the script to run! I think it must have been a cut and paste error I made. I have to say the hta version is very impressive and shows the depth of your knowledge. It gave 88 results. What function does the part headed "Raw Paste Data" serve as that seems to have already been listed?

However, I'm still left with the unsolved problem of a bulk selective download. Pity that Google doesn't overlay a checkbox on each image so you can tick the images you want to download and ignore the others. I've hunted around hoping I might find perhaps even a greasemonkey script to do just that but no luck so far.


Reply ↓  Report •

#6
July 24, 2020 at 16:53:08
@ColDon

Please Check my new HTA Version , i updated it and you can select now with a checkbox to download what image(s) did you want !

Google Image Search.hta


Reply ↓  Report •

#7
July 25, 2020 at 04:08:14
Hackoo, this just gets better and better! The only downside, and that is not strictly correct because this is better than anything else I've come across, is that I notice the downloaded image is smaller than the original google one. Is it possible to get the full size image? As you have probably noticed it can be difficult to make out the vessel registration number, so I have to fall back on checking for it in the original google full size image if your search results throws up an image I find relevant.

Reply ↓  Report •

#8
July 26, 2020 at 16:43:08
@ColDon

Give a try for this selective version, and i will post any update here in pastebin link
Google Image Search.hta

message edited by Hackoo


Reply ↓  Report •

#9
July 27, 2020 at 07:39:38
Your latest version is the "bees knees" ,Hackoo, the "bees knees". Apart from the odd instance where the full image might not have been accessible, this version seems to do the business. If you input "steam drifters" as the search term you will see a marked improvement in the legibility of the registration numbers on the vessels in the downloaded image.

One thing though, being curious, as Duckduckgo doesn't give the same images as Google, I tried to see if it would deliver Duckduckgo images but without success.(I just used the Duckduckgo images url from the browser). It threw up an "Acess Denied" error at what would be line 91 - 5 of your script [ winHttp.send() ]. Excuse my ignorance but why would it not work with DuckDuckGo? The output style of both is broadly similar and can be saved as a complete html file.

message edited by ColDon


Reply ↓  Report •

#10
July 28, 2020 at 03:51:59
Hi, Hackoo, this is not a criticism but arises from curiosity, but I also meant to ask if you have deliberately limited the number of images that can be shown? I notice that doing a "steam drifters" Google Image search via browser produces hundreds of images while your script generally nets just below a hundred.

Reply ↓  Report •

Ask Question