一个VB程序的编写，高手进来看看，追加至最高分！

Posted 2023-05-16

vb题目：从100～200随机产生60个数，在产生的60个数中，偶数按从小到大排序，基数从打大到小排序。
要求：创建3个文本框（只能是文本框，图片框等不行）：第一个文本框输出产生的60个随机数，第二、三个分别输出排序后的奇数和偶数；四个命令按钮，依次为：产生随机数，排序，清空，结束。
本人写的程序总是有这样和那样的问题，求一方案，希望高手踊跃提供，追加分数至最高分！
请注意，题目完整描述为：从100～200随机产生60个数，在产生的60个数中，偶数从小到大排序，奇数从大到小排序。随机产生的60个数字是没有重复的，
要求：创建3个文本框（只能是文本框，图片框等不行）：第一个文本框输出产生的60个随机数，这60个数字按10个数一行排列，共6行，第二、三个分别输出排序后的奇数和偶数，奇数偶数输出没有上述text1的“按10个数一行排列”的要求，只要求有空格和换行即可；四个命令按钮，依次为：产生随机数，排序，清空，结束。

请在解答时认真审题，程序尽量简洁，我是个初学者，更希望有更加健康的程序，函数不要太复杂，最好能用基本的函数并且说明函数的意思，以便于我能更加了解整个过程，请尽量添加每步的描述，谢谢

另外，答案采纳我会认真考虑的，能运算出结果不是唯一判断标准！！谁是自己写的等问题我清楚的，尤其请kciych放心！··!

6-2 03:12
首先，建立3个text和4个command，名称不改了
text1：原始数字
text2：排序后奇数
text3：排序后偶数
command1：产生随机数
command2：排序
command3：清空
command4：结束

其次，在设计状态把所有text的属性multiline修改成true，方便看数字

最后贴上程序代码，你可以拷贝尝试调试一下看看，我这里成功了：）

Option Explicit
Dim X(1 To 60) As Integer, Os() As Integer, Js() As Integer
Dim I As Integer, J As Integer
Dim N As Integer, M As Integer
Dim Temp As Integer

Private Sub Command1_Click()
Text1 = ""
For I = 1 To 60 '产生100到200的随机数
X(I) = Int(Rnd * 100) + 100
Text1 = X(I) & "," & Text1
Next I
End Sub

Private Sub Command2_Click()
N = 0
M = 0
For I = 1 To 60 '根据奇偶安排随机数进入各自数组
If X(I) Mod 2 = 0 Then
N = N + 1
ReDim Preserve Os(1 To N)
Os(N) = X(I)
Else
M = M + 1
ReDim Preserve Js(1 To M)
Js(M) = X(I)
End If
Next I

For I = 1 To N - 1 '冒泡排序排偶数
For J = I + 1 To N
If Os(I) < Os(J) Then
Temp = Os(I)
Os(I) = Os(J)
Os(J) = Temp
End If
Next J
Next I

For I = 1 To M - 1 '冒泡排序排奇数
For J = I + 1 To M
If Js(I) > Js(J) Then
Temp = Js(I)
Js(I) = Js(J)
Js(J) = Temp
End If
Next J
Next I

Text2 = ""
Text3 = ""
For I = 1 To M
Text2 = Js(I) & "," & Text2
Next I
For I = 1 To N
Text3 = Os(I) & "," & Text3
Next I
End Sub

Private Sub Command3_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()
Randomize '随机时钟
End Sub

6-2 13:10
最后祝你顺利哈，偶睡觉鸟，有问题给偶留言啦~

无语了，居然有人这么无耻，抄我的改了我的注释而已，我可是半夜3点多写完的程序，虽然代码仅区区几行，但是请尊重别人的成果！！
tong_ai_ya如果你会请写出自己的东西，没有必要把我的说明和变量定义都抄了过去，大家都知道写程序有很多个人习惯的，一般一看就能看出来，我对你无语，太让人心寒了。。。

楼主你好，你这个问题我晚上来帮你解决，我现在去考试了。
现在问你一个问题，100~200数字中取60个数字可否有重复？我现在写的程序是有重复的，如果你的意思是没有重复数字那么我也晚上来改哦~考试去啦嘻嘻：）

不好意思哈，又是这个点，考完试出去疯了嘿嘿~
根据你的不重复要求我更改了一个算法，大体感觉上应该是优化的，懒得算啦：P
其实我以前和楼主一样，碰到程序问题就很头疼，尤其以前网上搜资料不像现在这么多这么方便。往往一个很简单很基础的问题可以让我做一个通宵，所以我觉得现在休息的时候帮助一下其他人的程序学习很有好处，尤其有这么一个好的平台：）
说实话，楼主初学vb的话，只要能够独立看懂程序就行，然后再尝试自己动手写程序，用vb的一个好处就是F5和F8，自己找碴自己解决还是很有成就感的哦~
我专业和这个完全没有关系，但是还是对编程很有兴趣，如果楼主是编程兴趣爱好者，我们可以相互交流一下，共同进步哈：D

以下是代码，控件没有改动
Option Explicit '强制变量定义，个人习惯而已
Dim X(1 To 60) As Integer, Os() As Integer, Js() As Integer '定义数组，X是随机数字存放的数组；Os是偶数存放的数组，由于随机偶数不确定，因此采用不定长数组形式
Dim Sz(1 To 100) As Integer '这个数组用来存放100~199（上下含）的所有数字，见下述
Dim I As Integer, J As Integer
Dim N As Integer, M As Integer
Dim Temp As Integer, T As Integer '两个临时变量
Dim Si As Boolean '也是一个临时变量，用布朗值描述代表真伪判断

Private Sub Command1_Click()
Text1 = ""
For I = 1 To 100
Sz(I) = I + 99
Next I
For I = 1 To 60 '产生100到200的随机数并且取出数字不重复
Do '常规思路是每生成一个数字，就让它与之前的所有数字进行比较判断是否重复
Si = False '而这里我用了另一种思路，即将所有数字进行标记，以取出的形式获得，形象地说，可以比喻成从篮子里拿苹果：）
T = Int(Rnd * 100) + 1 '我想说，编程时同一个目标是可以由不同的过程来完成的，打开思路想咯，我没仔细考虑过两种算法的优劣，懒得去算啦，偶也不是学这个的。。。只是感觉我现在用的方法速度更快~
If Sz(T) <> 0 Then
X(I) = Sz(T)
Sz(T) = 0
Si = True
End If
Loop Until (Si = True)
If ((I - 1) Mod 10 = 0) And (I <> 1) Then '以6行形式输出，每行10个数字
Text1 = Text1 & vbCrLf '这个问题很简单，就是在文本框中加上chr(10)和chr(13)，vb中可以用vbCrLf表示，就是回车和换行啦
End If
If (I - 1) Mod 10 = 0 Then
Text1 = Text1 & X(I)
Else
Text1 = Text1 & " " & X(I)
End If
Next I
End Sub

Private Sub Command2_Click()
N = 0
M = 0
For I = 1 To 60 '根据奇偶安排随机数进入各自数组
If X(I) Mod 2 = 0 Then
N = N + 1
ReDim Preserve Os(1 To N)
Os(N) = X(I)
Else
M = M + 1
ReDim Preserve Js(1 To M)
Js(M) = X(I)
End If
Next I

For I = 1 To N - 1 '冒泡排序排偶数
For J = I + 1 To N
If Os(I) < Os(J) Then
Temp = Os(I)
Os(I) = Os(J)
Os(J) = Temp
End If
Next J
Next I

For I = 1 To M - 1 '冒泡排序排奇数
For J = I + 1 To M
If Js(I) > Js(J) Then
Temp = Js(I)
Js(I) = Js(J)
Js(J) = Temp
End If
Next J
Next I

Text2 = ""
Text3 = ""
For I = 1 To M
Text2 = Js(I) & " " & Text2
Next I
For I = 1 To N
Text3 = Os(I) & " " & Text3
Next I
End Sub

Private Sub Command3_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()
Randomize '随机时钟 如果尝试去掉这一行，你会发现每次随机都是相同的数字：P
End Sub 参考技术A 看了楼上的楼上的代码真别扭 逆向思维是不错 不过你的逆向思维没有减少运算量

改了楼上的楼上的楼上的。。。。楼上的某位的代码
I = 1
Do While I < 61
Randomize
A(I) = Int(Rnd * (200 - 100) + 100)
If InStr(Text1.Text, A(I)) > 0 Then
Else
Text1.Text = Text1.Text & A(I) & " "
If I Mod 10 = 0 Then Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1) & vbCrLf
I = I + 1
End If
Loop
只加了这段

这个至少看起来不那么费力InStr(Text1.Text, A(I)) 判断A(I)是否在Text1.Text中

呵呵重在参与

'############代码开始############
Option Explicit

Dim A(1 To 60) As Integer, B() As Integer, C() As Integer, D As Integer, E As Integer
Dim I As Integer, J As Integer
Dim NumStr As Integer

Private Sub Command1_Click()
Text1.Text = ""
I = 1
Do While I < 61
Randomize
A(I) = Int(Rnd * (200 - 100) + 100)
If InStr(Text1.Text, A(I)) > 0 Then
Else
Text1.Text = Text1.Text & A(I) & " "
If I Mod 10 = 0 Then Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1) & vbCrLf
I = I + 1
End If
Loop
End Sub

Private Sub Command2_Click()
D = 0: E = 0
For I = 1 To 60
If A(I) Mod 2 = 0 Then
D = D + 1
ReDim Preserve B(1 To D)
B(D) = A(I)
Else
E = E + 1
ReDim Preserve C(1 To E)
C(E) = A(I)
End If
Next I

For I = 1 To D - 1
For J = I + 1 To D
If B(I) < B(J) Then
NumStr = B(I)
B(I) = B(J)
B(J) = NumStr
End If
Next J
Next I

For I = 1 To E - 1
For J = I + 1 To E
If C(I) > C(J) Then
NumStr = C(I)
C(I) = C(J)
C(J) = NumStr
End If
Next J
Next I

Text2.Text = ""
Text3.Text = ""
For I = 1 To E
Text2.Text = Text2.Text & C(I) & ","
If I Mod 10 = 0 Then Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1) & vbCrLf
Next I
For I = 1 To D
Text3.Text = Text3.Text & B(I) & ","
If I Mod 10 = 0 Then Text3.Text = Left(Text3.Text, Len(Text3.Text) - 1) & vbCrLf
Next I
End Sub

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub

Private Sub Command4_Click()
End
End Sub

'############代码结束############ 参考技术B 请楼主将以下代码粘贴到记事本,为存为"form.frm".再用VB打开即可!

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5805
ClientLeft = 60
ClientTop = 450
ClientWidth = 5160
LinkTopic = "Form1"
ScaleHeight = 5805
ScaleWidth = 5160
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text3
Height = 1335
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 3720
Width = 4935
End
Begin VB.TextBox Text2
Height = 1335
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 2040
Width = 4935
End
Begin VB.CommandButton Command4
Caption = "结束"
Height = 495
Left = 3960
TabIndex = 7
Top = 5160
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "清空"
Height = 495
Left = 2760
TabIndex = 6
Top = 5160
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "排序"
Height = 495
Left = 1560
TabIndex = 2
Top = 5160
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "产生随机数"
Height = 495
Left = 120
TabIndex = 1
Top = 5160
Width = 1335
End
Begin VB.TextBox Text1
Height = 1335
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 360
Width = 4935
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "偶数(小到大排序):"
Height = 180
Left = 240
TabIndex = 5
Top = 3480
Width = 1530
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "奇数(大到小排序):"
Height = 180
Left = 240
TabIndex = 4
Top = 1800
Width = 1530
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "随机数:"
Height = 180
Left = 240
TabIndex = 3
Top = 120
Width = 630
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'############代码开始############
Option Explicit

Dim A(1 To 60) As Integer, B() As Integer, C() As Integer, D As Integer, E As Integer
Dim I As Integer, J As Integer
Dim NumStr As Integer

Private Sub Command1_Click()
Text1.Text = ""
For I = 1 To 60
Randomize
A(I) = Int(Rnd * (200 - 100) + 100)
Text1.Text = Text1.Text & A(I) & ","
If I Mod 10 = 0 Then Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1) & vbCrLf
Next I
End Sub

Private Sub Command2_Click()
D = 0: E = 0
For I = 1 To 60
If A(I) Mod 2 = 0 Then
D = D + 1
ReDim Preserve B(1 To D)
B(D) = A(I)
Else
E = E + 1
ReDim Preserve C(1 To E)
C(E) = A(I)
End If
Next I

For I = 1 To D - 1
For J = I + 1 To D
If B(I) < B(J) Then
NumStr = B(I)
B(I) = B(J)
B(J) = NumStr
End If
Next J
Next I

For I = 1 To E - 1
For J = I + 1 To E
If C(I) > C(J) Then
NumStr = C(I)
C(I) = C(J)
C(J) = NumStr
End If
Next J
Next I

Text2.Text = ""
Text3.Text = ""
For I = 1 To E
Text2.Text = Text2.Text & C(I) & ","
If I Mod 10 = 0 Then Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1) & vbCrLf
Next I
For I = 1 To D
Text3.Text = Text3.Text & B(I) & ","
If I Mod 10 = 0 Then Text3.Text = Left(Text3.Text, Len(Text3.Text) - 1) & vbCrLf
Next I
End Sub

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub

Private Sub Command4_Click()
End
End Sub

'############代码结束############

"回答者：williamnapolv - 举人 五级 6-3 21:28",谢谢!受益了! 参考技术C 楼上的所有答案都缺少一功能－－生成的数都不重复
这是我写的一段程序，已经过调试确实可行
程序代码如下，
如有问题可以＋我QQ：252529013

Dim a(1 To 60) As Integer '定义数组A（60）用来保存随即数
Private Sub Command1_Click()'生成随即数按钮
Dim s As Integer, i As Integer, j As Integer
Text1 = ""
text2=""
text3=""
For i = 1 To 60 '生成60个不同的随即数
Randomize '更换随即种子
re: s = Int(101 * Rnd + 100) '生成随即数
If same(s) = False Then '如果随即数跟已有数无一相同，则把该随即数赋予数组
a(i) = s
Else '如果随即数跟已有数相同，则回到RE重新生成新的随即数
GoTo re
End If
Next i
For i = 1 To 60 '把数组里的60个数输出
Text1 = Text1 + " " & a(i) '在TEXT1显示
Next i
End Sub

Private Sub Command2_Click() '排序按钮
Dim i As Integer, j As Integer, t As Integer
Text2 = ""
Text3 = ""
For i = 1 To 60 '用冒泡法对60个数进行从小到大的排序
For j = i To 60
If a(i) > a(j) Then
t = a(i)
a(i) = a(j)
a(j) = t
End If
Next j
Next i
For i = 1 To 60 '把数组按1-60读取
If a(i) Mod 2 = 0 Then '如果数为偶数就输出
Text2 = Text2 + " " & a(i) '在text2显示
End If
Next i
For i = 60 To 1 Step -1 '把数组反向读取，那么读取的数为又大到小排序
If a(i) Mod 2 <> 0 Then '如果数为奇数就输出
Text3 = Text3 + " " & a(i) '在text3显示
End If
Next i

End Sub

Private Sub Command3_Click() '清除按钮
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

Private Sub Command4_Click() '结束按钮
End
End Sub
Function same(s As Integer) As Boolean '判断函数--用来判断是否生成了重复的数字
Dim i As Integer
For i = 1 To 60 '让s与整个数组进行比较，如果有相同的same函数返回true直，否则返回FALSE
If a(i) = s Then
same = True
Exit For '此处要退出循环，不然后面出现不同直就覆盖了
ElseIf a(i) <> s Then
same = False
End If
Next i
End Function 参考技术D text1：原始数字
text2：排序后奇数
text3：排序后偶数
command1：产生随机数
command2：排序
command3：清空
command4：结束

其次，在设计状态把所有text的属性multiline修改成true，方便看数字

最后贴上程序代码，你可以拷贝尝试调试一下看看，我这里成功了：）

Option Explicit
Dim X(1 To 60) As Integer, Os() As Integer, Js() As Integer
Dim I As Integer, J As Integer
Dim N As Integer, M As Integer
Dim Temp As Integer

Private Sub Command1_Click()
Text1 = ""
For I = 1 To 60 '产生100到200的随机数
X(I) = Int(Rnd * 100) + 100
Text1 = X(I) & "," & Text1
Next I
End Sub

Private Sub Command2_Click()
N = 0
M = 0
For I = 1 To 60 '根据奇偶安排随机数进入各自数组
If X(I) Mod 2 = 0 Then
N = N + 1
ReDim Preserve Os(1 To N)
Os(N) = X(I)
Else
M = M + 1
ReDim Preserve Js(1 To M)
Js(M) = X(I)
End If
Next I

