📄 form1.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
Caption = "arp神盾"
ClientHeight = 3855
ClientLeft = 60
ClientTop = 345
ClientWidth = 5310
ClipControls = 0 'False
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3855
ScaleWidth = 5310
ShowInTaskbar = 0 'False
Begin VB.Frame Frame6
Caption = "说明"
Height = 975
Left = 0
TabIndex = 17
Top = 2760
Width = 5175
Begin VB.Label Label6
Caption = "网关ip和mac可这样看到：打开MSDOS-输入arp -a即可，没有输入网关信息本软件是无效的。欢迎你使用本软件。"
Height = 495
Left = 120
TabIndex = 18
Top = 240
Width = 4935
End
End
Begin VB.Frame Frame5
Caption = "自己添入网关信息"
Height = 855
Left = 120
TabIndex = 11
Top = 840
Width = 5175
Begin VB.TextBox Text4
Height = 270
Left = 3240
TabIndex = 16
Top = 360
Width = 1785
End
Begin VB.TextBox Text3
Height = 270
Left = 840
TabIndex = 13
Top = 345
Width = 1455
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "网关MAC："
Height = 180
Left = 2400
TabIndex = 15
Top = 360
Width = 810
End
Begin VB.Label Label4
Caption = "Label4"
Height = 135
Left = 2520
TabIndex = 14
Top = 240
Width = 15
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "网关ip："
Height = 180
Left = 120
TabIndex = 12
Top = 360
Width = 675
End
End
Begin VB.Timer Timer1
Interval = 2000
Left = 0
Top = 0
End
Begin VB.Frame Frame4
Height = 735
Left = 3960
TabIndex = 8
Top = 1800
Width = 1095
Begin VB.CommandButton Command3
Caption = "退出"
Height = 375
Left = 120
TabIndex = 9
Top = 240
Width = 855
End
End
Begin VB.Frame Frame3
Height = 735
Left = 2040
TabIndex = 6
Top = 1800
Width = 1695
Begin VB.CommandButton Command2
Caption = "到系统托盘"
Height = 375
Left = 120
TabIndex = 7
Top = 240
Width = 1455
End
End
Begin VB.Frame Frame2
Height = 735
Left = 0
TabIndex = 5
Top = 1800
Width = 1815
Begin VB.CommandButton Command1
Caption = "开始防护"
Height = 375
Left = 120
TabIndex = 10
Top = 240
Width = 1575
End
End
Begin VB.Frame Frame1
Height = 615
Left = 120
TabIndex = 0
Top = 120
Width = 5175
Begin VB.TextBox Text2
Height = 270
Left = 3240
TabIndex = 4
Top = 240
Width = 1815
End
Begin VB.TextBox Text1
CausesValidation= 0 'False
Height = 270
Left = 840
TabIndex = 2
Top = 240
Width = 1455
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "本机mac："
Height = 180
Left = 2400
TabIndex = 3
Top = 240
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "本机ip："
Height = 180
Index = 0
Left = 120
TabIndex = 1
Top = 240
Width = 720
End
End
Begin MSWinsockLib.Winsock mysock
Left = 4440
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32
Private Type NCB
ncb_command As Byte
ncb_retcode As Byte
ncb_lsn As Byte
ncb_num As Byte
ncb_buffer As Long
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte
ncb_sto As Byte
ncb_post As Long
ncb_lana_num As Byte
ncb_cmd_cplt As Byte
ncb_reserve(9) As Byte ' Reserved, must be 0
ncb_event As Long
End Type
Private Type ADAPTER_STATUS
adapter_address(5) As Byte
rev_major As Byte
reserved0 As Byte
adapter_type As Byte
rev_minor As Byte
duration As Integer
frmr_recv As Integer
frmr_xmit As Integer
iframe_recv_err As Integer
xmit_aborts As Integer
xmit_success As Long
recv_success As Long
iframe_xmit_err As Integer
recv_buff_unavail As Integer
t1_timeouts As Integer
ti_timeouts As Integer
Reserved1 As Long
free_ncbs As Integer
max_cfg_ncbs As Integer
max_ncbs As Integer
xmit_buf_unavail As Integer
max_dgram_size As Integer
pending_sess As Integer
max_cfg_sess As Integer
max_sess As Integer
max_sess_pkt_size As Integer
name_count As Integer
End Type
Private Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type
Private Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type
Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Function EthernetAddress(LanaNumber As Long) As String
Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim X As Integer
udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For X = 0 To 5
strOut = strOut & "-" & Right$("00" & Hex$(.adapter_address(X)), 2)
Next X
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
strOut = Replace(strOut, "-", "", 1, 1)
EthernetAddress = strOut
End Function
Private Sub Command1_Click()
Timer1.Enabled = True
Command1.Enabled = False
WritePrivateProfileString App.Title, "netip", Text3.Text, "c:\net.ini"
WritePrivateProfileString App.Title, "netmac", Text4.Text, "c:\net.ini"
End Sub
Private Sub Command2_Click()
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
Text1.Text = mysock.LocalIP
Text2.Text = EthernetAddress(0)
i = 0
j = 0
Timer1.Enabled = False
Dim ret As Long
Dim buff As String
buff = String(255, 0)
ret = GetPrivateProfileString(App.Title, "netip", "", buff, 256, "c:\net.ini")
Text3.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString(App.Title, "netmac", "", buff, 256, "c:\net.ini")
Text4.Text = buff
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP
ShowWindow Me.hWnd, SW_RESTORE
End Select
End Sub
Private Sub Timer1_Timer()
If Text3.Text = "" And Text4.Text = "" Then
MsgBox "请输入网关信息！"
Timer1.Enabled = False
Command1.Enabled = True
Else
i = i + 1
If i = 1 Then
Shell "cmd.exe /c" & "arp -d", vbHide
Shell "cmd.exe /c" & "arp -d", vbHide
Shell "cmd.exe /c" & "arp -d", vbHide
Shell "cmd.exe /c" & "arp -s" & Chr(32) & Text3.Text & Chr(32) & Text4.Text, vbHide
Shell "cmd.exe /c" & "arp -s" & Chr(32) & Text1.Text & Chr(32) & Text2.Text, vbHide
i = 0
j = j + 1
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -