Question

VB6.0 扫描端口

用VB6.0 编一个扫描本机端口的工具，把已开放端口号全部显示在标签里......在线等..谢谢..............

Answer 1

计算机网络技术的日益发展和普及，为信息共享提供了一条全球性的高速通道，但目前采用的TCP/IP协议族潜在着安全漏洞，其安全机制并不健全，如何保护企业内部网络中的资源及信息不受外部攻击者肆意破坏或盗窃，是企业网络安全需要解决的重要问题。当我们担心被黑客攻击或怀疑电脑被植入木马时，我们往往求助于防火墙,本系统即通过实时监控全部TCP连接的方法来实现防黑客攻击。同时网络管理人员在整个网络运行期间，能否实时监控联网计算机的运行状态和操作对网络安全具有极其重要的作用.下面就以Visual Basic 6.0作为开发工具讲述两个主要模块的设计和实现。

系统概述

该系统由两个子系统组成：服务器端系统和客户端(工作站)系统。服务器端系统安装在网络管理人员的计算机上，用于实施各种对联网计算机的监控操作;客户端系统安装在每台联网的计算机上，它运行后以图标的方式出现在系统任务栏的提示区中，不影响工作站的其他操作，只用于响应服务器端的监控命令，并根据服务的需要，及时采样工作站的相应数据返回给服务器端。该系统的运行环境可以运行于Win98、Win95或WinNT、Win2000下。在系统的开发中，引入了WINSOCK通讯控件，除此之外，为较好地实现各项监控操作，还用到了几个API函数。

系统功能

1、监控全部TCP连接：实时监控所有服务器端口的连接情况、及时对异常连接发出警告并提示用户删除异常连接;

2、屏幕监控：该功能允许服务器随时把被监控工作站的屏幕画面抓取到服务器中，网络管理人员对相应工作站所进行的操作一目了然，若发现有非法操作即可采取发送警告或强制措施，强迫其停止相应操作;

3、对工作站进行锁机、关机、限制鼠标活动等;

4、服务器和工作站之间的信息互送。

功能的实现

1、监控全部TCP连接

TCP/IP(Transmission Control Protocol/Internet Protocol：传输控制协议/互联网协议)是一个包括TCP、IP、 UDP、ARP、RARP和ICMP等在内的网络协议集。TCP/IP经常被称为“将Internet绑定在一起的粘合剂”，它允许在空间上分离的多个信息网络连接在一起形成一个巨大的虚拟网络。TCP和UDP(用户数据报协议)是两个最常用的数据传输协议，它们都使用设置监听端口的方法来完成数据传输。

在本文中讨论TCP连接。通过使用TCP， Internet客户机可以打开到另一个Internet客户机的虚拟连接并传送数据流。与UDP不同，TCP协议通过重传丢失的数据报保证传输的可靠性。它也保证在接收端的应用程序按发送的顺序将接收到的位和字节重新组装起来以获取完整的数据。

要获得与服务器系统中全部有效的TCP连接，用到GetTcpTable这个API函数，它定义如下：

Private Declare Function GetTcpTable Lib "iphlpapi.

dll" (ByRef pTcpTable As MIB_TCPTABLE, ByRef

pdwSize As Long, ByVal bOrder As Long) As Long

其中参数pPcpTable是已生成的 TCP连接表缓冲区的指针，参数pdwsize是缓冲区大小(当缓冲区不够大时，该参数返回实际需要的大小)，参数bOrder指示连接表是否需要按“Local IP”、“Localport”、“Remote IP”、“Remote port”依次进行排序，1为按此顺序。

通过一个TIMEER控件的TIMER的事件来比较前后两个TCP连接表，我们可以立即发现异常并发出警告。本系统用声音和报警标志提醒用户注意可能的外界入侵。收到警告信号后，我们应首先将可疑连接删除掉，SetTcpEntry函数可以帮助我们删除可疑连接。其定义为：

Private Declare Function SetTcpEntry Lib "iphlpapi.

dll" (ByRef pTcpTable As MIB_TCPROW) As Long

其中参数pTcptable为指向tcp表行的指针。然后将欲删连接的状态置为MIB_TCP_STATE_DELETE_TCB(值为12)即可删除该连接。

TIMER事件源代码：

Private Sub Timer1_Timer()

Dim Return1 As Long, i As Long

Dim Tmp1 As Long, Tmp2 As Long