For I = 1 To N - 1 '冒泡排序排偶数
For J = I + 1 To N
If Os(I) < Os(J) Then
Temp = Os(I)
Os(I) = Os(J)
Os(J) = Temp
End If
Next J
Next I

For I = 1 To M - 1 '冒泡排序排奇数
For J = I + 1 To M
If Js(I) > Js(J) Then
Temp = Js(I)
Js(I) = Js(J)
Js(J) = Temp
End If
Next J
Next I

Text2 = ""
Text3 = ""
For I = 1 To M
Text2 = Js(I) & "," & Text2
Next I
For I = 1 To N
Text3 = Os(I) & "," & Text3
Next I
End Sub

Private Sub Command3_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()
Randomize '随机时钟
End Sub 第5个回答  2007-06-02 建议你买一张VB考级用的无忧软件,是北京的.那上面有很多你说的这种题目.有详细的解答,是演示的那种.
我以前用过那软件.

高手指导：用VB我想编写个安全软件

就是可以监视系统目录的动作，比如是有病毒在进入系统，起到一个拦截的作用， 然后要你点同意之类的那些，就好像防火墙那样，还有其他的功能，我不要求有防火墙的所有功能
各位！我还不知道怎么编写呢，给点代码和例子

VB防火墙的开发原理2007-01-08 13:06以下为转载内容，本人不具有该文的任何权力，也不承担由此而起的任何责任。。
信息来源:http://www.chinanethack.com/

火墙主要有日志，网络状态列表,网络状态控制（如拦截）组成的。所以，我们要3个界面，一个是主界面——状态列表。一个是日志界面，一个是控制界面。
打开VB新建一个工程，添加一个窗体。一共要3个窗体，2个模块。太复杂了，我也在考虑怎么写才能让大家理解。文章写的不好，还请大家包含。说下原理：
一、监控 TCP连接

黑客程序或木马程序的本质是实现数据传输。TCP和UDP（用户数据文报协议）是两个最常用的数据传输协议，它们都使用设置监听端口的方法来完成数据传输。

实时监控所有端口的连接情况、及时对异常连接发出警告并提示用户删除异常连接，就可以有效地达到防黑目的。
使用微软的IP助手库函数（iphlpapi.dll）是一个捷径。其中的 GetTcpTable函数能返回当前系统中全部有效的 TCP连接。其定义为：
Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
其中参数一是 TCP连接表缓冲区的指针，参数二是缓冲区大小（当缓冲区不够大时，该参数返回实际需要的大小），参数三指示连接表是否需要按“Local IP”、“Localport”、“Remote IP”、“Remote port”依次进行排序。
对于监控 UDP连接表，可使用 GetUdpTable函数完成。由于在使用上完全类似，这里略去讨论。
二、异常警告及删除连接
通过定时比较前后两个 TCP连接表，我们可以立即发现异常并发出警告。收到警告信号后，我们应首先将可疑连接删除掉，然后再仔细查找系统中是否有安全漏洞或有可疑进程在工作。IP助手库函数中的 SetTcpEntry函数可以帮助我们删除可疑连接。其定义为：
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW) As Long 'This is used to close an open port.
在调用此函数之前，应将欲删连接的状态置为 MIB_TCP_STATE_DELETE_TCB（删除）。MIB_TCP_STATE_DELETE_TCB也是目前唯一可在运行时设置的状态。
好了，有了这些，一个放火墙的基本原理以及方法已经知道了，哈哈，我们想将这些函数，API封装起来。建立一个类模块，名称为modNetstat，代码如下
‘-------------------------------------------------modNetstat-------------------------------
Option Explicit

'定义一些ICMP协议

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
'GetIcmpStatistics函数能够让你查看当前ICMP数据报的流量
Public Declare Function GetIcmpStatistics Lib "iphlpapi.dll" (pStats As MIBICMPINFO) As Long
Public Last_ICMP_Cnt As Integer

'-------------------------------------------------------------------------------
'定义一些TCP协议

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
'GetTcpTable函数能返回当前系统中全部有效的 TCP连接
Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
'SetTcpEntry函数可以帮助我们删除可疑连接
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW) As Long 'This is used to close an open port.
'定义连接状态为13个
Public IP_States(13) As String
Private Last_Tcp_Cnt As Integer

'-------------------------------------------------------------------------------
'定义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
'inet_addr将IP地址从 点数格式转换成无符号长整型
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
'inet_ntoa将IP地址从 点数格式转换成ascii
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
'若该函数的返回值非0，则为存储器的地址。由于VB不能直接操作地址，所以还必须调用RtlMoveMemory函数将数据写入地址中
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
'定义网络状态
Sub InitStates()
IP_States(0) = "未知"
IP_States(1) = "已经关闭"
IP_States(2) = "监听"
IP_States(3) = "发送同步空闲字符"
IP_States(4) = "接收同步空闲字符"
IP_States(5) = "数据交换中"
IP_States(6) = "结束等待1"
IP_States(7) = "结束等待2"
IP_States(8) = "关闭等待"
IP_States(9) = "关闭中"
IP_States(10) = "命令正确应答"
IP_States(11) = "连接等待"
IP_States(12) = "删除TCP连接"
End Sub

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 = "无法取得IP"
End If
End Function
好了，日志是建立一个LOG文件，所以我们将所需要的函数封装一个类模块里。建立一个public模块。代码如下
'对日志的定义
Public Function Log(RemA As String, RemP As String, LocP As String, Txt As String)

Dim ff As Long
ff = FreeFile
‘打开log文件
Open App.Path & "\log.log" For Append As #ff
‘向log文件写入数据
Write #ff, Time & "-" & Date, RemA, RemP, LocP, Txt
‘将数据在日志窗口中显示出来
Frmlog.lstLog.ListItems.Add , , Time & "-" & Date
Frmlog.lstLog.ListItems(Frmlog.lstLog.ListItems.Count).SubItems(1) = RemA
Frmlog.lstLog.ListItems(Frmlog.lstLog.ListItems.Count).SubItems(2) = RemP
Frmlog.lstLog.ListItems(Frmlog.lstLog.ListItems.Count).SubItems(3) = LocP
Frmlog.lstLog.ListItems(Frmlog.lstLog.ListItems.Count).SubItems(4) = Txt
‘结束日志操作
Close #ff

End Function

好了，封装好了函数以及API数据库，下面是设计界面，以及功能结合了：）
先建立主窗体，这里将名称改为frmMain,我不想抹杀你们的创意，但是为了代码的最后测试成功，请你不要改变：）
点工程——部件，插入microsoft windows common controls 6.0 (sp4)如图1：

前面点上小钩，确定：）
回到桌面，双点击Toolbar，加入后，在上面右键属性。
依次插入按钮，如图2：

索引 标题 样式 图象
1 停止拦截 1-tbrcheck 暂时不说
2 刷新 0- tbrdefault
3 (空) 3-tbrseparator
4 查看日志 0- tbrdefault
插入2个ImageList空间，命名为imgHot和imgCold
依次插入图片，其实就是“停止拦截”等按钮上面显示的图片
在Toolbar上面右键属性如图3：

修改图象列表为imgcold,热图象列表为imghot
好了，在图2，我们看到图象图象后面的数字，着就是imgcold图片列表的数字：）
加入ListView控件
右键——属性——列首
索引 文本 宽度
1 远程IP 自己调节吧：）
2 远程端口
3 本地端口
4 状态
好了，在加入一个timer控件，名称为tmrRefresh，这个是用来刷新网络状态列表的。
将Interval设顶为250
最后完成界面如图：

添加代码如下：
‘定义一些常量
Private lC As Integer
Public Blk As String

Private a_RemA(1000) As String
Private a_LocP(1000) As String
Private a_RemP(1000) As String

Private a_Count As Long
‘下面是刷新网络状态的函数
Public Function RefreshTable(Optional force As Boolean = False)

On Error Resume Next

Dim tcpt As MIB_TCPTABLE, l As Long
Dim x As Integer, i As Integer
Dim RemA As String, LocP As String, RemP As String

l = Len(MIB_TCPTABLE)
GetTcpTable tcpt, l, 0
x = tcpt.dwNumEntries

If x < lC Or x > lC Or force Then

lC = x

ListView1.ListItems.Clear

For i = 0 To x - 1

