VB加载一个控件，调试运行时正常，编译时出现拒绝的权限，换到虚拟机一样情况
在网上下载的一个VB源码 《翻译的一个法国VB爱好者的代码,比较简单的一个代码,其中使用了PACKETX.DLL》
就是关于调用PACKETX.DLL这个控件的
网上找的方法
在有问题的机器上，通过控制面板——管理工具——组件服务——组件服务——计算机——我的电脑右击—属性—“选项”选项卡——事务超时（秒）改成0，“默认属性”选项卡中把“在此计算机上启用分布式DCOM”打勾。
还是行不通，我在想应该不是代码的原因，我本机哪里需要设置，求遇到过同类问题的朋友或则知道的告诉我一声，谢了
[解决办法]
顺便把代码发出来给大家看看
Public oPacket As Packet
Dim vnCounter As Integer
Dim oPacketColl As New PacketCollection
Dim WithEvents oPacketX As PacketX
Private Sub About_Click()
frmAbout.Show
End Sub
Private Sub Act_Click()
Option1.Value = True
Option2.Value = False
End Sub
Private Sub Check1_Click()
End Sub
Private Sub close_Click()
End
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
If Text1.Text = "" Then
MsgBox "Vous devez saisir une valeur !", vbCritical
Exit Sub
End If
Text2.Text = ""
Dim Temp As String
Dim ValHexa As String
Dim Result As String
Dim i As Integer
Dim j As Integer
Dim Tablo() As String
ValHexa = Text1.Text
For i = 1 To Len(ValHexa) Step 2
Temp = Temp & Mid(ValHexa, i, 2)
Temp = Temp & "^"
j = i
Next i
Temp = Left(Temp, Len(Temp) - 1)
Tablo = Split(Temp, "^")
For i = 0 To UBound(Tablo)
Result = Result & Chr(Val("&H" & Tablo(i)))
Next i
Text2.Text = Result
End Sub
Private Sub Desact_Click()
Option1.Value = False
Option2.Value = True
End Sub
Private Sub Form_Load()
Dim clm As ColumnHeader
Set clm = ListView1.ColumnHeaders.Add(1, "Numro du paquet", "序列号", 1500)
Set clm = ListView1.ColumnHeaders.Add(2, "Adresse Source", "原地址", 1500)
Set clm = ListView1.ColumnHeaders.Add(3, "Port source", "原端口", 1500)
Set clm = ListView1.ColumnHeaders.Add(4, "Adresse Destination", "目标地址", 1500)
Set clm = ListView1.ColumnHeaders.Add(5, "Port de destination", "目标端口", 1500)
Set clm = ListView1.ColumnHeaders.Add(6, "Taille", "数据报大小", 1500)
Set clm = ListView1.ColumnHeaders.Add(7, "Protocol", "协议", 1500)
Set oPacketX = New PacketX
oPacketX.Adapter = oPacketX.Adapters(oPacketX.Adapters.Count)
ListView1.View = lvwReport
End Sub
Private Sub ListView1_Click()
Text1 = ""
If Not ListView1.SelectedItem Is Nothing Then
Dim oPacket As Packet
Set oPacket = oPacketColl(ListView1.SelectedItem.Index)
Else
Exit Sub
End If
Dim vByte As Variant
Dim sData As String
Dim nPosition, nColumns As Integer
nColumns = 16
For Each vByte In oPacket.Data
If nPosition = 8 Then
sData = sData + " "
End If
If nPosition >= nColumns Then
sData = sData + vbCrLf: nPosition = 1
Else
nPosition = nPosition + 1
End If
If vByte <= &HF Then
sData = sData + "0"
End If
sData = sData + Hex(vByte) + " "
Next
Text1.SelText = sData
End Sub
Private Sub Option1_Click()
ListView1.ListItems.Clear
oPacketColl.RemoveAll
oPacketX.Start
vnCounter = 0
Act.Checked = True
Desact.Checked = False
End Sub
Private Sub oPacketX_OnPacket(ByVal pPacket As PacketXLib.IPktXPacket)
vnCounter = vnCounter + 1
Dim clItem As ListItem
Dim clSubItem As ListSubItem
Set clItem = ListView1.ListItems.Add(vnCounter, , vnCounter)
Select Case pPacket.SourcePort
Case 21
sport = "21 - FTP"
Case 23
sport = "23 - TELNET"
Case 25
sport = "25 - SMTP"
Case 80
sport = "80 - HTTP"
Case 53
sport = "53 - DNS"
Case Else
sport = pPacket.SourcePort
End Select
Select Case pPacket.DestPort
Case 21
Dport = "21 - FTP"
Case 23
Dport = "23 - TELNET"
Case 25
Dport = "25 - SMTP"
Case 80
Dport = "80 - HTTP"
Case 53
Dport = "53 - DNS"
Case Else
Dport = pPacket.DestPort
End Select
Set clSubItem = clItem.ListSubItems.Add(, "Adresse Source", pPacket.SourceIpAddress)
Set clSubItem = clItem.ListSubItems.Add(, "Port source", sport)
Set clSubItem = clItem.ListSubItems.Add(, "Adresse Destination", pPacket.DestIpAddress)
Set clSubItem = clItem.ListSubItems.Add(, "Port de destination", Dport)
Set clSubItem = clItem.ListSubItems.Add(, "Taille", pPacket.DataSize)
Select Case pPacket.Protocol
Case 3
prot = "UDP"
Case 4
prot = "TCP"
End Select
Set clSubItem = clItem.ListSubItems.Add(, "Protocol", prot)
oPacketColl.Add pPacket
End Sub
Private Sub Option2_Click()
oPacketX.Stop
Act.Checked = False
Desact.Checked = True
End Sub
