hackoo

Bing_Image_Search.hta

Sep 9th, 2020
734
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. <html>
  2.  <head>
  3.  <title>Bing Image Search by Hackoo 2020</title>
  4.  <HTA:APPLICATION
  5.  Application ID = "BingImageSearch"
  6.  APPLICATIONNAME = "Bing Image Search"
  7.  BORDER = "Dialog"
  8.  BORDERSTYLE = "Normal"
  9.  CAPTION = "Yes"
  10.  CONTEXTMENU = "Yes"
  11.  ICON = "nslookup.exe"
  12.  INNERBORDER = "Yes"
  13.  MAXIMIZEBUTTON = "Yes"
  14.  MINIMIZEBUTTON = "Yes"
  15.  NAVIGABLE = "No"
  16.  SCROLL = "Auto"
  17.  SCROLLFLAT = "No"
  18.  SELECTION = "No"
  19.  SHOWINTASKBAR = "Yes"
  20.  SINGLEINSTANCE = "Yes"
  21.  SYSMENU = "Yes"
  22.  WINDOWSTATE = "Maximize"
  23.  />
  24.  </head>
  25.  <style type="text/css">
  26.   body {
  27.         font-family:Verdana;
  28.         font-size: 12px;
  29.         color: #49403B;
  30.         background: LightBlue;
  31.         }
  32.  
  33.     button {
  34.         font-family:Verdana;
  35.         font-size: 14px;
  36.         filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr=#FF0000, EndColorStr=#ffffff);
  37.         height: 30px;
  38.         width: 215px;
  39.         font-weight: bold;
  40.         }
  41.        
  42.     div {
  43.         text-align: center;
  44.         }
  45.     a:link {color: #F19105;}
  46.     a:visited {color: #F19105;}
  47.     a:active {color: #F19105;}
  48.     a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}
  49.  </style>
  50.  <script Language="VBScript">
  51.  Option Explicit
  52.  '-------------------------------------------------------------------------
  53. Sub Window_OnLoad()
  54.  Dim strSearch,DEST,Title
  55.  Title = "Bing Image Search by Hackoo 2020"
  56.  Call Shortcut()
  57.  'strSearch = Trim(txtSearch.value)
  58. 'DEST = ".\Images_Downloaded\" & strSearch
  59. End Sub
  60.  '-------------------------------------------------------------------------
  61. Sub Start()
  62.     Dim strInput  :  strInput = Trim(txtSearch.value)
  63.     Dim P
  64.     If strInput = "" Then
  65.         DataArea.InnerHTML = "Nothing to do."
  66.         Exit Sub ' exit sub if no keyword is specified
  67.     Else
  68.         DataArea.InnerHTML = ""
  69.         Call Search(1)
  70.     End If
  71. End Sub
  72.  '-------------------------------------------------------------------------
  73. Sub Search(P)
  74. Dim strHTML, intCount
  75.     Dim Title,strSearch,WS,URL,WinHttp,LogFile,All_Img_Links,Img_Link,I,DEST,FileName,strText,ALT,Page
  76.     Title = "Bing Image Search by Hackoo 2020"
  77.     ALT = "Click on this image to open it with your default browser"
  78.     intCount = 0
  79.     DataArea.InnerHTML = ""
  80.     strHTML = Get_Date_Time & "<br> Results : [[COUNT] Image(s) Found] - page "&P&"<hr>"
  81.     strHTML = strHTML & "<button type=""button"" id=""CheckAll"" name=""CheckAll"" value=""Check All"" onClick='SelectAll()'>Check All</button>"
  82.     strHTML = strHTML & "<button type=""button"" id=""UnCheckAll"" name=""UnCheckAll"" value=""Uncheck All"" onClick=""UnSelectAll()"">Uncheck All</button>"
  83.     strHTML = strHTML & "<button type=""button"" id=""btn_GetCheckBoxes"" OnClick='GetCheckBoxes_onClick'>Download Checked boxes</button><hr>"
  84.     For I=1 To 70
  85.         Page = Page & "<a href=""#"" id=""Page"" onClick=""Search("&I&")"">"&I&"</a>&nbsp"
  86.     Next
  87.     strHTML = strHTML & Page & "<hr>"
  88.     strSearch = Trim(txtSearch.value)
  89.     'MsgBox strSearch
  90.     If strSearch = "" Then Exit Sub
  91.     Set WS = CreateObject("WScript.Shell")
  92.     strSearch = Replace(strSearch," ","+")
  93.     'https://www.google.com/search?tbm=isch&q=
  94.     URL = "https://www.bing.com/images/search?q=" & strSearch & "&first= "& P & "&scenario=ImageBasicHover"
  95.     'MsgBox "Page = " &P,vbInformation,Title
  96.     DEST = ".\Images_Downloaded\" & strSearch
  97.     Call SmartCreateFolder(DEST)
  98.     Set WinHttp = CreateObject("Microsoft.XMLHTTP")
  99.     LogFile = DEST &"\"& strSearch &".txt"
  100.     WinHttp.Open "GET", URL, False
  101.     On Error Resume Next
  102.     WinHttp.send()
  103.     If err.number <> 0 Then
  104.         DataArea.InnerHTML = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
  105.         "<strong>CHECK YOUR INTERNET CONNECTION  : " & Err.Description & "<strong></Marquee>"
  106.         MsgBox Err.Description & vbCrLf & Err.Source,vbCritical,Title
  107.         txtSearch.select
  108.         document.getElementById("runbutton").disabled = False
  109.         Exit Sub
  110.     End If
  111.     All_Img_Links = Extracting_Images(WinHttp.responseText,_
  112.     "(https|http):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&/~\+#]*[\w\-\@?^=%&/~\+#])(\.jpg|\.gif|\.jpeg|\.png|\.tiff|\.bmp)")
  113.    
  114.     For each Img_Link in All_Img_Links
  115.         intCount = intCount + 1
  116.         strText = strText & Img_Link & vbCrLf
  117.         strHTML = strHTML & "<tr><a href=""#"" OnClick=""Open_Default_Browser('"& Img_Link &"')""><img src="& Img_Link & " height=120 width=180 alt='"& ALT &"'></a>"
  118.         strHTML = strHTML & "<td>.<input type=""checkbox"" ID=""cbx"" name=""cbx"" Value='"& Img_Link &"'></td></tr>"
  119.     Next
  120.    
  121.     strHTML = Replace(strHTML, "[COUNT]", intCount)
  122.     DataArea.InnerHTML = strHTML
  123.     'Call WriteLog(strText,LogFile,2)
  124.     'document.getElementById("txtSearch").disabled = False
  125.     'txtSearch.select
  126. End Sub
  127. '-------------------------------------------------------------------------
  128. Sub StartOnEnter()
  129.     If window.event.keyCode = 13 Then ' if the Enter key is pressed, then call the Start sub
  130.         document.getElementById("runbutton").disabled = True
  131.         Start
  132.         document.getElementById("runbutton").disabled = False
  133.     End If
  134. End Sub
  135. '-------------------------------------------------------------------------
  136. Sub WriteLog(strText,LogFile,Mode)
  137.     Dim fs,ts
  138.     'Const ForWriting = 2
  139.     Set fs = CreateObject("Scripting.FileSystemObject")
  140.     Set ts = fs.OpenTextFile(LogFile,Mode,True)
  141.     ts.WriteLine strText
  142.     ts.Close
  143. End Sub
  144. '-------------------------------------------------------------------------
  145. Function Extracting_Images(URL,Pattern)
  146.     Dim regEx, Match, Matches, Array_Images,dico,K
  147.     Set regEx = New RegExp
  148.     regEx.Pattern = Pattern
  149.     regEx.IgnoreCase = True
  150.     regEx.Global = True
  151.     Set Matches = regEx.Execute(URL)
  152.     Array_Images = Array()
  153.     Set dico = CreateObject("Scripting.Dictionary")
  154.     For Each Match in Matches
  155.         If Not dico.Exists(Match.Value)          And _
  156.             Not InStr(Match.Value,"gstatic") > 0 And _
  157.             Not InStr(Match.Value,"winudf")  > 0 And _
  158.             Not InStr(Match.Value,"testfamilysafety")  > 0 Then
  159.             dico.Add Match.Value,Match.Value
  160.         End If
  161.     Next
  162.     For each K in dico.Keys()
  163.         ReDim Preserve Array_Images(UBound(Array_Images) + 1)
  164.         Array_Images(UBound(Array_Images)) = K
  165.     Next
  166.     Extracting_Images = Array_Images
  167. End Function
  168. '---------------------------------------------------------------------------
  169. Function GetFileName(URL)
  170.     Dim ArrFile,FileName
  171.     ArrFile = Split(URL,"/")
  172.     FileName = ArrFile(UBound(ArrFile))
  173.     GetFileName = FileName
  174. End Function
  175. '---------------------------------------------------------------------------
  176. Function Get_Date_Time()
  177.     Get_Date_Time = LPad(Day(Now),2,"0") & "/" & LPad(Month(Now),2,"0") & "/" & Year(Now) &_
  178.     vbTab & vbTab & LPad(Hour(Now),2,"0") & ":" & LPad(Minute(Now),2,"0")  & ":" & LPad(Second(Now),2,"0")
  179. End Function
  180. '---------------------------------------------------------------------------
  181. Function LPad(s, l, c)
  182.     Dim n : n = 0
  183.     If l > Len(s) Then n = l - Len(s)
  184.     LPad = String(n, c) & s
  185. End Function
  186. '----------------------------------------------------------------------------
  187. Sub Open_Default_Browser(sObj)
  188.     Dim ws
  189.     Set ws=CreateObject("wscript.shell")
  190.     ws.run sObj,1,False
  191. End Sub
  192. '----------------------------------------------------------------------------
  193. Sub SmartCreateFolder(strFolder)
  194.     With CreateObject("Scripting.FileSystemObject")
  195.         If Not .FolderExists(strFolder) then
  196.             SmartCreateFolder(.getparentfoldername(strFolder))
  197.             .CreateFolder(strFolder)
  198.         End If
  199.     End With
  200. End Sub
  201. '----------------------------------------------------------------------------
  202. Sub GetCheckBoxes_onClick()
  203.     Dim colInputs,objInput,strSearch,DEST,FileName,Title,Question
  204.     Title = "Bing Image Search by Hackoo 2020"
  205.     document.getElementById("txtSearch").disabled = True
  206.     document.getElementById("btn_GetCheckBoxes").disabled = True
  207.     document.getElementById("runbutton").disabled = True
  208.     strSearch = Trim(txtSearch.value)
  209.     strSearch = Replace(strSearch," ","+")
  210.     DEST = ".\Images_Downloaded\" & strSearch
  211.     Call SmartCreateFolder(DEST)
  212.     If Check_Checked_Boxes = True Then
  213.         Question = MsgBox("Did you want to download all checked images ?",vbQuestion+vbYesNo,Title)
  214.         If Question = vbYes Then
  215.             document.getElementById("cbx").disabled = False
  216.             document.getElementById("btn_GetCheckBoxes").disabled = False
  217.             document.getElementById("runbutton").disabled = False
  218.             document.getElementById("txtSearch").disabled = False
  219. 'Get all input elements in the document
  220.             Set colInputs = document.getElementsByName("cbx")
  221. 'loop through the input tags
  222.             For Each objInput In colInputs
  223. 'See if the input is a checkbox (vs a textbox, etc.)
  224.                 If objInput.Type = "checkbox" Then
  225. 'Verify its checked and show its value
  226.                     If objInput.Checked = True Then
  227.                         document.getElementById("btn_GetCheckBoxes").disabled = True
  228.                         document.getElementById("runbutton").disabled = True
  229.                         document.getElementById("txtSearch").disabled = True
  230.                         document.getElementById("UnCheckAll").disabled = True
  231.                         FileName = GetFileName(objInput.Value)
  232. 'MsgBox DEST + "\" + FileName
  233.                         Call Download(objInput.Value,DEST + "\" + FileName)
  234.                     End If
  235.                 End If
  236.             Next
  237.             'document.getElementById("CheckAll").disabled = False
  238.             UnSelectAll()
  239.             Question = MsgBox("The Download of images files is completed !" & vbCrLf &_
  240.             "Did you want to explore downloaded folder to check it ?" ,_
  241.             vbQuestion+vbYesNo,Title)
  242.             If Question = vbYes Then
  243.                 document.body.style.cursor = "default"
  244.                 UnSelectAll()
  245.                 Call Explorer(DEST)
  246.             Else
  247.                 document.body.style.cursor = "default"
  248.                 UnSelectAll()
  249.                 txtSearch.Select
  250.                 Exit Sub
  251.             End If
  252.         Else
  253.             UnSelectAll()
  254.             txtSearch.Select
  255.             Exit Sub
  256.         End If
  257.     Else
  258.         MsgBox "No Images were selected for the download, please check before downloading any images !",vbExclamation,Title
  259.         UnSelectAll()
  260.         txtSearch.Select
  261.         Exit Sub
  262.     End If
  263. End Sub
  264. '----------------------------------------------------------------------------
  265. sub Download(URL,Save2File)
  266.     Dim File,Line,BS,ws,ErrorFile,DEST,strSearch
  267.     strSearch = Trim(txtSearch.value)
  268.     strSearch = Replace(strSearch," ","+")
  269.     document.body.style.cursor = "wait"
  270.     DEST = ".\Images_Downloaded\" & strSearch
  271.     Call SmartCreateFolder(DEST)
  272.     ErrorFile = DEST &"\"& strSearch &"_Error.txt"
  273.     On Error Resume Next
  274.     Set ws = CreateObject("wscript.Shell")
  275.     Set File = CreateObject("Microsoft.XMLHTTP")
  276.     File.Open "GET",URL, False
  277.     File.Send()
  278.     If Err.Number = 0 And File.Status = 200 Then ' File exists and it is ready to be downloaded
  279.         Set BS = CreateObject("ADODB.Stream")
  280.         BS.type = 1
  281.         BS.open
  282.         BS.Write File.ResponseBody
  283.         BS.SaveToFile Save2File, 2
  284.     Else
  285.         Line  = Line &  vbcrlf & "Error Getting File " & vbTab & "File Status = "& File.Status & vbcrlf &_
  286.         "FileName : "& GetFileName(URL) &  vbcrlf & "URL :" & URL
  287.         Line  = Line &  vbcrlf & "Error Number : " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf & "Error Description : "& err.description
  288.         Line  = Line &  vbcrlf & "Source " & err.Source & vbcrlf & String(100,"-")
  289.         Line  = Get_Date_Time & vbcrlf & Line
  290.         Call WriteLog(Line,ErrorFile,8)
  291.     End If
  292. End Sub
  293. '-------------------------------------------------------------------------
  294. Sub SelectAll()
  295.     Dim checkbox,cbx
  296.     Set cbx = document.getElementsByName("cbx")
  297.     'document.body.style.cursor = "wait"
  298.     document.getElementById("runbutton").disabled = True
  299.     document.getElementById("CheckAll").disabled = True
  300.     document.getElementById("txtSearch").disabled = True
  301.     For Each checkbox In cbx
  302.         checkbox.Checked = True
  303.     Next
  304. End Sub
  305. '-------------------------------------------------------------------------
  306. Sub UnSelectAll()
  307.     Dim checkbox,cbx
  308.     Set cbx = document.getElementsByName("cbx")
  309.     document.body.style.cursor = "default"
  310.     document.getElementById("UnCheckAll").disabled = False
  311.     document.getElementById("runbutton").disabled = False
  312.     document.getElementById("CheckAll").disabled = False
  313.     document.getElementById("txtSearch").disabled = False
  314.     document.getElementById("btn_GetCheckBoxes").disabled = False
  315.     For Each checkbox In cbx
  316.         checkbox.Checked = False
  317.     Next
  318. End Sub
  319. '-------------------------------------------------------------------------
  320. Function Check_Checked_Boxes()
  321.     Dim CheckBox,cbx
  322.     Set cbx = document.getElementsByName("cbx")
  323.     For Each checkbox In cbx
  324.         If checkbox.Checked = True Then
  325.             Check_Checked_Boxes = True
  326.             Exit For
  327.         Else
  328.             Check_Checked_Boxes = False
  329.         End If
  330.     Next
  331. End Function
  332. '-------------------------------------------------------------------------
  333. Sub Explorer(sOBJ)
  334.     Dim ws
  335.     Set ws = CreateObject("wscript.shell")
  336.     ws.run "explorer " & sOBJ & "\"
  337. end Sub
  338. '-------------------------------------------------------------------------
  339. sub Shortcut()
  340. dim shell,DesktopPath,Link,CurrentFolder,FullName,arrFN,HTA_Name
  341. Set Shell = CreateObject("WScript.Shell")
  342. CurrentFolder = shell.CurrentDirectory
  343. DesktopPath = Shell.SpecialFolders("Desktop")
  344. FullName = replace(BingImageSearch.commandLine,chr(34),"")  
  345. arrFN=split(FullName,"\")  
  346. HTA_Name = arrFN(ubound(arrFN))
  347. Link = GetFilenameWithoutExtension(HTA_Name)
  348. Set link = Shell.CreateShortcut(DesktopPath & "\" & Link & ".lnk")
  349. link.Description = HTA_Name
  350. link.IconLocation = "nslookup.exe"
  351. link.TargetPath = CurrentFolder & "\" & HTA_Name
  352. link.WorkingDirectory = CurrentFolder
  353. Link.HotKey = "CTRL+ALT+B"
  354. link.Save
  355. end Sub
  356. '-------------------------------------------------------------------------
  357. Function GetFilenameWithoutExtension(FileName)
  358.     Dim Result, i
  359.     Result = FileName
  360.     i = InStrRev(FileName, ".")
  361.     If ( i > 0 ) Then
  362.         Result = Mid(FileName, 1, i - 1)
  363.     End If
  364.     GetFilenameWithoutExtension = Result
  365. End Function
  366. '-------------------------------------------------------------------------
  367. </script>
  368.  <body onKeyPress="StartOnEnter" STYLE="overflow:auto;font:arial; color:#000000; filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#FFFFFF', EndColorStr='#CCCCCC')">
  369.  <center><basefont SIZE="3">
  370.  Searching for :
  371.  <input type="text" size="40" ID="txtSearch" name="txtSearch" value="steam drifters">
  372.  <input id="runbutton" STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#0575F1', EndColorStr='#A4C8EF');font-weight: bold;" class="button" type="button" value="Bing Image Search" name="run_button"  onClick="Start">
  373.  <hr>
  374.  <span id="DataArea"></span>
  375.  </basefont>
  376.  </body>
  377.  </html>
RAW Paste Data