frmmain.frm

本人初学VB的处女作！ 带单机的端口扫描功能

scan portlisttext.Text
Exit Sub
err:
End Sub

Private Sub sendbtn1_Click()
If senttext.Text = "" Then MsgBox "不能空发信息！", , "警告": GoTo en
On Error GoTo err:
Dim a As Boolean
a = sent(senttext.Text + vbCrLf, True)
GoTo en
err:
'添加错误处理代码

en:
End Sub

Private Sub SSTab1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblTitle.Caption = "小小工具箱！——" + SSTab1.Caption
End Sub








Private Sub stopbtn_Click()
Winsock3.Close
scanbtn.Enabled = True
portlisttext.Enabled = True
Label27.Caption = "状态：STOP!"
End Sub

Private Sub Timer1_Timer()
If send(0) <> "" Then sent1 0, send(0)
If send(1) <> "" Then sent1 1, send(1)

If Winsock2(0).State = 7 And Winsock2(1).State <> 7 Then ljie = ljie + 1
If ljie = 10 Then Winsock2(0).Close: Winsock2(1).Close: lijie = 0
Select Case Winsock1.State
  Case 0: Label8.Caption = "断开"
  Case 1: Label8.Caption = "打开"
  Case 2: Label8.Caption = "listening...."
  Case 3: Label8.Caption = "连接挂起"
  Case 4: Label8.Caption = "识别主机中...."
  Case 5: Label8.Caption = "已识别主机！"
  Case 6: Label8.Caption = "正在连接中...."
  Case 7: Label8.Caption = "已建立连接！": sendbtn1.Enabled = True
  Case 8: Label8.Caption = "正在关闭连接...."
  Case 9: Label8.Caption = "对方端口未开"
  End Select
  Select Case Winsock2(1).State
  Case 0: Label16.Caption = "转向状态:断开"
  Case 1: Label16.Caption = "转向状态:打开"
  Case 2: Label16.Caption = "转向状态:listening...."
  Case 3: Label16.Caption = "转向状态:连接挂起"
  Case 4: Label16.Caption = "转向状态:识别主机中...."
  Case 5: Label16.Caption = "转向状态:已识别主机！"
  Case 6: Label16.Caption = "转向状态:正在连接中...."
  Case 7: Label16.Caption = "转向状态:已建立连接！"
  Case 8: Label16.Caption = "转向状态:正在关闭连接...."
  Case 9: Label16.Caption = "转向状态:对方端口未开"
  End Select
   Select Case Winsock2(0).State
  Case 0: Label19.Caption = "监听状态:断开"
  Case 1: Label19.Caption = "监听状态:打开"
  Case 2: Label19.Caption = "监听状态:listening...."
  Case 3: Label19.Caption = "监听状态:连接挂起"
  Case 4: Label19.Caption = "监听状态:识别主机中...."
  Case 5: Label19.Caption = "监听状态:已识别主机！"
  Case 6: Label19.Caption = "监听状态:正在连接中...."
  Case 7: Label19.Caption = "监听状态:已建立连接！"
  Case 8: Label19.Caption = "监听状态:正在关闭连接...."
  Case 9: Label19.Caption = "监听状态:对方端口未开"
  End Select
End Sub





Private Sub Winsock1_Close()
Winsock1.Close
Label10.Caption = "对方IP: 无"
lianjie.Enabled = True
listen.Enabled = True
break.Enabled = False
sendbtn1.Enabled = False

End Sub

Private Sub Winsock1_Connect()
Dim sentsuccess As Boolean
If senttext.Text <> "" And Winsock1.State = 7 Then sentsuccess = sent(senttext.Text, Check1.value)
Label10.Caption = "对方IP:" + Winsock1.RemoteHost
receivetext.Text = ""
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
Winsock1.Close
Winsock1.Accept requestID
If senttext.Text <> "" And Winsock1.State = 7 Then sentsuccess = sent(senttext.Text, Check1.value)
Label10.Caption = "对方IP:" + Winsock1.RemoteHost

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strtemp As String
Dim a As Boolean
Label6.Caption = "消息传输状态：接收中...."
Winsock1.GetData strtemp
Label6.Caption = "消息传输状态：接收完成"
If receivetext.Text = "" Then receivetext.Text = strtemp Else receivetext.Text = receivetext.Text + "____________________" + Chr$(13) + Chr$(10) + strtemp
If Check2.value Then a = save(CDialog.filename, receivetext.Text)
If cishu Then a = sent(senttext.Text, True)
End Sub

'发送数据

Function sent(ByVal strtemp As String, ByVal value As Boolean) As Boolean
sendbtn1.Enabled = False
'分批发送数据
Do
cishu = InStr(1, senttext.Text, "____________________", vbTextCompare)
If cishu = 0 Then GoTo right
strtemp = Left(senttext.Text, cishu - 1)
senttext.Text = right(senttext.Text, Len(senttext.Text) - cishu - 19)
Loop While cishu = 1
right:
If value = False Then GoTo err
On Error GoTo err:
Label6.Caption = "消息传输状态：发送中...."
Winsock1.SendData strtemp + vbCrLf
Label6.Caption = "消息传输状态：发送完成"
sent = True
GoTo en
err:
Label6.Caption = "消息传输状态：发送失败"

'添加错误处理代码
sent = False
en:
If cishu = 0 Then GoTo en1
sendbtn1.Enabled = True
en1:
End Function

Private Sub Winsock1_Error(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 GoTo en
Winsock1.Close
Label10.Caption = "对方IP: 无"
lianjie.Enabled = True
listen.Enabled = True
break.Enabled = False
sendbtn1.Enabled = False
If lianxu = True Then
   Winsock1.listen
   lianjie.Enabled = False
listen.Enabled = False
break.Enabled = True
sendbtn1.Enabled = False
End If
en:
End Sub
'端口转发
Private Sub Winsock2_Close(Index As Integer)
connect = False
Label17.Caption = "客户IP:无"
Winsock2(0).Close
Winsock2(1).Close
listening1.Enabled = True
break1.Enabled = False
End Sub
Private Sub Winsock2_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If connect = True Then GoTo en
On Error GoTo err
Winsock2(0).Close
Winsock2(0).Accept requestID
winsocksendconnect
Label17.Caption = "客户IP:" + Winsock2(0).RemoteHost
connect = True
GoTo en
err:
Winsock2(0).Close
Winsock2(1).Close
MsgBox "连接" + Winsock2(1).RemoteHost + "的" + Str$(Winsock2(1).RemotePort) + "端口时出错！" + vbNewLine + "可能对方端口未开！", , "错误"
listening1.Enabled = True
break1.Enabled = False
en:
End Sub

Private Sub Winsock2_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim strtemp As String
Dim a As Boolean
Label18.Caption = "消息传输状态：接收中.. .."
Winsock2(Index).GetData strtemp
Label18.Caption = "消息传输状态：接收完成"
If Index = 0 Then
    If receivetext2.Text = "" Then
    receivetext2.Text = strtemp
    Else: receivetext2.Text = receivetext2.Text + "____________________" + Chr$(13) + Chr$(10) + strtemp
    End If
End If
If Index = 1 Then
    If receivetext1.Text = "" Then
    receivetext1.Text = strtemp
    
    Else: receivetext1.Text = receivetext1.Text + "____________________" + Chr$(13) + Chr$(10) + strtemp
End If
End If
winsocksend Index, strtemp
GoTo en
err:
Winsock2(0).Close
Winsock2(1).Close
MsgBox "连接" + Winsock2(1).RemoteHost + "的" + Str$(Winsock2(1).RemotePort) + "端口时出错！" + vbNewLine + "可能对方端口未开！", , "错误"
listening1.Enabled = True
break1.Enabled = False
en:
End Sub

Private Sub Winsock2_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)
Winsock2(0).Close
Winsock2(1).Close
MsgBox Str$(Number) + Description + Source + HelpFile, , "错误"
listening1.Enabled = True
break1.Enabled = False
End Sub

Private Sub Winsock2_SendComplete(Index As Integer)
Label18.Caption = "消息传输状态：发送完成"
End Sub

Private Sub Winsock2_SendProgress(Index As Integer, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Label18.Caption = "消息传输状态：发送中...."
End Sub

Private Sub winsocksendconnect()
Winsock2(1).RemoteHost = iptext1.Text
Winsock2(1).RemotePort = porttext2.Text
Winsock2(1).connect
End Sub
Private Sub winsocksend(Index As Integer, ByVal strtemp As String)
If Index = 1 Then Index = 0 Else Index = 1
send(Index) = send(Index) + "____________________" + strtemp
send(Index) = change(send(Index), Winsock2(0).LocalIP, Winsock2(1).RemoteHostIP, Check3.value)
sent1 Index, send(Index)
End Sub
Function sent1(ByVal Index As Integer, ByVal strtemp As String) As Boolean
If Winsock2(Index).State <> 7 Then GoTo en1
On Error GoTo err
'分批发送数据
Do
cishu = InStr(1, send(Index), "____________________", vbTextCompare)
If cishu = 0 Then GoTo right
strtemp = Left(send(Index), cishu - 1)
send(Index) = right(send(Index), Len(send(Index)) - cishu - 19)
Loop While cishu = 1
right:
If cishu = 0 Then strtemp = send(Index): send(Index) = ""
Label18.Caption = "消息传输状态：发送中...."
Winsock2(Index).SendData strtemp + vbCrLf
Label18.Caption = "消息传输状态：发送完成"
sent1 = True
GoTo en
err:
Label18.Caption = "消息传输状态：发送失败"

'添加错误处理代码
sent1 = False
en:
If cishu = 0 Then GoTo en1

en1:
End Function
Private Sub scan(ByVal port As String)
Dim strtemp As String
Dim strtempbat As String
Dim i As Long
Dim sta As Long
Dim sto As Long
Dim time As Long
strtempbat = port
Dim a As Integer
a:
a = InStr(1, strtempbat, ",", vbTextCompare)
If a Then strtemp = Left$(strtempbat, a - 1)
If a = 0 Then GoTo last
strtempbat = right$(strtempbat, Len(strtempbat) - a)

If scanbtn.Enabled = True Then Winsock3.Close: Exit Sub
a = InStr(1, strtemp, "-", vbTextCompare)
If a > 1 Then GoTo you Else GoTo no
'有－时
you:

  sta = Val(Left$(strtemp, a - 1)): sto = Val(right$(strtemp, Len(strtemp) - a))
  
  For i = sta To sto
  Winsock3.RemotePort = Str$(i)
  Winsock3.connect
  DoEvents
  portnum1 = portnum1 + 1
  
  Label27.Caption = "状态：正在扫描" + Str$(i) + "端口"
  time = GetTickCount()
 
  Do Until GetTickCount() > time + timelong Or Winsock3.State = sckConnected
  DoEvents
  If scanbtn.Enabled = True Then Winsock3.Close: Exit Sub
  Loop
  If Winsock3.State = sckConnected Then result = result + vbNewLine + ipaddtext + "的" + Str$(i) + "号端口开放" + getportname(i)
  Winsock3.Close
  Next i: GoTo a
'没－时
no:
  Winsock3.RemotePort = strtemp
  Winsock3.connect
  DoEvents
  portnum1 = portnum1 + 1

  Label27.Caption = "状态：正在扫描" + strtemp + "端口"
  time = GetTickCount()
 If scanbtn.Enabled = True Then Winsock3.Close: Exit Sub
  Do Until GetTickCount() > time + timelong Or Winsock3.State = sckConnected
  DoEvents
  Loop
  If Winsock3.State = sckConnected Then result = result + vbNewLine + ipaddtext + "的" + Str$(i) + "号端口开放" + getportname(i)
  Winsock3.Close
  GoTo a
'最后的端口
last:
 a = InStr(1, strtempbat, "-", vbTextCompare)
If a > 1 Then GoTo you1 Else GoTo no1
'有－时
you1:
 
  sta = Val(Left$(strtempbat, a - 1)): sto = Val(right$(strtempbat, Len(strtempbat) - a))
  For i = sta To sto
  Winsock3.RemotePort = Str$(i)
  Winsock3.connect
  DoEvents
  portnum1 = portnum1 + 1

  Label27.Caption = "状态：正在扫描" + Str$(i) + "端口"
  time = GetTickCount()
 If scanbtn.Enabled = True Then Winsock3.Close: Exit Sub
  Do Until GetTickCount() > time + timelong Or Winsock3.State = sckConnected
  DoEvents
  Loop
  If Winsock3.State = sckConnected Then result = result + vbNewLine + ipaddtext + "的" + Str$(i) + "号端口开放" + getportname(i)
  Winsock3.Close
  Next i: GoTo en
'没－时
no1:
  Winsock3.RemotePort = strtempbat
  Winsock3.connect
  DoEvents
  portnum1 = portnum1 + 1

  Label27.Caption = "状态：正在扫描" + strtempbat + "端口"
  time = GetTickCount()
 If scanbtn.Enabled = True Then Winsock3.Close: Exit Sub
  Do Until GetTickCount() > time + timelong Or Winsock3.State = sckConnected
  DoEvents
  Loop
  If Winsock3.State = sckConnected Then result = result + vbNewLine + ipaddtext + "的" + Str$(i) + "号端口开放" + getportname(i)
  Winsock3.Close
en:
Label27.Caption = "状态：扫描完毕！"
scanbtn.Enabled = True
Winsock3.Close
scanbtn.Enabled = True
portlisttext.Enabled = True
End Sub

Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
Dim strtemp As String
Winsock3.GetData strtemp
result.Text = result.Text + vbNewLine + "从" + Winsock3.RemoteHostIP + "的" + Str$(Winsock3.RemotePort) + "端口接收的信息：" + strtemp

End Sub