📄 获得及设置ip地址.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3660
ClientLeft = 60
ClientTop = 345
ClientWidth = 5385
LinkTopic = "Form1"
ScaleHeight = 3660
ScaleWidth = 5385
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "本机使用以下地址的DNS服务器"
Height = 1365
Left = 360
TabIndex = 7
Top = 2040
Width = 4545
Begin VB.TextBox Text5
Alignment = 1 'Right Justify
Height = 300
Left = 2070
TabIndex = 11
Text = "Text5"
Top = 780
Width = 1995
End
Begin VB.TextBox Text4
Alignment = 1 'Right Justify
Height = 300
Left = 2070
TabIndex = 10
Text = "Text4"
Top = 360
Width = 1995
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "备用的DNS服务器："
Height = 180
Left = 300
TabIndex = 9
Top = 870
Width = 1530
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "首选的DNS服务器："
Height = 180
Left = 270
TabIndex = 8
Top = 390
Width = 1530
End
End
Begin VB.Frame Frame1
Caption = "本机使用以下IP地址"
Height = 1515
Left = 360
TabIndex = 0
Top = 240
Width = 4545
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 300
Left = 2070
TabIndex = 3
Text = "Text1"
Top = 300
Width = 2025
End
Begin VB.TextBox Text2
Alignment = 1 'Right Justify
Height = 300
Left = 2070
TabIndex = 2
Text = "Text2"
Top = 645
Width = 2025
End
Begin VB.TextBox Text3
Alignment = 1 'Right Justify
Height = 300
Left = 2070
TabIndex = 1
Text = "Text3"
Top = 990
Width = 2025
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "IP 地址："
Height = 180
Left = 780
TabIndex = 6
Top = 360
Width = 810
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "子网掩码："
Height = 180
Left = 780
TabIndex = 5
Top = 720
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "默认网关："
Height = 180
Left = 780
TabIndex = 4
Top = 1050
Width = 900
End
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "子网掩码："
Height = 180
Left = 1170
TabIndex = 13
Top = 810
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "IP 地址："
Height = 180
Left = 1170
TabIndex = 12
Top = 420
Width = 810
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' API函数声明
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal HKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal HKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As Long) As Long
' 字符常数说明
Const REG_MULTI_SZ = 7
Const REG_SZ = 1
Const HKEY_LOCAL_MACHINE = &H80000002
Dim Subkey As String, HandhKey As String, M As String
Private Sub Form_Load()
Dim I As Integer, K As Integer
' 得到子键名称
M = GetData("SYSTEM\CurrentControlSet\Services\Tcpip\Linkage", "Route", REG_MULTI_SZ)
Subkey = Mid(M, 2, Len(M) - 2)
HandhKey = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & Subkey
' 读取IP 地址
Text1 = GetData(HandhKey, "IPAddress", REG_MULTI_SZ)
' 读取子网掩码
Text2 = GetData(HandhKey, "SubnetMask", REG_MULTI_SZ)
' 读取默认网关
Text3 = GetData(HandhKey, "DefaultGateway", REG_MULTI_SZ)
' 读取DNS 服务器
M = GetData(HandhKey, "NameServer", REG_SZ)
If M <> "" Then
I = 1
Do While Mid(M, I, 1) <> Chr$(44)
K = K + 1
I = I + 1
Loop
' 首选的DNS服务器
Text4 = Mid(M, 1, K)
' 备用的DNS服务器
Text5 = Mid(M, K + 2, Len(M))
Else
Text4 = ""
Text5 = ""
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
' 设置IP地址
If KeyAscii = 13 Then
SaveData "IPAddress", REG_MULTI_SZ, Text1
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
' 设置子网掩码
If KeyAscii = 13 Then
SaveData "SubnetMask", REG_MULTI_SZ, Text2
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
' 设置默认网关
If KeyAscii = 13 Then
SaveData "DefaultGateway", REG_MULTI_SZ, Text3
End If
End Sub
' 设置DNS 服务器
Private Sub Text4_KeyPress(KeyAscii As Integer)
' 设置首选的DNS服务器
If KeyAscii = 13 Then
SaveData "NameServer", REG_SZ, Text4
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
' 设置备用的DNS服务器
If KeyAscii = 13 Then
SaveData "NameServer", REG_SZ, Text4 & "," & Text5
End If
End Sub
Function GetData(SubHkey As String, DataName As String, ValueType As Long) As String
' 读取数据
Dim HKey As Long, strBuf As String, DataBufSize As Long
RegOpenKey HKEY_LOCAL_MACHINE, SubHkey, HKey
RegQueryValueEx HKey, DataName, 0, ValueType, ByVal 0, DataBufSize
strBuf = String(DataBufSize, Chr$(0))
RegQueryValueEx HKey, DataName, 0, ValueType, ByVal strBuf, DataBufSize
GetData = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
RegCloseKey HKey
End Function
Function SaveData(DataName As String, DataType As Long, DataValue As String) As String
' 保存数据
Dim HKey As Long
RegOpenKey HKEY_LOCAL_MACHINE, HandhKey, HKey
RegSetValueEx HKey, DataName, 0&, DataType, DataValue, Len(DataValue)
RegCloseKey HKey
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -