frmmain.frm

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

      X1              =   0
      X2              =   688
      Y1              =   31
      Y2              =   31
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "超级工具箱"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   240
      Left            =   4080
      TabIndex        =   0
      Top             =   8520
      Width           =   255
   End
   Begin VB.Image imgTitleMinimize 
      Height          =   195
      Left            =   5640
      Picture         =   "Frmmain.frx":0D3D
      Top             =   8280
      Width           =   195
   End
   Begin VB.Image imgTitleClose 
      Height          =   195
      Left            =   5640
      Picture         =   "Frmmain.frx":0F87
      Top             =   7920
      Width           =   195
   End
   Begin VB.Image imgTitleHelp 
      Height          =   195
      Left            =   5640
      Picture         =   "Frmmain.frx":11D1
      Top             =   7560
      Width           =   195
   End
   Begin VB.Image imgTitleLeft 
      Height          =   450
      Left            =   4200
      Picture         =   "Frmmain.frx":141B
      Top             =   7560
      Width           =   285
   End
   Begin VB.Image imgTitleRight 
      Height          =   450
      Left            =   4560
      Picture         =   "Frmmain.frx":1B65
      Top             =   7560
      Width           =   285
   End
   Begin VB.Image imgWindowBottomLeft 
      Height          =   450
      Left            =   4920
      Picture         =   "Frmmain.frx":22AF
      Top             =   7560
      Width           =   285
   End
   Begin VB.Image imgWindowBottomRight 
      Height          =   450
      Left            =   5280
      Picture         =   "Frmmain.frx":29F9
      Top             =   7560
      Width           =   285
   End
   Begin VB.Image imgTitleMain 
      Height          =   450
      Left            =   4200
      Picture         =   "Frmmain.frx":3143
      Stretch         =   -1  'True
      Top             =   8040
      Width           =   285
   End
   Begin VB.Image imgWindowBottom 
      Height          =   450
      Left            =   4560
      Picture         =   "Frmmain.frx":388D
      Stretch         =   -1  'True
      Top             =   8040
      Width           =   285
   End
   Begin VB.Image imgWindowLeft 
      Height          =   450
      Left            =   4920
      Picture         =   "Frmmain.frx":3FD7
      Stretch         =   -1  'True
      Top             =   8040
      Width           =   285
   End
   Begin VB.Image imgWindowRight 
      Height          =   450
      Left            =   5280
      Picture         =   "Frmmain.frx":4721
      Stretch         =   -1  'True
      Top             =   8040
      Width           =   285
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public lianxu As Boolean
Public cishu As Integer
Public sended As String
Public ljie As Integer
Private send(1) As String
Public connect As Boolean
Public portnum1 As Integer


Private Sub break_Click()
lianxu = False
Winsock1.Close
break.Enabled = False
    sendbtn1.Enabled = False
    lianjie.Enabled = True
    listen.Enabled = True
End Sub

Private Sub break1_Click()
Winsock2(0).Close
Winsock2(1).Close
break1.Enabled = False: listening1.Enabled = True
Label17.Caption = "客户IP:无"
End Sub

Private Sub Check2_Click()
If Check2.value Then savebtn.Enabled = False Else savebtn.Enabled = True
 
End Sub

Private Sub clearbtn1_Click()
senttext.Text = ""
End Sub

Private Sub clearbtn2_Click()
receivetext1.Text = ""
End Sub
Private Sub clearbtn3_Click()
receivetext2.Text = ""
End Sub

Private Sub clearbtn4_Click()
result.Text = ""
End Sub

Private Sub Command1_Click()
Icon_Del Form1.hwnd
Unload Me

End
End Sub


Private Sub Command2_Click()
senttext.Text = senttext.Text + "____________________"
End Sub






Private Sub Command6_Click()
Dim a As Boolean
CDialog.DefaultExt = "txt"
CDialog.Action = 2
a = save(CDialog.filename, result.Text)
End Sub



Private Sub listening1_Click()
If porttext2.Text = "" Or Val(porttext2.Text) > 65535 Then MsgBox "端口号输入错误！", , "错误！": porttext2.SetFocus: GoTo en
If localport1.Text = "" Or Val(localport1.Text) > 65535 Then MsgBox "端口号输入错误！", , "错误！": localport1.SetFocus: GoTo en
If ipcheck(iptext1.Text) = False Then iptext1.SetFocus: GoTo en

Winsock2(0).localport = localport1.Text
Winsock2(0).listen
listening1.Enabled = False: break1.Enabled = True
GoTo en:
err:
MsgBox "可能本地端口被占用！" + vbNewLine + "请更换本地端口后再试", , "错误"
Winsock2(0).Close
Winsock2(1).Close
listening1.Enabled = True: break1.Enabled = False
en:
End Sub

Private Sub localport1_Change()
If localport1.Text = "" Then localport1.SetFocus: GoTo en2
If Val(localport1.Text) > 65535 Or Val(localport1.Text) < 0 Then localport1.SetFocus: MsgBox "端口号输入错误！", , "错误！"
en2:
End Sub

Private Sub openbtn_Click()
On Error GoTo err
Dim inputdata$
CDialog.Action = 1
senttext.Text = ""
Open CDialog.filename For Input As #1
Do While Not EOF(1)
Line Input #1, inputdata
senttext.Text = senttext.Text + inputdata + Chr(13) + Chr(10)
Loop
Close #1
GoTo en
err:
MsgBox "文件打开出错!", , "错误"
en:
End Sub

Private Sub pingbtn_Click()

If hostname.Text = "" Then MsgBox "请输入主机名", , "提示": hostname.SetFocus: Exit Sub

Timer2.Enabled = True
End Sub

Private Sub porttext2_Change()
If porttext2.Text = "" Then porttext2.SetFocus: GoTo en2
If Val(porttext2.Text) > 65535 Or Val(porttext2.Text) < 0 Then porttext2.SetFocus: MsgBox "端口号输入错误！", , "错误！"
en2:
End Sub

Private Sub savebtn_Click()
Dim a As Boolean
CDialog.DefaultExt = "txt"
CDialog.Action = 2
a = save(CDialog.filename, receivetext.Text)
End Sub

Private Sub clearbtn_Click()
receivetext.Text = ""
End Sub

Private Sub Form_Load()
lianxu = False
a = Icon_Add(Form1.hwnd, Me.Icon)

    lblTitle.Caption = "小小工具箱——" + SSTab1.Caption
    break.Enabled = False
    sendbtn1.Enabled = False
    break1.Enabled = False

    Label9.Caption = "本机IP:" + Winsock1.LocalIP
    MakeWindow Me
    Load Winsock2(1)
    receivetext1.Text = "": receivetext2.Text = ""
    Timer2.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
Icon_Del Me.hwnd
End Sub


Private Sub imgTitleClose_Click()
Icon_Del Form1.hwnd
    Unload Me
    End
End Sub

Private Sub imgTitleHelp_Click()
Form1.Show
End Sub

Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMinimize_Click()
Dim a As Integer
     
     xb = CMenu()
    Me.Hide
     lproc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf DialogProc)
   
    
End Sub

Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lianjie_Click()

If porttext.Text = "" Or Val(porttext.Text) > 65535 Then MsgBox "端口号输入错误！", , "错误！": GoTo en1
If ipcheck(iptext.Text) = False Then GoTo en1 Else iptext.SetFocus
On Error GoTo on_error
Winsock1.RemoteHost = iptext.Text
Winsock1.RemotePort = porttext.Text
Winsock1.localport = localport.Text
Winsock1.connect
lianjie.Enabled = False
listen.Enabled = False
break.Enabled = True
sendbtn1.Enabled = False
lianxu = False
GoTo en1
on_error:
MsgBox "可能本地端口被占用！" + vbNewLine + "请更换本地端口后再试", , "错误"
Winsock1.Close
lianjie.Enabled = True
listen.Enabled = True
break.Enabled = False
sendbtn1.Enabled = False
en1:
End Sub

Private Sub listen_Click()

If porttext.Text = "" Or Val(porttext.Text) > 65535 Then MsgBox "端口号输入错误！", , "错误！": GoTo en
On Error GoTo err
Winsock1.localport = localport.Text
Winsock1.listen

lianjie.Enabled = False
listen.Enabled = False
break.Enabled = True
sendbtn1.Enabled = False
GoTo en
err:
MsgBox "可能本地端口被占用！" + vbNewLine + "请更换本地端口后再试", , "错误"
Winsock1.Close
lianjie.Enabled = True
listen.Enabled = True
break.Enabled = False
sendbtn1.Enabled = False
en:
lianxu = True
End Sub

Private Sub localport_Change()
If localport.Text = "" Then localport.SetFocus: GoTo en2
If Val(localport.Text) > 65535 Or Val(localport.Text) < 0 Then localport.SetFocus: MsgBox "端口号输入错误！", , "错误！"
en2:
End Sub

Private Sub porttext_Change()
If porttext.Text = "" Then porttext.SetFocus: GoTo en2
If Val(porttext.Text) > 65535 Or Val(porttext.Text) < 0 Then porttext.SetFocus: MsgBox "端口号输入错误！", , "错误！"
en2:
End Sub
Private Sub savebtn1_Click()
Dim a As Boolean
CDialog.DefaultExt = "txt"
CDialog.Action = 2
a = save(CDialog.filename, receivetext1.Text)
End Sub

Private Sub savebtn2_Click()
Dim a As Boolean
CDialog.DefaultExt = "txt"
CDialog.Action = 2
a = save(CDialog.filename, receivetext2.Text)
End Sub

Private Sub scanbtn_Click()

portnum1 = 0
result = ""
On Error GoTo err
If ipcheck(ipaddtext.Text) = False Then ipaddtext.SetFocus: Exit Sub
If portcheck(portlisttext.Text) = False Then MsgBox "端口设置错误，请重新输入！", , "错误": portlisttext.SetFocus: Exit Sub
portlisttext = change(portlisttext, ",,", ",", True)
portlisttext = change(portlisttext, "--", "-", True)
If Left$(portlisttext, 1) = "," Then portlisttext = right$(portlisttext, Len(portlisttext) - 1)

Winsock3.RemoteHost = ipaddtext.Text
scanbtn.Enabled = False
portlisttext.Enabled = False