subnetmask.bas

金水区行政审批服务软件窗口系统

Attribute VB_Name = "SubNetMask"
'*******************************说明**********************************************************
'*在模块里面添加如下代码                                                                     *
'*此处代码很有用，费了我不少时间，最后在VB论坛清高人帮忙得到                                 *                     *
'*特别提示: 完成取IP地址,子网掩码和广播地址;以及默认IP地址,子网掩码和广播地址                *                                     *
'*2003-04-30 dww am 09:16                                                                    *
'*********************************************************************************************
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Dim strIP As String
Private Const MAX_IP = 255
Private Type IPINFO
    dwAddr As Long
    dwIndex As Long
    dwMask As Long
    dwBCastAddr As Long
    dwReasmSize As Long
    unused1 As Integer
    unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
    dEntrys As Long
    mIPInfo(MAX_IP) As IPINFO
End Type
Private Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type
'新加上的定义变量IPAddress,SubNetMask存放要取的Ip地址和子网掩码
Dim strIpAddress As String
Dim strIpSubNetMask As String
Dim strBroadAddress As String
Dim strIpAddressArray(3) As String
Dim strIpSubNetMaskArray(3) As String
Dim strBroadAddressArray(3) As String
'此处代码暂不用
'Private Sub main()
     'Start
     'MsgBox strIP
'End Sub
'转换IP地址到字符串
Private Function ConvertAddressToString(longAddr As Long) As String
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), longAddr, 4
    For Cnt = 0 To 3
    ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
    Next Cnt
    ConvertAddressToString = left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
 Public Sub Start()
    '此处取机器的IP地址和子网掩码信息
    '从网上下载的这一段代码
    Dim Ret As Long, Tel As Long
    Dim bBytes() As Byte
    Dim Listing As MIB_IPADDRTABLE
    On Error GoTo END1
    GetIpAddrTable ByVal 0&, Ret, True
    If Ret <= 0 Then Exit Sub
    ReDim bBytes(0 To Ret - 1) As Byte
    GetIpAddrTable bBytes(0), Ret, False
    CopyMemory Listing.dEntrys, bBytes(0), 4
    strIP = "你机子上有" & Listing.dEntrys & " 个 IP 地址" & vbCrLf
    strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf
    For Tel = 0 To Listing.dEntrys - 1
    CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
    If Tel = 0 Then
    strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
    strIpAddress = ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
    
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), Listing.mIPInfo(Tel).dwAddr, 4
    For Cnt = 0 To 3
    strIpAddressArray(Cnt) = CStr(myByte(Cnt))
    Next Cnt
    
    strIP = strIP & "子网掩码: " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
    strIpSubNetMask = ConvertAddressToString(Listing.mIPInfo(Tel).dwMask)
    
    CopyMemory myByte(0), Listing.mIPInfo(Tel).dwMask, 4
    For Cnt = 0 To 3
    strIpSubNetMaskArray(Cnt) = CStr(myByte(Cnt))
    Next Cnt
    
    strIP = strIP & "广播地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
    strBroadAddress = ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr)
 
    CopyMemory myByte(0), Listing.mIPInfo(Tel).dwBCastAddr, 4
    For Cnt = 0 To 3
    strBroadAddressArray(Cnt) = CStr(myByte(Cnt))
    Next Cnt
    

    strIP = strIP & "------------------------------------------------" & vbCrLf
    End If
    Next Tel
    Exit Sub
END1:
    MsgBox "ERROR"
End Sub
Public Sub GetIPAndMask(IPAddress As String, IPMask As String)
'新加上的通过GetIPAndMask函数直接取IpAddress，IpMask
'2003-04-30 dww am 11:37
IPAddress = strIpAddress
IPMask = strIpSubNetMask
End Sub
Public Sub GetIPAndMaskArray(ByRef IPAddress() As String, ByRef IPMask() As String)
'新加上的通过GetIPAndMaskArray函数直接取IpAddress，IpMask放入数组
'2003-04-30 dww am 15:37
 IPAddress = strIpAddressArray
 IPMask = strIpSubNetMaskArray
End Sub
Public Function GetComputerNo() As String
'新加上的通过GetComputerNO函数直接取取得本计算机的号码
'此号码是有本计算机IP地址和子网掩码计算得到
'计算规则IP地址和的子网掩码反妈取与操作得到
'2003-04-30 dww am 11:37
Dim IPAddressArray() As String
Dim IPMaskArray() As String
Dim IPAddressConvertStr As String
Dim IPMaskConvertStr As String
Dim NotIPMaskConvertStr As String
Dim ComputerConvertNo As String
Dim BinaryStr As String
BinaryStr = "0000000"
Call Start
Call GetIPAndMaskArray(IPAddressArray, IPMaskArray)
Dim i As Integer
'先将存放IP地址和子网掩码的数组进行转换放入变量IPAddressConvertStr和 IPMaskConvertStr
'注意：变量变量IPAddressConvertStr和 IPMaskConvertStr存放的是已转换后的2进制地址32位
'      调用模块subConvertBase中的转换函数将十进制的地址转换成2进制的地址
For i = 0 To 3
 If Len(ConvertBase(IPAddressArray(i), 10, 2)) <= 8 Then
     IPAddressArray(i) = left(BinaryStr, 8 - Len(ConvertBase(IPAddressArray(i), 10, 2))) + ConvertBase(IPAddressArray(i), 10, 2)
     IPAddressConvertStr = IPAddressConvertStr & IPAddressArray(i)
 End If
 If Len(ConvertBase(IPMaskArray(i), 10, 2)) <= 8 Then
     IPMaskArray(i) = left(BinaryStr, 8 - Len(ConvertBase(IPMaskArray(i), 10, 2))) + ConvertBase(IPMaskArray(i), 10, 2)
     IPMaskConvertStr = IPMaskConvertStr & IPMaskArray(i)
 End If
Next i
'将子网掩码取反码：0变1，1变0
For i = 1 To Len(IPMaskConvertStr)
  If Mid(IPMaskConvertStr, i, 1) = 0 Then
     NotIPMaskConvertStr = NotIPMaskConvertStr + "1"
  Else
     NotIPMaskConvertStr = NotIPMaskConvertStr + "0"
  End If
Next i
'将子IP地址和子网掩码的反码进行AND运算得到ComputerConvertNo（2进制代码）
For i = 1 To Len(IPAddressConvertStr)
      ComputerConvertNo = ComputerConvertNo + Trim(Str(Val(Mid(IPAddressConvertStr, i, 1)) And Val(Mid(NotIPMaskConvertStr, i, 1))))
Next i
'将得到ComputerConvertNo（2进制代码）转换成10进制的GetComputerNo
GetComputerNo = ConvertBase(ComputerConvertNo, 2, 10)
'下面是测试数据得到
'Debug.Print IPAddressConvertStr
'Debug.Print IPMaskConvertStr
'Debug.Print NotIPMaskConvertStr
'Debug.Print ComputerConvertNo
'Debug.Print ComputerNo
End Function