Dim Ip_Buf(1 To 4) As Byte

Dim Win_Path As String, Tmp3 As String

Return1 = GetTcpTable(TCP1, Len(TCP1), 1)

If Last_Num_Of_Entries <>0 And _

Last_Num_Of_Entries <>TCP1.dwNum_Of_Entries Then

'异常时发出警告

Picture1.Visible = True '警告标志

On Error Resume Next

Win_Path = String(145, 0)

'利用API函数GetWindowsDirectory获得当前系统目录

i = GetWindowsDirectory(Win_Path, 145)

Win_Path = Left(Win_Path, i)

'利用API函数sndPlaySound发出报警声音

i = sndPlaySound(Win_Path + "\Media\Ding.wav", &H1)

On Error GoTo 0

Else

If Picture1.Visible = True Then

Picture1.Visible = False

End If

End If

Last_Num_Of_Entries = TCP1.dwNum_Of_Entries

Select Case Return1

Case 0&:

Text1 = "": Combo1.Clear

For i = 0 To TCP1.dwNum_Of_Entries - 1

Tmp3 = Str(i + 1) + " "

Select Case TCP1.TCP_Table(i).dwState

' 显示连接状态

Case 1: Tmp3 = Tmp3 + "CLOSED"

Case 2: Tmp3 = Tmp3 + "LISTENING"

Case 3: Tmp3 = Tmp3 + "SYN_SENT"

Case 4: Tmp3 = Tmp3 + "SYN_RCVD"

Case 5: Tmp3 = Tmp3 + "ESTABLISHED"

Case 6: Tmp3 = Tmp3 + "FIN_WAIT1"

Case 7: Tmp3 = Tmp3 + "FIN_WAIT2"

Case 8: Tmp3 = Tmp3 + "CLOSE_WAIT"

Case 9: Tmp3 = Tmp3 + "CLOSING"

Case 10: Tmp3 = Tmp3 + "LAST_ACK"

Case 11: Tmp3 = Tmp3 + "TIME_WAIT"

Case 12: Tmp3 = Tmp3 + "DELETE_TCB"

End Select

Combo1.AddItem Tmp3 ' 填充列表以供用户删除

' 本地IP

Tmp3 = Tmp3 + ":" + vbCrLf + vbTab + "Local: "

'CopyMemory为API函数

CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwLocalAddr, 4

Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + _

CStr(Ip_Buf(2)) + "."+ CStr(Ip_Buf(3)) _

+"." + CStr(Ip_Buf(4))

Tmp1 = TCP1.TCP_Table(i).dwLocalPort

' 本地端口

Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256

' 远程IP

Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbTab + "Remote: "

CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwRemoteAddr, 4

Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) _

+ "."+ CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4))

' 远程端口

Tmp1 = TCP1.TCP_Table(i).dwRemotePort

Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256

Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbCrLf

Text1 = Text1 + Tmp3

Next i

Case 50&:

MsgBox "系统不支持该API函数": End

Case 87:

MsgBox "无效的参数": End

Case 111&:

MsgBox "缓冲区溢出": End

Case 232&:

MsgBox "无数据": End

End Select

End Sub

用于删除连接的CLICK事件源代码：

Private Sub delete_Click()

Dim Return1 As Long

If Combo1.ListIndex <0 Then Exit Sub

' 将欲删连接的状态置为值为12

TCP1.TCP_Table(Combo1.ListIndex).dwState = 12

' 执行删除

Return1 = SetTcpEntry(TCP1.TCP_Table(Combo1.ListIndex))

If Return1 = 0 Then

MsgBox "删除成功"

Else

MsgBox "删除失败"

End If

Timer1_Timer

End Sub

2、屏幕监控

当服务器系统发现TCP异常连接时，可通过屏幕监控功能将局域网中被监控工作站的屏幕画面抓取到服务器中并实施相应措施，如对工作站锁机或关机等。此处用到WINSOCK控件，其通讯原理请参阅相关资料，屏幕监控功能用到TCP协议，为了达到更好的效果,可在窗体中加入TIMER控件,设定TIMER事件。

(1) 工作站端

侦听并响应服务器端发出的连接请求和屏幕抓取。其中屏幕抓取功能可通过API函数实现：

Dim a As String

Winsock1.GetData a, vbString

Select Case a

Case "zp"

Picture1.AutoRedraw = True

Picture1.ScaleMode = 1

lDesktop = GetDesktopWindow()

lDC = GetDC(lDesktop)

BitBlt Picture1.hdc, 0, 0, Screen.Width, _

Screen.Height, lDC,0, 0, vbSrcCopy

'获取图像数组

SavePicture Picture1.Image, filename

Winsock1.SendData "okm"

Dim myfile() As Byte

Case "fir" '传第一块图

Open filename For Binary As #1

filelen = LOF(1)

ReDim myfile(1 To blocksize) As Byte

'（const blocksize=3072）

Get #1, , myfile

Winsock1.SendData myfile

curpos = blocksize

Case "next" ‘传其它块

If curpos = filelen Then

Winsock1.SendData "end"

Close #1

Exit Sub

End If

j = curpos + blocksize

If j >filelen Then

j = filelen - curpos

Else

j = blocksize

End If

ReDim myfile(1 To j) As Byte

Get #1, , myfile

Winsock1.SendData myfile

curpos = curpos + j

End Select

注意：以上功能在WINSOCK的DataArrival事件中实现。抓取的图象数据量较大，所以需要分块传输。

(2) 服务器端

DataArrival 事件代码：

Dim receivefile() As Byte

ReDim receivefile(bytesTotal) As Byte

Winsock1.GetData receivefile, vbArray + vbByte

'告诉Winsock控件收到的是字节数组类型的数据

If Chr(receivefile(0)) = "o" And _

Chr(receivefile(1)) = "k" And _

Chr(receivefile(2)) = "m" Then

If Dir$(filename) <>"" Then Kill filename

' 打开文件，准备存储图像

Open filename For Binary As #1

filelen = 0

Winsock1.SendData "fir"

Exit Sub

End If

If Chr(receivefile(0)) = "e" And _

Chr(receivefile(1)) = "n" And _

Chr(receivefile(2)) = "d" Then

Label1.Caption = "end"

Close #1

Picture1.Picture = LoadPicture(filename) '显示图象

Exit Sub

End If

Put #1, , receivefile

Winsock1.SendData "next"

3、其它功能

主要用到一些API函数，如实现屏幕锁定和解锁操作可使用Enable Window,实现关机功能用ExitWindowsEx, 服务器和工作站之间的信息互送用到WINSOCK控件的UDP协议,具体用法请参阅有关资料。

结束语

通过在基本的网络监控系统增加入侵检测，就能够极大提高网络的整体安全性，使之更灵敏、更智能，大大降低入侵的成功率。

Answer 2

分二步：
一、建立模块，复制下面代码：
Option Explicit

Public MIBICMPSTATS As MIBICMPSTATS
Public Type MIBICMPSTATS
dwEchos As Long
dwEchoReps As Long
End Type

Public MIBICMPINFO As MIBICMPINFO
Public Type MIBICMPINFO
icmpOutStats As MIBICMPSTATS
End Type

Public MIB_ICMP As MIB_ICMP
Public Type MIB_ICMP
stats As MIBICMPINFO
End Type

Public Declare Function GetIcmpStatistics Lib "iphlpapi.dll" (pStats As MIBICMPINFO) As Long
Public Last_ICMP_Cnt As Integer 'ICMP count

Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type

Type MIB_TCPTABLE
dwNumEntries As Long
table(100) As MIB_TCPROW
End Type
Public MIB_TCPTABLE As MIB_TCPTABLE

Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW) As Long 'This is used to close an open port.
Public IP_States(13) As String
Private Last_Tcp_Cnt As Integer 'TCP connection count

'-------------------------------------------------------------------------------
'Types and functions for winsock:

Private Const AF_INET = 2
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const SOCKET_ERROR As Long = -1
Private Const WS_VERSION_REQD As Long = &H101

Type HOSTENT
h_name As Long ' official name of host
h_aliases As Long ' alias list
h_addrtype As Integer ' host address type
h_length As Integer ' length of address
h_addr_list As Long ' list of addresses
End Type

Type servent
s_name As Long ' (pointer to string) official service name
s_aliases As Long ' (pointer to string) alias list (might be null-seperated with 2null terminated)
s_port As Long ' port #
s_proto As Long ' (pointer to) protocol to use
End Type

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type

Public Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
Private Declare Function inet_ntoa Lib "WSOCK32.DLL" (ByVal inn As Long) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (Addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal host_name As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Declare Function lstrlen Lib "kernel32" (ByVal lpString As Any) As Integer
Private Blocked As Boolean

'-------------------------------------------------------------------------------
'Function for checking for new connections and blocking them if specified:
Sub CheckTcp()
Dim Item As ListItem, LTmp As Long
Dim x As Integer, i As Integer, n As Integer
Dim RemA As String, LocP As String, RemP As String
Dim tcpt As MIB_TCPTABLE

Blocked = False
LTmp = Len(MIB_TCPTABLE) 'Size of the TCP table
GetTcpTable tcpt, LTmp, 0 'Load the TCP table data.
x = tcpt.dwNumEntries 'Number of TCP entries.

If x > Last_Tcp_Cnt Or x < Last_Tcp_Cnt Then '+ or - an entry detected.
frmMain.RefreshNS

For i = 0 To tcpt.dwNumEntries - 1

RemA = GetAscIP(tcpt.table(i).dwRemoteAddr) 'Retrieve the IP address
RemP = ntohs(tcpt.table(i).dwRemotePort) 'Retrieve the remote port
LocP = ntohs(tcpt.table(i).dwLocalPort) 'Retrieve the local port

If frmMain.Filtering = False Then Exit For 'Exit the loop if filtering is off.

'//Address blocking
If frmMain.chkAct(0).Value = 1 Then
For n = 1 To frmMain.lvwFilter(0).ListItems.Count
If frmMain.lvwFilter(0).ListItems.Item(n).Checked = False Then GoTo NextLoop
If RemA = frmMain.lvwFilter(0).ListItems.Item(n).Key And tcpt.table(i).dwState <> 2 Then
If frmMain.Logging = True And frmMain.chkLog(2).Value = 1 Then rLog RemA, LocP, RemP, "Blocked Address", Time, True
Blocked = True
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
DoEvents
GoTo EndLp
End If
NextLoop:
Next n
End If

'//Remote port blocking
If frmMain.chkAct(1).Value = 1 Then
For n = 1 To frmMain.lvwFilter(1).ListItems.Count
If frmMain.lvwFilter(1).ListItems.Item(n).Checked = False Then GoTo NextLoop2
If RemP = frmMain.lvwFilter(1).ListItems.Item(n).Text And tcpt.table(i).dwState <> 2 Then
If frmMain.Logging = True And frmMain.chkLog(2).Value = 1 Then rLog RemA, LocP, RemP, "Blocked Remote Port", Time, True
Blocked = True
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
DoEvents
GoTo EndLp
End If
NextLoop2:
Next n
End If

'//Local port blocking
If frmMain.chkAct(2).Value = 1 Then
For n = 1 To frmMain.lvwFilter(2).ListItems.Count
If frmMain.lvwFilter(2).ListItems.Item(n).Checked = False Then GoTo NextLoop3
If LocP = frmMain.lvwFilter(2).ListItems.Item(n).Text And tcpt.table(i).dwState <> 2 Then
If frmMain.Logging = True And frmMain.chkLog(2).Value = 1 Then rLog RemA, LocP, RemP, "Blocked Local Port", Time, True
Blocked = True
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
DoEvents
GoTo EndLp
End If
NextLoop3:
Next n
End If
EndLp:
Next i
End If
Last_Tcp_Cnt = tcpt.dwNumEntries 'Update the TCP count

'//ICMP Statistics
If GetIcmpStatistics(MIBICMPINFO) <> 0 Then
frmMain.SBar.Panels(3).Text = "ICMP failure"
rLog "ICMP", "ICMP failure", "", "", Time
Else
With MIBICMPINFO.icmpOutStats
If Last_ICMP_Cnt <> .dwEchoReps + .dwEchos Then
frmMain.SBar.Panels(3).Text = "ICMP Echo Requests: " & .dwEchoReps & ", Echo Replies: " & .dwEchos
rLog "ICMP", "Echo Requests: " & .dwEchoReps, "Echo Replies: " & .dwEchos, "", Time
Last_ICMP_Cnt = .dwEchoReps + .dwEchos 'Update the ICMP count
End If
End With
End If

If Blocked = True Then frmMain.RefreshNS
End Sub

'-------------------------------------------------------------------------------
'Sub for defining IP state constants:
Sub InitStates()
IP_States(0) = "UNKNOWN"
IP_States(1) = "CLOSED"
IP_States(2) = "LISTENING"
IP_States(3) = "SYN_SENT"
IP_States(4) = "SYN_RCVD"
IP_States(5) = "ESTABLISHED"
IP_States(6) = "FIN_WAIT1"
IP_States(7) = "FIN_WAIT2"
IP_States(8) = "CLOSE_WAIT"
IP_States(9) = "CLOSING"
IP_States(10) = "LAST_ACK"
IP_States(11) = "TIME_WAIT"
IP_States(12) = "DELETE_TCB"
End Sub

'-------------------------------------------------------------------------------
'Function for obtaining the IP number of a hostname:
Public Function GetIPFromHostName(HostName$) As Long
Dim phe&, heDestHost As HOSTENT
Dim addrList&, retIP&
retIP = inet_addr(HostName$)
If retIP = &HFFFF Then
phe = gethostbyname(HostName$)
If phe <> 0 Then
CopyMemory heDestHost, ByVal phe, Len(heDestHost)
CopyMemory addrList, ByVal heDestHost.h_addr_list, 4
CopyMemory retIP, ByVal addrList, heDestHost.h_length
Else
retIP = &HFFFF
End If
End If
GetIPFromHostName = retIP
End Function

'-------------------------------------------------------------------------------
'Function for obtaining the hostname of an IP number:
Public Function GetHostNameFromIP(ByVal sAddress As String) As String
Dim ptrHosent As Long
Dim hAddress As Long
Dim nbytes As Long

If SocketsInitialize1() Then
hAddress = inet_addr(sAddress) 'Convert string address to long, this was the cause of meny errors, so do not mess with this.
If hAddress <> SOCKET_ERROR Then
DoEvents
ptrHosent = gethostbyaddr(hAddress, 4, AF_INET) 'Obtain a pointer to the HOSTENT structure.
DoEvents
If ptrHosent <> 0 Then
CopyMemory ptrHosent, ByVal ptrHosent, 4 'Convert address and get resolved hostname.
nbytes = lstrlen(ByVal ptrHosent)
If nbytes > 0 Then
sAddress = Space$(nbytes)
CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
GetHostNameFromIP = sAddress
End If
Else
GetHostNameFromIP = sAddress 'No DNS entry, so set it back to the IP.
End If
SocketsCleanup
Else 'SOCKET_ERROR
GetHostNameFromIP = "Invalid IP."
End If
Else 'Sockets failed to initialize.
Exit Function
End If
End Function

'-------------------------------------------------------------------------------
'Function for obtaining the IP number:
Public Function GetAscIP(ByVal inn As Long) As String
Dim nStr&
Dim lpStr As Long
Dim retString As String
retString = String(32, 0)
lpStr = inet_ntoa(inn)
If lpStr Then
nStr = lstrlen(lpStr)
If nStr > 32 Then nStr = 32
CopyMemory ByVal retString, ByVal lpStr, nStr
retString = Left(retString, nStr)
GetAscIP = retString
Else
GetAscIP = "Unable to get IP"
End If
End Function

'-------------------------------------------------------------------------------
'Function for Initializing a socket:
Private Function SocketsInitialize1() As Boolean
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize1 = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

'-------------------------------------------------------------------------------
'Sub for socket clean up:
Private Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub

Public Function RefreshNS() As String
'On Error Resume Next
'Dim Item As ListItem
Dim LTmp As Long, State As Long, Val As Long
Dim x As Integer, i As Integer, n As Integer
Dim rHost As String, LocP As String
Dim tcpt As MIB_TCPTABLE

LTmp = Len(MIB_TCPTABLE)
GetTcpTable tcpt, LTmp, 1

For i = 0 To tcpt.dwNumEntries - 1
State = tcpt.table(i).dwState
If ((State <> 2)) Then
rHost = GetAscIP(tcpt.table(i).dwRemoteAddr)
LocP = ntohs(tcpt.table(i).dwLocalPort) 'Retrieve the actual IP
If (State <> 2) Then 'If not listening then...
RefreshNS = RefreshNS & "Local Port:" & LocP & " Remote Port:" & ntohs(tcpt.table(i).dwRemotePort) & vbNewLine
Else
RefreshNS = RefreshNS & "Local Port:" & LocP & " Remote Port:n\a" & vbNewLine
End If
End If
Next i
End Function

二、窗体内调用举例：

Private Sub Command1_Click()
MsgBox RefreshNS
End Sub