RemA = GetAscIP(tcpt.table(i).dwRemoteAddr)
RemP = ntohs(tcpt.table(i).dwRemotePort)
LocP = ntohs(tcpt.table(i).dwLocalPort)
ListView1.ListItems.Add , "x" & i, RemA
ListView1.ListItems(ListView1.ListItems.Count).SubItems(1) = RemP
ListView1.ListItems(ListView1.ListItems.Count).SubItems(2) = LocP
ListView1.ListItems(ListView1.ListItems.Count).SubItems(3) = modNetstat.IP_States(state)

Next i

End If

End Function

Private Sub Form_Load()
‘调用网络状态函数
modNetstat.InitStates
‘一开始就刷新网络状态列表
RefreshTable
End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
‘判断是否为鼠标右键按下
If Button = 2 And ListView1.ListItems.Count > 0 Then
‘调用控制按钮，在下面将说到
frmMain.PopupMenu frmMenu.mnuConn
End If
End Sub

Private Sub tmrRefresh_Timer()
‘定时刷新网络状态列表
RefreshTable
End Sub

Public Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index

Case 1
‘停止功能按钮
If Button.Caption = "停止" Then

Button.Caption = "继续"
Button.ToolTipText = "继续开始工作"
tmrRefresh.Enabled = False
‘停止刷新网络状态列表，先面反之
Else

Button.Caption = "停止"
Button.ToolTipText = "停止工作"
tmrRefresh.Enabled = True

End If

Case 2
‘刷新按钮功能
RefreshTable

Case 4
‘显示日志
Frmlog.Show

End Select

End Sub
好了，下面定义控制按钮：）也就是网络状态上右键显示的拦截连接
新建一个窗体，命名为frmMenu，只需要有一个菜单，如图：

修改菜单属性：
标题 名称
mnuConn mnuConn
拦截连接 mnuDis
如图：

好了，添加代码如下：

Private Sub mnuDis_Click()

Dim tcpt As MIB_TCPTABLE
Dim l As Long
Dim i As Long
Dim RemA As String, RemP As String, LocP As String

i = Right(frmMain.ListView1.SelectedItem.Key, Len(frmMain.ListView1.SelectedItem.Key) - 1) + 1

RemA = frmMain.ListView1.ListItems(i)
RemP = frmMain.ListView1.ListItems(i).SubItems(1)
LocP = frmMain.ListView1.ListItems(i).SubItems(2)

l = Len(MIB_TCPTABLE)
GetTcpTable tcpt, l, 0

tcpt.table(i - 1).dwState = 12
‘断开TCP连接，还记得一开始说的函数吗？
SetTcpEntry tcpt.table(i - 1)
DoEvents
‘写入日志
Log RemA, RemP, LocP, "拦截连接"
End Sub
好了，最后是一个日志操作窗体，建立一个名称为Frmlog的窗体
一个用一个listview和command控件，调整位置如图

listview属性
名称 lstLog
列首索引 文本 大小自己调节
1 时间
2 IP
3 远程端口
4 本地端口
5 说明
添加代码如下
Private Sub Command1_Click()
Dim r As String

r = MsgBox("防火墙日志是有效检查黑客入侵的手段！" & vbCrLf & vbCrLf & "清楚日志?", vbQuestion & vbYesNo, "注意！")
‘如果按的是“是”那么
If r = vbYes Then

Dim ff As Long
ff = FreeFile
‘打开日志写入空数据，也就是清空日志
Open App.Path & "\log.log" For Output As #ff

Close #ff
‘清空列表
lstLog.ListItems.Clear

End If
End Sub
程序运行后，成功拦截我以前开发的一个盗取拨号密码的木马，如图：
第一次获得密码是没拦截，拦截后提示无法连接 参考技术A 我是做VB.NET的,但还是来探讨探讨...我是新手..
至于监视文件系统，你可以采用多线程和类似FileSystemWatcher之类的方法〉〉原理就是 一个线程，死循环，但是循环中的操作是阻塞线程的，这样达到目的。
防火墙要对Tcp/UDP协议进行监视，Port监视，可以调用API，或者自己的事件机制..
但是我还是建议你用VC/VB.NET之类的写服务，应为服务是不容易被结束的，达到安全的目的，服务还是很重要的啊

498483439
我是新手，一起学习 参考技术B 编完给个代码学习学习