Code Pasta

Untitled

4 years ago in Plain Text

                            DATA HOSTED WITH ♥ BY PASTEBIN.COM - DOWNLOAD RAW - SEE ORIGINAL
<html>
 <head>
 <title>Google Image Search by Hackoo 2020</title>
 <HTA:APPLICATION
 Application ID = "GoogleImageSearch"
 APPLICATIONNAME = "Google Image Search"
 BORDER = "Dialog"
 BORDERSTYLE = "Normal"
 CAPTION = "Yes"
 CONTEXTMENU = "Yes"
 ICON = "nslookup.exe"
 INNERBORDER = "Yes"
 MAXIMIZEBUTTON = "Yes"
 MINIMIZEBUTTON = "Yes"
 NAVIGABLE = "No"
 SCROLL = "Auto"
 SCROLLFLAT = "No"
 SELECTION = "No"
 SHOWINTASKBAR = "Yes"
 SINGLEINSTANCE = "Yes"
 SYSMENU = "Yes"
 WINDOWSTATE = "Maximize"
 />
 </head>
 <style type="text/css">
  body {
        font-family:Verdana;
        font-size: 12px;
        color: #49403B;
        background: LightBlue;
        }
 
    button {
        font-family:Verdana;
        font-size: 14px;
        filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr=#FF0000, EndColorStr=#ffffff);
        height: 30px;
        width: 215px;
        font-weight: bold;
        }
       
    div {
        text-align: center;
        }
    a:link {color: #F19105;}
    a:visited {color: #F19105;}
    a:active {color: #F19105;}
    a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}
 </style>
 <script Language="VBScript">
 Option Explicit
 '-------------------------------------------------------------------------
Sub Window_OnLoad()
 Dim strSearch,DEST,Title
 Title = "Google Image Search by Hackoo 2020"
 Call Shortcut()
 'strSearch = Trim(txtSearch.value)
'DEST = ".\Images_Downloaded\" & strSearch
End Sub
 '-------------------------------------------------------------------------
Sub Start()
    Dim strInput  :  strInput = txtSearch.value
    If strInput = "" Then
        DataArea.InnerHTML = "Nothing to do."
        Exit Sub ' exit sub if no keyword is specified
    Else
        DataArea.InnerHTML = ""  
        Call Search
    End If
End Sub
 '-------------------------------------------------------------------------
Sub Search()
    Dim strHTML, intCount
    Dim Title,strSearch,WS,URL,WinHttp,LogFile,All_Img_Links,Img_Link,I,DEST,FileName,strText,ALT
    Title = "Google Image Search by Hackoo 2020"
    ALT = "Click on this image to open it with your default browser"
    intCount = 0
    DataArea.InnerHTML = ""
    strHTML = Get_Date_Time & "<br> Results [[COUNT] Image(s) Found] : <br>"
    strHTML = strHTML & "<button type=""button"" id=""CheckAll"" name=""CheckAll"" value=""Check All"" onClick='SelectAll()'>Check All</button>"
    strHTML = strHTML & "<button type=""button"" id=""UnCheckAll"" name=""UnCheckAll"" value=""Uncheck All"" onClick=""UnSelectAll()"">Uncheck All</button>"
    strHTML = strHTML & "<button type=""button"" id=""btn_GetCheckBoxes"" OnClick='GetCheckBoxes_onClick'>Download Checked boxes</button><hr>"
    strSearch = Trim(txtSearch.value)
    'MsgBox strSearch
    If strSearch = "" Then Exit Sub
    Set WS = CreateObject("WScript.Shell")
    strSearch = Replace(strSearch," ","+")
    URL = "https://www.google.com/search?tbm=isch&q=" & strSearch
    DEST = ".\Images_Downloaded\" & strSearch
    Call SmartCreateFolder(DEST)
    Set WinHttp = CreateObject("Microsoft.XMLHTTP")
    LogFile = DEST &"\"& strSearch &".txt"
    WinHttp.Open "GET", URL, False
    On Error Resume Next
    WinHttp.send()
    If err.number <> 0 Then
        DataArea.InnerHTML = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
        "<strong>CHECK YOUR INTERNET CONNECTION  : " & Err.Description & "<strong></Marquee>"
        MsgBox Err.Description & vbCrLf & Err.Source,vbCritical,Title
        txtSearch.select
        document.getElementById("runbutton").disabled = False
        Exit Sub
    End If
    All_Img_Links = Extracting_Images(WinHttp.responseText,_
    "(https|http):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&/~\+#]*[\w\-\@?^=%&/~\+#])(\.jpg|\.gif|\.jpeg|\.png|\.tiff|\.bmp)")
   
    For each Img_Link in All_Img_Links
        intCount = intCount + 1
        strText = strText & Img_Link & vbCrLf
        strHTML = strHTML & "<tr><a href=""#"" OnClick=""Open_Default_Browser('"& Img_Link &"')""><img src="& Img_Link & " height=120 width=180 alt='"& ALT &"'></a>"
        strHTML = strHTML & "<td>.<input type=""checkbox"" ID=""cbx"" name=""cbx"" Value='"& Img_Link &"'></td></tr>"
    Next
   
    strHTML = Replace(strHTML, "[COUNT]", intCount)
    DataArea.InnerHTML = strHTML
    Call WriteLog(strText,LogFile,2)
    'document.getElementById("txtSearch").disabled = False
    'txtSearch.select
End Sub
'-------------------------------------------------------------------------
Sub StartOnEnter()
    If window.event.keyCode = 13 Then ' if the Enter key is pressed, then call the Start sub
        document.getElementById("runbutton").disabled = True
        Start
        document.getElementById("runbutton").disabled = False
    End If
End Sub
'-------------------------------------------------------------------------
Sub WriteLog(strText,LogFile,Mode)
    Dim fs,ts
    'Const ForWriting = 2
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(LogFile,Mode,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) And Not InStr(Match.Value,"gstatic") > 0 And Not InStr(Match.Value,"google") > 0 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
'---------------------------------------------------------------------------
Function Get_Date_Time()
    Get_Date_Time = LPad(Day(Now),2,"0") & "/" & LPad(Month(Now),2,"0") & "/" & Year(Now) &_
    vbTab & 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 Open_Default_Browser(sObj)
    Dim ws
    Set ws=CreateObject("wscript.shell")
    ws.run sObj,1,False
End Sub
'----------------------------------------------------------------------------
Sub SmartCreateFolder(strFolder)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(strFolder) then
            SmartCreateFolder(.getparentfoldername(strFolder))
            .CreateFolder(strFolder)
        End If
    End With
End Sub
'----------------------------------------------------------------------------
Sub GetCheckBoxes_onClick()
    Dim colInputs,objInput,strSearch,DEST,FileName,Title,Question
    Title = "Google Image Search by Hackoo 2020"
    document.getElementById("txtSearch").disabled = True
    document.getElementById("btn_GetCheckBoxes").disabled = True
    document.getElementById("runbutton").disabled = True
    strSearch = Trim(txtSearch.value)
    strSearch = Replace(strSearch," ","+")
    DEST = ".\Images_Downloaded\" & strSearch
    Call SmartCreateFolder(DEST)
    If Check_Checked_Boxes = True Then
        Question = MsgBox("Did you want to download all checked images ?",vbQuestion+vbYesNo,Title)
        If Question = vbYes Then
            document.getElementById("cbx").disabled = False
            document.getElementById("btn_GetCheckBoxes").disabled = False
            document.getElementById("runbutton").disabled = False
            document.getElementById("txtSearch").disabled = False
'Get all input elements in the document
            Set colInputs = document.getElementsByName("cbx")
'loop through the input tags
            For Each objInput In colInputs
'See if the input is a checkbox (vs a textbox, etc.)
                If objInput.Type = "checkbox" Then
'Verify its checked and show its value
                    If objInput.Checked = True Then
                        document.getElementById("btn_GetCheckBoxes").disabled = True
                        document.getElementById("runbutton").disabled = True
                        document.getElementById("txtSearch").disabled = True
                        document.getElementById("UnCheckAll").disabled = True
                        FileName = GetFileName(objInput.Value)
'MsgBox DEST + "\" + FileName
                        Call Download(objInput.Value,DEST + "\" + FileName)
                    End If
                End If
            Next
            'document.getElementById("CheckAll").disabled = False
            UnSelectAll()
            Question = MsgBox("The Download of images files is completed !" & vbCrLf &_
            "Did you want to explore downloaded folder to check it ?" ,_
            vbQuestion+vbYesNo,Title)
            If Question = vbYes Then
                document.body.style.cursor = "default"
                UnSelectAll()
                Call Explorer(DEST)
            Else
                document.body.style.cursor = "default"
                UnSelectAll()
                txtSearch.Select
                Exit Sub
            End If
        Else
            UnSelectAll()
            txtSearch.Select
            Exit Sub
        End If
    Else
        MsgBox "No Images were selected for the download, please check before downloading any images !",vbExclamation,Title
        UnSelectAll()
        txtSearch.Select
        Exit Sub
    End If
End Sub
'----------------------------------------------------------------------------
sub Download(URL,Save2File)
    Dim File,Line,BS,ws,ErrorFile,DEST,strSearch
    strSearch = Trim(txtSearch.value)
    strSearch = Replace(strSearch," ","+")
    document.body.style.cursor = "wait"
    DEST = ".\Images_Downloaded\" & strSearch
    Call SmartCreateFolder(DEST)
    ErrorFile = DEST &"\"& strSearch &"_Error.txt"
    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 And 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
    Else
        Line  = Line &  vbcrlf & "Error Getting File " & vbTab & "File Status = "& File.Status & vbcrlf &_
        "FileName : "& GetFileName(URL) &  vbcrlf & "URL :" & URL
        Line  = Line &  vbcrlf & "Error Number : " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf & "Error Description : "& err.description
        Line  = Line &  vbcrlf & "Source " & err.Source & vbcrlf & String(100,"-")
        Line  = Get_Date_Time & vbcrlf & Line
        Call WriteLog(Line,ErrorFile,8)
    End If
End Sub
'-------------------------------------------------------------------------
Sub SelectAll()
    Dim checkbox,cbx
    Set cbx = document.getElementsByName("cbx")
    'document.body.style.cursor = "wait"
    document.getElementById("runbutton").disabled = True
    document.getElementById("CheckAll").disabled = True
    document.getElementById("txtSearch").disabled = True
    For Each checkbox In cbx
        checkbox.Checked = True
    Next
End Sub
'-------------------------------------------------------------------------
Sub UnSelectAll()
    Dim checkbox,cbx
    Set cbx = document.getElementsByName("cbx")
    document.body.style.cursor = "default"
    document.getElementById("UnCheckAll").disabled = False
    document.getElementById("runbutton").disabled = False
    document.getElementById("CheckAll").disabled = False
    document.getElementById("txtSearch").disabled = False
    document.getElementById("btn_GetCheckBoxes").disabled = False
    For Each checkbox In cbx
        checkbox.Checked = False
    Next
End Sub
'-------------------------------------------------------------------------
Function Check_Checked_Boxes()
    Dim CheckBox,cbx
    Set cbx = document.getElementsByName("cbx")
    For Each checkbox In cbx
        If checkbox.Checked = True Then
            Check_Checked_Boxes = True
            Exit For
        Else
            Check_Checked_Boxes = False
        End If
    Next
End Function
'-------------------------------------------------------------------------
Sub Explorer(sOBJ)
    Dim ws
    Set ws = CreateObject("wscript.shell")
    ws.run "explorer " & sOBJ & "\"
end Sub
'-------------------------------------------------------------------------
sub Shortcut()
dim shell,DesktopPath,Link,CurrentFolder,FullName,arrFN,HTA_Name
Set Shell = CreateObject("WScript.Shell")
CurrentFolder = shell.CurrentDirectory
DesktopPath = Shell.SpecialFolders("Desktop")
FullName = replace(GoogleImageSearch.commandLine,chr(34),"")  
arrFN=split(FullName,"\")  
HTA_Name = arrFN(ubound(arrFN))
Link = GetFilenameWithoutExtension(HTA_Name)
Set link = Shell.CreateShortcut(DesktopPath & "\" & Link & ".lnk")
link.Description = HTA_Name
link.IconLocation = "nslookup.exe"
link.TargetPath = CurrentFolder & "\" & HTA_Name
link.WorkingDirectory = CurrentFolder
Link.HotKey = "CTRL+ALT+I"
link.Save
end Sub
'-------------------------------------------------------------------------
Function GetFilenameWithoutExtension(FileName)
    Dim Result, i
    Result = FileName
    i = InStrRev(FileName, ".")
    If ( i > 0 ) Then
        Result = Mid(FileName, 1, i - 1)
    End If
    GetFilenameWithoutExtension = Result
End Function
'-------------------------------------------------------------------------
</script>
 <body onKeyPress="StartOnEnter" STYLE="overflow:auto;font:arial; color:#000000; filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#FFFFFF', EndColorStr='#CCCCCC')">
 <center><basefont SIZE="3">
 Searching for :
 <input type="text"  size="40" ID="txtSearch" name="txtSearch" value="FORTNITE">
 <input id="runbutton" STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#0575F1', EndColorStr='#A4C8EF');font-weight: bold;" class="button" type="button" value="Google Images Search" name="run_button"  onClick="Start">
 <hr>
 <span id="DataArea"></span>
 </basefont>
 </body>
 </html>

                        
Recent Public Pastes
6 videos of old men fucking young girls BEST COLLECTION - 1 day ago Amazing Collections - 3 days ago [v1.2.1.0] Farming Simulator 25 Trainer (2025) (Plus +8) - 5 days ago TradingView - 1 week ago Untitled - 1 week ago They Like Nature - 1 week ago Untitled - 2 weeks ago Untitled - 2 weeks ago VIDEOS NO SHORTLINK AT ALL FREEEEEEEEEEEEE - 2 weeks ago Sanyuuu - 2 weeks ago