📄 form4.frm
字号:
BackColor = &H80000009&
Caption = "Goto Main --->"
Height = 255
Left = 9600
TabIndex = 25
Top = 120
Width = 1215
End
Begin VB.Label Label4
BackColor = &H00FFFFFF&
Caption = "DELAY SENT"
Height = 255
Left = 6720
TabIndex = 22
Top = 120
Width = 1095
End
Begin VB.Label Label3
BackColor = &H00000000&
Caption = "Targets List"
ForeColor = &H00FFFFFF&
Height = 255
Left = 360
TabIndex = 21
Top = 1320
Width = 1215
End
Begin VB.Label Label2
BackColor = &H00000000&
Caption = "End IP"
ForeColor = &H00FFFFFF&
Height = 255
Left = 360
TabIndex = 19
Top = 720
Width = 975
End
Begin VB.Label Label1
BackColor = &H00000000&
Caption = "Start IP"
ForeColor = &H00FFFFFF&
Height = 255
Left = 360
TabIndex = 18
Top = 240
Width = 975
End
Begin VB.Menu flemenu
Caption = "&File"
Index = 1
Begin VB.Menu savemnu
Caption = "&Save Scan"
End
End
End
Attribute VB_Name = "Frmdt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' by nima bagheri form THECRACKERS_GROUP@yahoo.ca
'TEL 098-0151-2210510
Dim c As Long
Dim i As Long
Private Sub Addnew_Click()
For x = 0 To 3
If txtip(x).Text <> "" And txtendip(x).Text <> "" Then
flag = True
Else
MsgBox "PLEASE ENTER FULL IP ", , "ERR !"
Exit Sub
End If
Next x
If flag = True Then
a0 = txtip(0).Text
a1 = txtip(1).Text
a2 = txtip(2).Text
a3 = txtip(3).Text
b0 = txtendip(0).Text
b1 = txtendip(1).Text
b2 = txtendip(2).Text
b3 = txtendip(3).Text
List1.AddItem Trim(txtip(0).Text + "." + txtip(1).Text + "." + txtip(2).Text + "." + txtip(3).Text)
cmdSend.Enabled = True
bip = (CStr(b0) + "." + CStr(b1) + "." + CStr(b2) + "." + CStr(b3))
ball = AddressStringToLong(bip) 'for check end ip
aip = (CStr(a0) + "." + CStr(a1) + "." + CStr(a2) + "." + CStr(a3))
aAll = AddressStringToLong(aip) 'for check end ip
If Abs(ball) = Abs(aAll) Then
Exit Sub
End If
Do
If a3 Mod 250 = 0 Then DoEvents
x:
a3 = a3 + 1
aip = (CStr(a0) + "." + CStr(a1) + "." + CStr(a2) + "." + CStr(a3))
aAll = AddressStringToLong(aip) 'for check end ip
If Abs(ball) = Abs(aAll) Then
List1.AddItem aip
Exit Do
Else
List1.AddItem aip
End If
If a3 > 254 And a2 < b2 Then
a2 = a2 + 1
a3 = 0
GoTo x:
End If
If a2 > 254 And a1 < b1 Then
a1 = a1 + 1
a2 = 0
GoTo x:
End If
Loop
End If
End Sub
Sub aa0(value As Integer)
value = value + 1
End Sub
Private Sub cmdclear_Click()
List1.Clear
End Sub
Private Sub cmdCollapse_Click()
For e = 1 To TreeView1.Nodes.Count
TreeView1.Nodes.item(e).Expanded = False
Next e
End Sub
Private Sub cmddelete_Click()
If List1.ListIndex <> -1 Then List1.RemoveItem (List1.ListIndex)
End Sub
Private Sub cmdexpand_Click()
For e = 1 To TreeView1.Nodes.Count
TreeView1.Nodes.item(e).Expanded = True
'TreeView1.Nodes.Item(e).EnsureVisible
Next e
End Sub
Private Sub Command1_Click()
Timer1.Enabled = False
Call cl
cmdSend.Enabled = True
End Sub
Private Sub Form_Activate()
If Me.WindowState <> 2 Then Me.WindowState = 2
End Sub
Private Sub lblmain_Click()
Form3.Show
Me.Hide
End Sub
Private Sub savemnu_Click()
cd1.ShowSave
If cd1.FileName = "" Then
MsgBox "PLEASE Enter A File Name ", , "WARNNING"
Exit Sub
Else
c = FreeFile
Open cd1.FileName + ".html" For Output As c
Print #1, createhtml
Close c
End If
End Sub
Private Sub timcl_Timer()
timcl.Enabled = False
Call cl
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If i = wsckClient.Count - 1 Then Load wsckClient(i + 1)
Dim strs As String
If i >= List1.ListCount - 1 Then
Timer1.Enabled = False
cmdSend.Enabled = Not (cmdSend.Enabled)
lblstat.Caption = "Scaning Finished ! "
timcl.Enabled = True
End If
wsckClient(i).Close
wsckClient(i).RemoteHost = List1.List(i)
wsckClient(i).RemotePort = "80"
TreeView1.Nodes.Add , , wsckClient(i).RemoteHost, wsckClient(i).RemoteHost
' TreeView1.Nodes.Item(TreeView1.Nodes.Count).Expanded = True
' TreeView1.Nodes.Item(TreeView1.Nodes.Count).EnsureVisible
wsckClient(i).Connect
i = i + 1
End Sub
Private Sub Timer2_Timer()
If i = wb1.Count - 1 Then Load wb1(i + 1)
Dim strs As String
If i >= List1.ListCount - 1 Then
Timer2.Enabled = False
cmdSend.Enabled = Not (cmdSend.Enabled)
lblstat.Caption = "Scaning Finished ! "
End If
SHR = "http://" & List1.List(i) + txtfolder.Text & txtscripts.Text & txtfilename
SHR = SHR + txtcmd
wb1(i).Navigate2 SHR, 1
i = i + 1
End Sub
Private Sub txtendip_Change(Index As Integer)
On Error Resume Next
If txtendip(Index) = "" Then txtendip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtendip(Index).Text) > 255 Then
MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
txtendip(Index).Text = "0"
SendKeys "{HOME}+{END}"
End If
End Sub
Private Sub txtendip_GotFocus(Index As Integer)
SendKeys "{HOME}+{END}"
End Sub
Private Sub txtip_Change(Index As Integer)
On Error Resume Next
If txtip(Index) = "" Then txtip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtip(Index).Text) > 255 Then
MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
txtip(Index).Text = "0"
SendKeys "{HOME}+{END}"
End If
txtendip(0).Text = txtip(0).Text
txtendip(1).Text = txtip(1).Text
txtendip(2).Text = txtip(2).Text
End Sub
Private Sub txtip_GotFocus(Index As Integer)
SendKeys "{HOME}+{END}"
End Sub
Private Sub VScroll1_Change()
txtdelay.Text = VScroll1.value
End Sub
Private Sub wsckClient_Connect(Index As Integer)
sendpacket (Index)
End Sub
Private Sub wsckClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Text3 is show resv
Dim msg As String
On Error Resume Next
wsckClient(Index).GetData msg
b1 = 1
If Len(msg) > 0 Then
If Len(msg) > 100 Then
Do
b = Mid(msg, b1, 100)
b1 = b1 + 100
If Len(b) > 0 Then
TreeView1.Nodes.Add wsckClient(Index).RemoteHost, 4, , CStr(b)
TreeView1.Nodes(TreeView1.Nodes.Count).Parent.ForeColor = vbRed
End If
Loop Until b = ""
End If
End If
End Sub
Private Sub cmdSend_Click()
cmdSend.Enabled = False
Timer1.Interval = CStr(txtdelay.Text)
Timer2.Interval = CStr(txtdelay.Text)
TreeView1.Nodes.Clear
If Option1.value = True Then
Timer1.Enabled = True
Else
Timer2.Enabled = True
End If
i = 0
End Sub
Sub sendpacket(target As Long)
On Error GoTo last
SHR = "GET " & txtfolder.Text & txtscripts.Text & txtfilename
txtcmd = Replace(txtcmd, Chr(32), "%20", 1, 100, vbBinaryCompare)
SHR = SHR + txtcmd & " HTTP/1.0" & vbCrLf
SHR = SHR + "Accept: */*" & vbCrLf
SHR = SHR + "Accept -Language: fa" & vbCrLf
SHR = SHR + "Accept -Encoding: gzip , deflate" & vbCrLf
SHR = SHR + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.1.4322)" & vbCrLf
SHR = SHR + "Host:" + CStr(wsckClient(target).RemoteHost) & vbCrLf
SHR = SHR + "Connection: Keep-Alive" & vbCrLf & vbCrLf
wsckClient(target).SendData SHR
Exit Sub
last:
If err.Number = 40006 Then
wsckClient(target).Close
'Timer1.Enabled = False
'MsgBox "Not connected, Try again"
End If
End Sub
Private Sub wsckClient_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
TreeView1.Nodes.Add wsckClient(Index).RemoteHost, 4, , Description
End Sub
Sub cl()
For j = 0 To wsckClient.Count - 1
wsckClient(j).Close
Next j
End Sub
Function createhtml() As String
Dim b As String
Const cr = vbCrLf
createhtml = "<html>" + cr + "<head>" + cr + "<title> THE CRACKERS GROUP SCANNER </title>" + cr + "</head>" + "<body>" + cr
b = b + "<p><font size=" + Chr(34) + "7" + Chr(34) + "> THE CRACKERS GROUP</font></p>"
b = b + " <b>TARGET OPRATION SYSTEM SCANNER </b> <br>"
For l = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes.item(l).Children <> 0 Then
b = b + "<p>" + "<font color=" + Chr(34) + "#FFFFFF" + Chr(34) + ">"
b = b + "<span style=" + Chr(34) + "background-color: #3366CC" + Chr(34) + ">"
b = b + "IP Address : " + TreeView1.Nodes.item(l).Text + "</span></font><br>"
b = b + "Details :" + "<br>"
ccount = 0
For l2 = l + 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(l2).Parent.Text = TreeView1.Nodes.item(l).Text Then
b = b + TreeView1.Nodes.item(l2).Text + "<br>"
ccount = ccount + 1
End If
If ccount = TreeView1.Nodes.item(l).Children Then Exit For
Next l2
b = b + "</p>"
End If
Next l
' For l = 1 To TreeView1.Nodes.Count
' If TreeView1.Nodes.item(l).Children <> 0 Then
' b = b + "<p>" + "<font color=" + Chr(34) + "#FFFFFF" + Chr(34) + ">"
' b = b + "<span style=" + Chr(34) + "background-color: #3366CC" + Chr(34) + ">"
' b = b + "IP Address : " + TreeView1.Nodes.item(l).Text + "</span></font><br>"
' b = b + "Details :" + "<br>"
' For l2 = l + 1 To l + TreeView1.Nodes.item(l).Children
' b = b + TreeView1.Nodes.item(l2).Text + "<br>"
' Next l2
' b = b + "</p>"
' End If
' Next l
createhtml = createhtml + b
createhtml = createhtml + "</body>" + cr + "</html>" + cr
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -