Serial Hunter Buat Nyari Serial Number

Kamis, 29 September 2011

Ini lah sebuah mesin pencarian serial number sederhana lansung aja copy code dibawah ini

Screen Shot

<html>
<head>
<title>SerialHunter by Rajendra Khope</title>
<HTA:APPLICATION
APPLICATIONNAME="SerialHunter"
ID="SerialHunter"
VERSION="2.0"
BORDERSTYLE="complex"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
ICON="SerialHunter.ico"
SCROLL="auto"
SCROLLFLAT="yes"
SINGLEINSTANCE="yes"/>
<link rel="stylesheet" href="style.css" type="text/css" />
</head>
<script language="VBScript">
'Crack looker by Rajendra Khope
'The code is not optimized. Under process of optimization...

Dim count
Dim cmd
Dim errMsg
Dim SearchResult
Dim oXMLHTTP
Dim FinalResults
Dim StartTime

Sub clearIt()
    rsult.innerHtml=""
    Document.title="SerialHunter by Rajendra Khope"
End Sub

Sub InitAll()
Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
End Sub

Sub CleaIt()
    Set oXMLHTTP = Nothing
    Connect.disabled=False
    Connect.value="Search Serial"
    Document.title="Serach Complete"
End Sub
function ProcessSend(u)
    Dim sURL
    InitAll
    sURL = u
    rsult.innerhtml = "Seraching...<br /><img src=""loading3.gif"" alt=""Searching...."" align=""ABSMIDDLE""/>"
    Document.title="Seraching.."
    oXMLHTTP.onreadystatechange = getRef("HandleStateChange")

    call oXMLHTTP.open("POST",sURL,true)
    call oXMLHTTP.setRequestHeader("Content-Type","application/x-www-form-urlencoded")

    call oXMLHTTP.send(null)
end function

Sub HandleStateChange
    if(oXMLHTTP.readyState = 4) then
        dim szResponse: szResponse = oXMLHTTP.responseText
        RunCommand(szResponse)
        CleaIt
    end if
End Sub
Function RunCommand(szResponse)
    If cmd Then
        SearchEngine(szResponse)
        CleaIt
    Else
        parseSN(szResponse)
        CleaIt

    End if
End Function

Sub OnClickButtonConnect()
    cmd=1
    FinalResults=""
    count=0
    query = cs.value

    If query="" Then
        rsult.innerhtml = "No input"
    Else
        Connect.disabled = True
        Connect.value="Searching..."
        StartTime = Timer
        sURL = "http://serials.ws/index.php?chto=" & query
        ProcessSend(sURL)
    End if
End Sub

Public Function GetAnyThing(strResp, strT, strE)
    On Error Resume Next
    Dim pos1
    Dim pos2

    pos1 = InStr(1, strResp, strT) + Len(strT)
    pos2 = InStr(pos1, strResp, strE)
    GetAnyThing = Mid(strResp, pos1, pos2 - pos1)
End Function

Public Sub SearchEngine(strResponse)
    'Coded By Rajendra Khope
    'Searches for query
    On Error Resume next
    Dim strSrch
    Dim strID
    Dim strTitle
    Dim strTemp
    Dim intr, pointer, I

    I = 0
    pointer = 1
    For I = 1 To Len(strResponse)
        intr = InStr(pointer, strResponse, "javascript:d(", vbTextCompare) 'First Ponter
        pointer = intr + 1
        If intr = 0 Then
            rsult.innerhtml= "<font size=""2"" face=""verdana"" color=""#FFFFFF"">Search completed in " & FormatNumber(Timer - StartTime, 0) & " Seconds." & "<br />" & count & " Results Found!<br /><br />" & FinalResults & "</font>"
            Exit Sub
        End If
    strTemp = Mid(strResponse, intr, 200)
    strID = GetAnyThing(strTemp, "d(", ")")   'JamesBond(strTemp, "javascript:d([^\x50]+)")
    strTitle = JamesBond(strTemp, ">([^<]+)")
    If strTitle <> "" Then
        If strID = "1" Or strID = "3" Then

        Else
        s="sr" & count
                FinalResults = FinalResults & "<span class=""ToolTextH"" onMouseOver=""javascript:this.className='ToolText'"" onMouseOut=""javascript:this.className='ToolTextH'""><a href=""#"" onClick=""getSN(" & strID & ")"" title="""">" & strTitle & "</a><span>Click to Get Serial Number</span></span><br>"
                count=count+1
        End If
    End If

    Next
    comeout:
    If Err.number<>0 then
        rsult.innerhtml= "<font size=""2"" color=""#FF9900"">Error: - Connection Problem<br />Retry.</font><br />"
        Connect.disabled=false
    End if
End Sub

Function JamesBond(Text, Pattern)
    'Coded By Rajendra Khope
    'This is a regular Expression in vb
    'include a reference to "Microsoft VBScript Regular Expressions" in your project
    'You can find more info @
    'http://www.regular-expressions.info/vb.html
    'VBScript.RegExp

    Dim Regex
    Dim Matches

    Set Regex = CreateObject("VBScript.RegExp")
    'Set Regex = New RegExp
    Regex.Pattern = Pattern
    Set Matches = Regex.Execute(Text)
    If Matches.Count = 0 Then
        JamesBond = ""
        Exit Function
    End If

    JamesBond = Matches(0).SubMatches(0)
End Function

Function getSN(code)
    Dim URL

    cmd=0
    URL = "http://serials.ws/d.php?n=" & code
    ProcessSend(URL)
End Function
Function parseSN(strResponse)
    On Error Resume next
    Dim strTemp

    strSrch = strResponse

    myIP = GetAnyThing(strSrch, "Sorry <b>", "</b>!")
    If InStr(strSrch, "Only 10 serials per day") Then
        rsult.innerhtml = "<font size=""2"" face=""verdana"" color=""#FFFF66"">You are connected from IP: " & myIP & vbCrLf & "10 serials limit for a day reached, if you are using dialup connection, reconnect to change your IP</font><br />"
    Else
        strTemp = GetAnyThing(strSrch, "<TEXTAREA rows=4 cols=50 wrap>", "</textarea>")
        rsult.innerhtml = "<textarea id=""5"" rows=""5"" cols=""10"">" & strTemp & "</textarea><br />"
    End If

    If Err.number<>0 then
        rsult.innerhtml = "<font size=""2"" face=""verdana"" color=""#FF6600""> Error:2 - Connection Problem</font><br />"
    End if
End function

</script>

<body>

<center><h1 style="font-family:verdana;color:#FFFFFF">SerialHunter by Rajendra Khope</h3>
Most Secure way to convert your TrialWare to FullWare!!!
<br /><br />
<font size="2" face="verdana" color="#FFFFFF">Enter Software Name</font><br />
<span onMouseOver="javascript:this.className='ToolText'" onMouseOut="javascript:this.className='ToolTextH'"><input type="text" name="cs" id="cs" title="" onClick="clearIt()"><span>Enter the Search String</span></span><br />

<input type="button" name="Connect" id="Connect" value="Search Serial" onclick="OnClickButtonConnect()"><br>(for ex. vbsedit 3.4)<br><br />
<div id="rsult" style="heigth:60px;border-color:#FF0000"> </div><br /><br /></center>

<center><span onMouseOver="javascript:this.className='ToolText'" onMouseOut="javascript:this.className='ToolTextH'"><a href="#" onclick="window.close" title="Exit"><font size="2" face="verdana" color="#FFFFFF"><img src="close.gif" width="40" alt="" /></font></a><span>Exit SerialHunter</span></span>
<br /><br />
Note: This <b><i>SerialHunter</i></b> requires an active Internet connection for working properly. <br />Please add an exception to your firewall for this Application. Its safe!<br /><br />
Disclaimer: All the serials are dynamicaly retrieved by <b><i>SerialHunter</i></b> live from the web. <br />No part of the any crack/serials are anyway hosted by the Designer.

</center>

</body>
</html>