📄 frmattackdetails.frm
字号:
End
Begin VB.CommandButton Logs_save
Caption = "logs"
Height = 195
Left = 5280
TabIndex = 17
Top = 2760
Visible = 0 'False
Width = 735
End
Begin VB.CommandButton cmdGet
Caption = "getHost"
Height = 195
Left = 5280
TabIndex = 16
Top = 2640
Visible = 0 'False
Width = 735
End
Begin VB.CommandButton Command1
Caption = "Close My Connection"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 240
Picture = "frmAttackDetails.frx":4082
Style = 1 'Graphical
TabIndex = 15
Top = 2640
Width = 2295
End
Begin VB.Label Label10
BackColor = &H00000000&
Caption = "/"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 255
Left = 2880
TabIndex = 30
Top = 2880
Width = 135
End
Begin VB.Label Label7
BackColor = &H00000000&
Caption = "OR"
BeginProperty Font
Name = "AmericanUncIniD"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 375
Left = 2640
TabIndex = 18
Top = 3600
Width = 615
End
Begin VB.Label Label2
BackColor = &H00000000&
Caption = "Warning !!! "
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 255
Left = 2400
TabIndex = 14
Top = 2400
Width = 1095
End
End
Begin VB.Image imgWarning
Height = 480
Index = 7
Left = 6300
Picture = "frmAttackDetails.frx":44C4
Top = 2100
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 6
Left = 6300
Picture = "frmAttackDetails.frx":4906
Top = 1425
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 5
Left = 6300
Picture = "frmAttackDetails.frx":4D48
Top = 750
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 4
Left = 6300
Picture = "frmAttackDetails.frx":518A
Top = 75
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 3
Left = 0
Picture = "frmAttackDetails.frx":55CC
Top = 2100
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 2
Left = 0
Picture = "frmAttackDetails.frx":5A0E
Top = 1425
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 0
Left = 0
Picture = "frmAttackDetails.frx":5E50
Top = 75
Visible = 0 'False
Width = 480
End
Begin VB.Image imgWarning
Height = 480
Index = 1
Left = 0
Picture = "frmAttackDetails.frx":6292
Top = 750
Visible = 0 'False
Width = 480
End
End
Attribute VB_Name = "frmAttackDetails"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Const SW_SHOWNORMAL = 1
Const WM_CLOSE = &H10
Const gcClassnameMSWord = "OpusApp"
Const gcClassnameMSExcel = "XLMAIN"
Const gcClassnameMSIExplorer = "IEFrame"
Const gcClassnameMSVBasic = "wndclass_desked_gsk"
Const gcClassnameNotePad = "Notepad"
Const gcClassnameMyVBApp = "ThunderForm"
Dim mintFullHeight As Integer
Dim mintCompactHeight As Integer
Dim mintCurMemoryCounter As Integer
Dim mintTextMemoryCounter As Integer
Dim mstrTextMemory() As String
Private Sub ShowErrorMsg(lngError As Long)
Dim strMessage As String
Select Case lngError
Case WSANOTINITIALISED
strMessage = "A successful WSAStartup call must occur " & _
"before using this function."
Case WSAENETDOWN
strMessage = "The network subsystem has failed."
Case WSAHOST_NOT_FOUND
strMessage = "Authoritative answer host not found."
Case WSATRY_AGAIN
strMessage = "Nonauthoritative host not found, or server failure."
Case WSANO_RECOVERY
strMessage = "A nonrecoverable error occurred."
Case WSANO_DATA
strMessage = "Valid name, no data record of requested type."
Case WSAEINPROGRESS
strMessage = "A blocking Windows Sockets 1.1 call is in " & _
"progress, or the service provider is still " & _
"processing a callback function."
Case WSAEFAULT
strMessage = "The name parameter is not a valid part of " & _
"the user address space."
Case WSAEINTR
strMessage = "A blocking Windows Socket 1.1 call was " & _
"canceled through WSACancelBlockingCall."
End Select
MsgBox strMessage, vbExclamation
End Sub
Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function
Private Sub cmdGet_Click()
Dim lngInetAdr As Long
Dim lngPtrHostEnt As Long
Dim strHostName As String
Dim udtHostEnt As HOSTENT
Dim strIpAddress As String
txtAttckrsHostName.Text = ""
strIpAddress = Trim$(txtAttckrsIP.Text)
lngInetAdr = inet_addr(strIpAddress)
If lngInetAdr = INADDR_NONE Then
ShowErrorMsg (Err.LastDllError)
Else
lngPtrHostEnt = gethostbyaddr(lngInetAdr, 4, PF_INET)
If lngPtrHostEnt = 0 Then
ShowErrorMsg (Err.LastDllError)
Else
RtlMoveMemory udtHostEnt, ByVal lngPtrHostEnt, LenB(udtHostEnt)
strHostName = String(256, 0)
RtlMoveMemory ByVal strHostName, ByVal udtHostEnt.hName, 256
strHostName = Left(strHostName, InStr(1, strHostName, Chr(0)) - 1)
txtAttckrsHostName.Text = strHostName
End If
End If
End Sub
Private Sub cmdReturn_Click()
MsgBox "Attackers Info saved at C:\Attacker.txt", vbExclamation
Main.cmdStopWatch.Enabled = True
Main.Show
Unload frmAttackDetails
End Sub
Private Sub Command1_Click()
Call HangUp
End Sub
Private Sub Command2_Click()
Me.Height = 7915
End Sub
Private Sub Command3_Click()
Me.Height = 5415
End Sub
Private Sub Command4_Click()
ShutDown_DIALOG
End Sub
Private Sub Logs_save_Click()
' We know Attacker Info, and we must save it (c:\logs.txt)
Dim FSO, Create, NowNow
NowNow = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Create = FSO.CreateTextFile("c:\Attacker.txt")
If txtAttckrsIP.Text = "" = False Then
Create.WriteLine "************************************"
Create.WriteLine " Trojan Defence v2.0 "
Create.WriteLine " Warning! [Attacker] "
Create.WriteLine " Attack Day: " & Format(NowNow, "d,mmmm,yyyy ")
Create.WriteLine " Attack Time: " & Format(NowNow, "h:mm:ss ")
Create.WriteLine " Host Name: " + txtAttckrsHostName.Text + ""
Create.WriteLine " IP: " + txtAttckrsIP.Text + ""
Create.WriteLine " Port: " + txtAttckrsPort.Text + ""
Create.WriteLine "************************************"
Create.Close
End If
End Sub
Private Sub Form_Load()
Main.cmdStopWatch.Enabled = False
Min.Value = True
End Sub
Private Function Flood()
'Checks if they type in a room name.
If txtAttckrsIP = "" Then
MsgBox "You can't Flood him. Because, I can't find Attackers IP.", vbExclamation, "Error"
Else
'Sets they variables
Dim strText As String
Dim strTextToSend As String
Dim strChunk As String
Dim intCounter1 As Integer
Dim Time
'Sets time to Zero
Time = 0
'Sets strText to the flood message
strText = txtFloodMessage.Text
'Checks for special charachters such as { and ]
For intCounter1 = 1 To Len(strText)
strChunk = Mid(strText, intCounter1, 1)
If strChunk = "(" Then strChunk = "{(}"
If strChunk = ")" Then strChunk = "{)}"
If strChunk = "+" Then strChunk = "{+}"
If strChunk = "^" Then strChunk = "{^}"
If strChunk = "%" Then strChunk = "{%}"
If strChunk = "~" Then strChunk = "{~}"
If strChunk = "[" Then strChunk = "{[}"
If strChunk = "]" Then strChunk = "{]}"
If strChunk = "{" Then strChunk = "{{}"
If strChunk = "}" Then strChunk = "{}}"
strTextToSend = strTextToSend + strChunk
Next
'Makes it auto hit return
If chkAddCarriageReturn.Value = Checked Then
strTextToSend = strTextToSend & Chr(13)
End If
'Sets the amount of times to flood
For i = 1 To txtFloodTimes.Text
DoSendKeys txtAttckrsIP.Text, False, strTextToSend, True
'pause amount, which = 0 From Time
s! = Timer
Do: DoEvents
Loop Until Timer - s! > Time
'Checks the array and redims to get rid of unnesasary items
mintTextMemoryCounter = mintTextMemoryCounter + 1
ReDim Preserve mstrTextMemory(mintTextMemoryCounter)
mstrTextMemory(mintTextMemoryCounter) = txtFloodMessage.Text
mintCurMemoryCounter = UBound(mstrTextMemory) + 1
Next i
End If
End Function
Private Sub DoSendKeys(AppToActivate As String, AppActivateDelay As Boolean, TextToSend As String, SendKeysDelay As Boolean)
'This will use SendKeys to send text to an outside application
On Error GoTo ErrHandler
AppActivate AppToActivate, AppActivateDelay
SendKeys TextToSend, SendKeysDelay
Exit Sub
ErrHandler:
Exit Sub
End Sub
Private Sub Min_Click()
MinimizeAll
End Sub
Private Sub picButton_Click()
Dim i
'For Flood Progress alitle unreal
ProgressBar1.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = 300000
For i = 0 To 300000
ProgressBar1.Value = i
Next
ProgressBar1.Visible = False
Call Flood
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -