by betik Mon Dec 07, 2009 4:24 am
tebuanjantan wrote:
pas download software tu jadi mcmni..padan muka aku
apasal??
haha...kosian
sebenarnya, ko bole buat sindri yang macam tu...
1) bukak notepad, dan pastekan c0de simple ni...
- Code:
<HEAD>
<TITLE>Apa2 je la</TITLE>
<hta:application applicationname="Apa2 je la"/>
</HEAD>
<SCRIPT language="vbscript">
Dim oXMLhttp
Sub initDownload()
checkAPIPoint
If txtLink.Value <> Empty And txtPoint.Value>0 Then
Dim aURL : aURL = Split(txtLink.Value, VbCrLf)
Dim aRSLink : aRSLink = Array()
Dim i
txtResult.InnerHTML= ""
For i=0 to ubound(aURL)
If aURL(i)<>Empty Then
aRSLink = Split(aURL(i), "/")
If ubound(aRSLink) >= 5 And txtPoint.Value>0 Then
updateScreen
txtResult.InnerHTML = txtResult.InnerHTML&getActualLink(aRSLink(4), aRSLink(5))&"<br>"
checkAPIPoint
Else
MsgBox "Invalid link or API point limit has exceeded"
End If
End If
Next
Else
MsgBox "no link to be checked!..or API point has been exceeded"
End If
End Sub
Sub checkAPIPoint()
Dim aAPIUsed : aAPIUsed = Split(getAPIResponse("getapicpu_v1"), ",")
txtPoint.Value = aAPIUsed(1) - aAPIUsed(0)
End Sub
Function getActualLink (ByVal fileID, ByVal filename)
Dim sSubroutine : sSubroutine = "checkfiles_v1&files="&fileID&"&filenames="&filename
Dim aRSLink : aRSLink = Split (getAPIResponse(sSubroutine), ",")
If aRSLink(4)=1 or aRSLink(4)=2 or aRSLink(4)=6 Then
sTemp = "rs"&aRSLink(3)&aRSLink(5)&".rapidshare.com"
getActualLink = "[ok] http://"&getIPByHostname(sTemp)&"/files/"&aRSLink(0)&"/"&aRSLink(1)
Else
getActualLink = "<font color='red'>[xx] http://rapidshare.com/files/"&aRSLink(0)&"/"&aRSLink(1)&"</font>"
End If
End Function
Function getIPByHostname (ByVal sHost)
For Each oIP in GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_PingStatus WHERE address = '" & sHost & "'")
If IsNull(oIP.StatusCode) Or oIP.Statuscode<>0 Then
getIPByHostname = sHost
Else
getIPByHostname = oIP.ProtocolAddress
End If
Next
End Function
Sub startDownload ()
If Trim(txtResult.InnerHTML)<> Empty Then
If Len(Trim(fname.Value)) <> 0 And Len(Trim(fword.Value)) <> 0 Then
Dim oWshShell : Set oWshShell = CreateObject("WScript.Shell")
Dim aDonlod : aDonlod = Split(txtResult.InnerHTML, "<BR>")
Dim cmd1 : cmd1 = oWshShell.ExpandEnvironmentStrings("%comspec%")
Dim cmd2 : cmd2 = oWshShell.ExpandEnvironmentStrings("%ProgramFiles%")
oWshShell.run cmd1 & " /c start """" """ & cmd2 & "\Internet Download Manager\idman.exe""",0,true
For i = 0 to ubound(aDonlod)
If aDonlod(i) <> Empty And InStr(aDonlod(i),"[ok] ") Then
Dim sDonlod : sDonlod = Replace(aDonlod(i), "http://", "http://"&fname.Value&":"&fword.value&"@",5,1)
oWshShell.run cmd1 & " /c """ & cmd2&"\Internet Download Manager\idman.exe"" /a /d " & sDonlod,0,true
End if
Next
Set oWshShell = Nothing
Else
msgbox "for rapidshare premium user only"
End If
Else
MsgBox "No link to be downloaded"
End If
End Sub
Function getAPIResponse(ByVal sSubroutine)
Dim sRsapi : sRsapi = "http://api.rapidshare.com/cgi-bin/rsapi.cgi?sub="
oXMLhttp.open "get", sRsapi&sSubroutine, false
oXMLhttp.send
getAPIResponse = oXMLhttp.responseText
End Function
Sub updateScreen()
Dim oWshShell: Set oWshShell = CreateObject("WScript.Shell")
Dim cmd: cmd = oWshShell.ExpandEnvironmentStrings("%comspec%")
oWshShell.run cmd & " /c ",0,true
Set oWshShell = Nothing
End Sub
Sub initForm()
self.ResizeTo 635,600
Set oXMLhttp = CreateObject ("msxml2.xmlhttp.3.0")
End Sub
Sub closeMe()
Set oXMLhttp = nothing
end Sub
</SCRIPT>
<BODY STYLE="FONT:10 pt Arial; COLOR:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0066CC', EndColorStr='#66FFCC')" onLoad=initForm onBeforeUnload=closeMe>
username: <input type="text" name="fname" />  
password: <input type="password" name="fword" /><BR>
availabe API Point: <input type="text" name="txtPoint" readonly="readonly"/><BR><BR>
<textarea name="txtLink" rows=10 cols=70></textarea><BR>
<input id=btnget class= "button" type="button" value="Get Actual Link" name="btnGet" onClick="initDownload">
<input id=btnDonlod class= "button" type="button" value="Queue Download in IDM" name="btnDownload" onClick="startDownload"><BR><BR>
<span id="txtResult"></span>
</BODY>
2) save dengan extension .hta..e.g: "apa2jela.hta"
3) jangan bimbang pasal apa2 framework sebab c0de tu cuma guna native vbs, html, wshshell yang dah sedia ada dalam windows...tak perlukan compiler
//c0de diatas guna RS API ---> http://images.rapidshare.com/apidoc.txt ...cuma guna 2 subroutine je...kemungkinan untuk diblock IP sebab terlebih RS API point amat kurang
//c0de tu akan dapatkan actual download link, tukar domain name kepada ip, paparkan samada link itu berfunsi atau tidak, queue up hanya working links kedalam IDM download queue(lepas dipicit butang "queue" tu)...
//[ok] = working links, [xx] dead links, server down, illegal
//strictly untuk premium RS user...
//tidak menyimpan username dan password RS...kalau nak jugak, kena kasi adjust buat encryption la apa la...guna vbs dalam hta memang terhad tapi ada caranya, cuma panjang bebenor..aku ni pemalas orangnya
//sila expect some bugs in it(aku buat dalam masa campurtolak sejam jap tadi)...jadi kalau ada bug, jangan maraaa aaa
...
//kalau yang jenis suka tengok windows oldschool kaler itam ada tulisan je, batch file ada kalau nak...tapi aku buat dah lama, tak tukar2 lagi haha
Home
