（200分）VB 获取本机IP和重新获取IP问题

DOS获取本机IP(括号内的为注释，输命令时别复制进去)。

方法1：arp -a (Interface:后面的就是你自己的IP地址)

方法2:ipconfig/all (IP Address后面的就是你自己的IP地址)

DOS重新获取IP

cmd /c ipconfig /release (释放IP,不执行这步下一步命令将无效)

cmd /c ipconfig /renew (重新获得IP)

上不了网或IP冲突时可以在记事本里贴入如下代码保存为如下文件名并执行：

重新获取IP.bat

@echo off

@echo 正在重新获取IP，请稍候....

cmd /c ipconfig /release >nul

cmd /c ipconfig /renew >nul

arp -a

@echo "Interface:后面的就是你自己的IP地址"

@echo "按任意建测试网络联通(不断跳说明网络正常)"

pause

ping www.baidu.com -t

本程序在我的XP系统下测试通过。

在执行本程序前请不要绑定网卡IP,否则重新获取IP的二条命令无效。

-------------------------------------------------------

'VB获取本机IP

Private Sub Command1_Click()

Dim winIP As Object

Set winIP = CreateObject("MSWinsock.Winsock")

MsgBox "本机IP:" &winIP.localip

End Sub

-------------------------------------------------------

'VB起用和禁用网络连接

Option Explicit

Private Const NetConnect = &H31

Private Sub Command1_Click() '停用本地连接

Dim blnRelust As Boolean

'把 本地连接换成你要控制的本地连接的名字

blnRelust = ExcNetLinkMenu("本地连接", "停用(&B)")

'xp

If blnRelust Then

Debug.Print "停用成功"

Else

blnRelust = ExcNetLinkMenu("本地连接", "禁用(&B)")

End If

If blnRelust Then

Debug.Print "停用成功"

Else

Debug.Print "停用失败"

End If

End Sub

Private Sub command2_Click() '启用本地连接

'把 本地连接换成你要控制的本地连接的名字

Dim blnRelust As Boolean

blnRelust = ExcNetLinkMenu("本地连接", "启用(&A)")

If blnRelust Then

Debug.Print "启用成功"

Else

Debug.Print "启用失败"

End If

End Sub

'首先引用Microsoft Shell Controls And Automation

'先找到“网络连接”这个虚拟文件夹，然后找到要控制的本地连接对应的folderitem，然后枚举verb，找到需要的verb后，调用verb的DoIt方法

Private Function ExcNetLinkMenu(ByVal AdapterName As String, ByVal MenuName As String) As Boolean

Dim objShell As New Shell32.Shell

Dim objFolder As Shell32.Folder

Dim objFolderItem As Shell32.FolderItem

Dim objShellFolderItem As ShellFolderItem

Dim objFolderItemVerb As Shell32.FolderItemVerb

Dim blnRelust As Boolean

On Error Resume Next

Set objFolder = objShell.NameSpace(NetConnect)

If ObjPtr(objFolder) = 0 Then

ExcNetLinkMenu = False

GoTo Exitfunction

End If

For Each objFolderItem In objFolder.Items '遍历网络连接文件夹集合

If objFolderItem.Name = AdapterName Then

Set objShellFolderItem = objFolderItem

blnRelust = True

Exit For

End If

Next

If blnRelust = False Then

ExcNetLinkMenu = False

GoTo Exitfunction

End If

For Each objFolderItemVerb In objShellFolderItem.Verbs '遍历本地连接的右键菜单

If objFolderItemVerb.Name = MenuName Then

objFolderItemVerb.DoIt

ExcNetLinkMenu = True

Exit For

End If

Next

If blnRelust = False Then ExcNetLinkMenu = False

Exitfunction:

Set objShell = Nothing

Set objFolder = Nothing

Set objFolderItem = Nothing

Set objShellFolderItem = Nothing

Set objFolderItemVerb = Nothing

End Function

从1-1023这些端口是系统服务端口

开启什么服务启动什么端口

比如你开启了 FTP服务那么 系统将打开 20.21（一个是控制，一个是传输）

现在总有些人认为我看网页那么也将打开我本机80端口

其实不然

大家可以打开一个网页 在打开CMD 输入 netstat -an

本机并没有80 只是远程主机有80这个端口

好我们的程序分为两部分

一部分判断远程主机

另外一部分判断本机

比如本机打开4000

大于1024的端口你需要自己搜集 在网上找吧 别人已经收集，你自己做成一个表就可以

利用vb写的扫描本机开放端口的小程序.

4个text 两个按钮.和一个Winsock1控件

Dim portnum As Long

Dim start As String

Sub scanningports()

Dim porttwo As Long

portnum = Text1.Text

porttwo = Text2.Text

Command2.Enabled = True

On Error GoTo viriio

Do

portnum = portnum + 1

DoEvents

If start = True Then

Winsock1.Close

DoEvents

Winsock1.LocalPort = portnum

DoEvents

Text3.Text = portnum

Winsock1.Listen

DoEvents

Else

portnum = 0

Command1.Enabled = True

Text1.Locked = False

Text2.Locked = False

Exit Sub

End If

Winsock1.Close

DoEvents

Loop Until portnum >= porttwo

portnum = 0

Command1.Enabled = True

logport.Text = logport.Text &vbCrLf &"Scanning Ports Done!" &vbCrLf

Text1.Locked = False

Text2.Locked = False

viriio:

If Err.Number = 10048 Then

logport.Text = logport.Text &vbCrLf &"端口" &Winsock1.LocalPort &" 开启中"

Resume Next

End If

End Sub

Private Sub Command1_Click()

Command2.Enabled = True

If Text1.Text = "" Then

MsgBox "你必须指定开始端口号！"

Exit Sub

End If

If Text2.Text = "" Then

MsgBox "你必须指定一个结束端口号"

Exit Sub

End If

Text1.Locked = True

Text2.Locked = True

Command1.Enabled = False

Winsock1.Close

start = True

Call scanningports

logport.Text = logport.Text &vbCrLf &"端口" &Text1.Text &"- " &Text3.Text &" 已经成功扫描！"

End Sub

Private Sub Command2_Click()

Command2.Enabled = False

start = False

End Sub

Option Explicit

Dim objSWbemServices As SWbemServices

Dim objSWbemObjectSet As SWbemObjectSet

Dim objSWbemObject As SWbemObject

'Text1(0)为IP地址、Text1(1)为子网掩码、Text1(2)为缺省网关、Text1(3)为DNS

Private Sub Form_Load()

Set objSWbemServices = GetObject("winmgmts:")

Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")

For Each objSWbemObject In objSWbemObjectSet

Combo1.AddItem objSWbemObject.Description '添加本机上已经安装了TCP/IP协议的网卡

Next

Combo1.Text = Combo1.List(0)

Combo1.ListIndex = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set objSWbemServices = Nothing

Set objSWbemObjectSet = Nothing

Set objSWbemObject = Nothing

End Sub

'当选择了网卡后，显示当前所选网卡的设置

Private Sub Combo1_Click()

Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" &Combo1.Text &"'")

For Each objSWbemObject In objSWbemObjectSet

If objSWbemObject.DHCPEnabled Then

Text1(0).Text = ""

Text1(1).Text = ""

Text1(2).Text = ""

If IsNull(objSWbemObject.DNSServerSearchOrder) Then

Text1(3).Text = ""

Else

Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)

End If

Else

Text1(0).Text = objSWbemObject.IPAddress(0)

Text1(1).Text = objSWbemObject.IPSubnet(0)

Text1(2).Text = objSWbemObject.DefaultIPGateway(0)

Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)

End If

Next

End Sub

'设置网卡的IP地址、子网掩码、缺省网关和DNS

Private Sub Command1_Click()

Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" &Combo1.Text &"'")

For Each objSWbemObject In objSWbemObjectSet

objSWbemObject.EnableStatic Array(Text1(0).Text), Array(Text1(1).Text)

objSWbemObject.SetGateways Array(Text1(2).Text)

objSWbemObject.SetDNSServerSearchOrder Array(Text1(3).Text)

Next

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

---