我继续按位和第一个函数获得溢出。我通过从Long转换为Currency来修复其他溢出（仍然看起来很奇怪），但我无法得到它并且能够工作。
有什么想法吗？我只是想将一些IP地址转换为CIDR并计算一些主机号码。
Option Explicit
Public Function ConvertMaskToCIDR(someIP As String, someMask As String)
Dim ipL As Variant
ipL = iPToNum(someIP)
Dim maskL As Variant
maskL = iPToNum(someMask)
maskL = CDec(maskL)
'Convert Mask to CIDR(1-30)
Dim oneBit As Variant
oneBit = 2147483648#
oneBit = CDec(oneBit)
Dim CIDR As Integer
CIDR = 0
Dim x As Integer
For x = 31 To 0 Step -1
If (maskL And oneBit) = oneBit Then
CIDR = CIDR + 1
Else
Exit For
End If
oneBit = oneBit / 2# 'Shift one bit to the right (>> 1)
Next
Dim answer As String
answer = numToIp(ipL And maskL) & " /" & CStr(CIDR)
End Function
Public Function NumHostsInCidr(CIDR As Integer) As Currency
Dim mask As Currency
mask = maskFromCidr(CIDR)
NumHostsInCidr = iPnumOfHosts(mask)
End Function
Private Function maskFromCidr(ByVal CIDR As Integer) As Currency
'x = 32 - CIDR
'z = (2^x)-1
'return z xor 255.255.255.255
maskFromCidr = CLng(2 ^ ((32 - CIDR)) - 1) Xor 4294967295# '255.255.255.255
End Function
Private Function iPnumOfHosts(ByVal IPmsk As Currency) As Currency 'a mask for the host portion
'255.255.255.0 XOR 255.255.255.255 = 255 so 0 to 255 is 256 hosts
iPnumOfHosts = IPmsk Xor 4294967295# '255.255.255.255 , calculate the number of hosts
End Function
Private Function numToIp(ByVal theIP As Currency) As String 'convert number back to IP
Dim IPb(3) As Byte '4 octets
Dim theBit As Integer
theBit = 31 'work MSb to LSb
Dim addr As String 'accumulator for address
Dim x As Integer
For x = 0 To 3 'four octets
Dim y As Integer
For y = 7 To 0 Step -1 '8 bits
If (theIP And CLng(2 ^ theBit)) = CLng(2 ^ theBit) Then 'if the bit is on
IPb(x) = IPb(x) + CByte(2 ^ y) 'accumulate
End If
theBit = theBit - 1
Next
addr = addr & CStr(IPb(x)) & "." 'add current octet to string
Next
numToIp = trimLast(addr, ".")
End Function
Private Function iPToNum(ByVal ip As String) As Currency
Dim IPpart As Variant
Dim IPbyte(3) As Byte
IPpart = Split(ip, ".")
Dim x As Integer
For x = 0 To 3
IPbyte(x) = CByte(IPpart(x))
Next x
iPToNum = (IPbyte(0) * (256 ^ 3)) + (IPbyte(1) * (256 ^ 2)) + (IPbyte(2) * 256#) + IPbyte(3)
End Function
Private Function trimLast(str As String, chr As String)
'****
'* Remove "chr" (if it exists) from end of "str".
'****
trimLast = str
If Right(str, 1) = chr Then trimLast = Left(str, Len(str) - 1)
End Function
答案 0 :(得分：2)
哇， 这是definitelly有趣的功能。但我会以非常不同的方式做到这一点。我会将IP地址和掩码视为四个字节的数组。此外，据我所知（很久以前）CIDR和掩码可以在非常simply way中相互转换（你看过桌子吗？）。为什么不单独对每个字节应用按位运算？ BR。
编辑：好的，我仔细查看了代码。溢出的原因是您无法使用currency和and。我认为and在内部被定义为Long并且不能返回任何更大的值。在其他语言中也很常见。我记得有一次我用其他语言（Pascal）来解决这个问题。您可以尝试按部门替换and。它会很慢，但我认为这不是问题。正如我所写的那样，其他解决方案是将这些值一直视为字节数组并对每个字节执行按位操作。
答案 1 :(得分：1)
这是在VBA中使用IPv4地址的完全数学方法（特别是Excel）。
前三个职能部门正在发挥严格的支持作用。
支持＃1：
Public Function RoundDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDouble
Dim i As Long
Dim j As Long
i = 0
j = 0
While Number < -(2 ^ 14)
Number = Number + (2 ^ 14)
i = i - 1
Wend
While Number > (2 ^ 14)
Number = Number - (2 ^ 14)
i = i + 1
Wend
While Number < -(2 ^ 5)
Number = Number + (2 ^ 5)
j = j - 1
Wend
While Number > (2 ^ 5)
Number = Number - (2 ^ 5)
j = j + 1
Wend
RoundDouble = Round(Number, Places) + (i * (2 ^ 14)) + (j * (2 ^ 5))
Exit_RoundDouble:
Exit Function
Err_RoundDouble:
MsgBox Err.Description
Resume Exit_RoundDouble
End Function
支持＃2：
Public Function RoundDownDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDownDouble
Dim i As Double
i = RoundDouble(Number, Places)
If Number < 0 Then
If i < Number Then
RoundDownDouble = i + (10 ^ -Places)
Else
RoundDownDouble = i
End If
Else
If i > Number Then
RoundDownDouble = i - (10 ^ -Places)
Else
RoundDownDouble = i
End If
End If
Exit_RoundDownDouble:
Exit Function
Err_RoundDownDouble:
MsgBox Err.Description
Resume Exit_RoundDownDouble
End Function
支持＃3
Public Function ModDouble(ByVal Number As Double, ByVal Divisor As Double) As Double
On Error GoTo Err_ModDouble
Dim rndNumber As Double
Dim rndDivisor As Double
Dim intermediate As Double
rndNumber = RoundDownDouble(Number, 0)
rndDivisor = RoundDownDouble(Divisor, 0)
intermediate = rndNumber / rndDivisor
ModDouble = (intermediate - RoundDownDouble(intermediate, 0)) * rndDivisor
Exit_ModDouble:
Exit Function
Err_ModDouble:
MsgBox Err.Description
Resume Exit_ModDouble
End Function
第一个函数会将Double转换回IP地址。
Public Function NUMtoIP(ByVal Number As Double) As String
On Error GoTo Err_NUMtoIP
Dim intIPa As Double
Dim intIPb As Double
Dim intIPc As Double
Dim intIPd As Double
If Number < 0 Then Number = Number * -1
intIPa = RoundDownDouble(ModDouble(Number, (2 ^ 32)) / (2 ^ 24), 0)
intIPb = RoundDownDouble(ModDouble(Number, (2 ^ 24)) / (2 ^ 16), 0)
intIPc = RoundDownDouble(ModDouble(Number, (2 ^ 16)) / (2 ^ 8), 0)
intIPd = ModDouble(Number, (2 ^ 8))
NUMtoIP = intIPa & "." & intIPb & "." & intIPc & "." & intIPd
Exit_NUMtoIP:
Exit Function
Err_NUMtoIP:
MsgBox Err.Description
Resume Exit_NUMtoIP
End Function
第二个功能是严格地从IPv4点缀八位字节格式转换为Double。
Public Function IPtoNUM(ByVal IP_String As String) As Double
On Error GoTo Err_IPtoNUM
Dim intIPa As Integer
Dim intIPb As Integer
Dim intIPc As Integer
Dim intIPd As Integer
Dim DotLoc1 As Integer
Dim DotLoc2 As Integer
Dim DotLoc3 As Integer
Dim DotLoc4 As Integer
DotLoc1 = InStr(1, IP_String, ".", vbTextCompare)
DotLoc2 = InStr(DotLoc1 + 1, IP_String, ".", vbTextCompare)
DotLoc3 = InStr(DotLoc2 + 1, IP_String, ".", vbTextCompare)
DotLoc4 = InStr(DotLoc3 + 1, IP_String, ".", vbTextCompare)
If DotLoc1 > 1 And DotLoc2 > DotLoc1 + 1 And _
DotLoc3 > DotLoc2 + 1 And DotLoc4 = 0 Then
intIPa = CInt(Mid(IP_String, 1, DotLoc1))
intIPb = CInt(Mid(IP_String, DotLoc1 + 1, DotLoc2 - DotLoc1))
intIPc = CInt(Mid(IP_String, DotLoc2 + 1, DotLoc3 - DotLoc2))
intIPd = CInt(Mid(IP_String, DotLoc3 + 1, 3))
If intIPa <= 255 And intIPa >= 0 And intIPb <= 255 And intIPb >= 0 And _
intIPc <= 255 And intIPc >= 0 And intIPd <= 255 And intIPd >= 0 Then
IPtoNUM = (intIPa * (2 ^ 24)) + (intIPb * (2 ^ 16)) + _
(intIPc * (2 ^ 8)) + intIPd
Else
IPtoNUM = 0
End If
Else
IPtoNUM = 0
End If
Exit_IPtoNUM:
Exit Function
Err_IPtoNUM:
MsgBox Err.Description
Resume Exit_IPtoNUM
End Function
接下来，我们将IPv4地址转换为其位掩码表示（假设源条目是仅包含子网掩码的虚线八位字节格式的字符串）。
Public Function IPtoBitMask(ByVal strIP_Address As String) As Integer
On Error GoTo Err_IPtoBitMask
IPtoBitMask = (32 - Application.WorksheetFunction.Log((2 ^ 32 - IPtoNUM(strIP_Address)), 2))
Exit_IPtoBitMask:
Exit Function
Err_IPtoBitMask:
MsgBox Err.Description
Resume Exit_IPtoBitMask
End Function
最后一个是将位掩码转换回虚线八位字节格式。
Public Function BitMasktoIP(ByVal intBit_Mask As Integer) As String
On Error GoTo Err_BitMasktoIP
BitMasktoIP = NUMtoIP((2 ^ 32) - (2 ^ (32 - intBit_Mask)))
Exit_BitMasktoIP:
Exit Function
Err_BitMasktoIP:
MsgBox Err.Description
Resume Exit_BitMasktoIP
End Function
编辑删除剩余的调试代码（它已经为我工作了很长时间，我完全忘记了它。）
另外，在计算机上执行数学运算比使用字符串更快。
答案 2 :(得分：0)
这是我的“作弊”方式：
Option Explicit
Public Function ConvertMaskToCIDR(varMask As Variant) As String
Dim strCIDR As String
Dim mask As String
mask = CStr(varMask)
Select Case mask
Case "255.255.255.255":
strCIDR = "/32"
Case "255.255.255.254":
strCIDR = "/31"
Case "255.255.255.252":
strCIDR = "/30"
Case "255.255.255.248":
strCIDR = "/29"
Case "255.255.255.240":
strCIDR = "/28"
Case "255.255.255.224":
strCIDR = "/27"
Case "255.255.255.192":
strCIDR = "/26"
Case "255.255.255.128":
strCIDR = "/25"
Case "255.255.255.0":
strCIDR = "/24"
Case "255.255.254.0":
strCIDR = "/23"
Case "255.255.252.0":
strCIDR = "/22"
Case "255.255.248.0":
strCIDR = "/21"
Case "255.255.240.0":
strCIDR = "/20"
Case "255.255.224.0":
strCIDR = "/19"
Case "255.255.192.0":
strCIDR = "/18"
Case "255.255.128.0":
strCIDR = "/17"
Case "255.255.0.0":
strCIDR = "/16"
Case "255.254.0.0":
strCIDR = "/15"
Case "255.252.0.0":
strCIDR = "/14"
Case "255.248.0.0":
strCIDR = "/13"
Case "255.240.0.0":
strCIDR = "/12"
Case "255.224.0.0":
strCIDR = "/11"
Case "255.192.0.0":
strCIDR = "/10"
Case "255.128.0.0":
strCIDR = "/9"
Case "255.0.0.0":
strCIDR = "/8"
Case "254.0.0.0":
strCIDR = "/7"
Case "252.0.0.0":
strCIDR = "/6"
Case "248.0.0.0":
strCIDR = "/5"
Case "240.0.0.0":
strCIDR = "/4"
Case "224.0.0.0":
strCIDR = "/3"
Case "192.0.0.0":
strCIDR = "/2"
Case "128.0.0.0":
strCIDR = "/1"
Case "0.0.0.0":
strCIDR = "/0"
End Select
ConvertMaskToCIDR = strCIDR
End Function
Public Function NumUsableIPs(cidr As String) As Long
Dim strHosts As String
If Len(cidr) > 3 Then
'They probably passed a whole address.
Dim slashIndex As String
slashIndex = InStr(cidr, "/")
If slashIndex = 0 Then
NumUsableIPs = 1
Exit Function
End If
cidr = Right(cidr, Len(cidr) - slashIndex + 1)
End If
Select Case cidr
Case "/32":
strHosts = 1
Case "/31":
strHosts = 0
Case "/30":
strHosts = 2
Case "/29":
strHosts = 6
Case "/28":
strHosts = 14
Case "/27":
strHosts = 30
Case "/26":
strHosts = 62
Case "/25":
strHosts = 126
Case "/24":
strHosts = 254
Case "/23":
strHosts = 508
Case "/22":
strHosts = 1016
Case "/21":
strHosts = 2032
Case "/20":
strHosts = 4064
Case "/19":
strHosts = 8128
Case "/18":
strHosts = 16256
Case "/17":
strHosts = 32512
Case "/16":
strHosts = 65024
Case "/15":
strHosts = 130048
Case "/14":
strHosts = 195072
Case "/13":
strHosts = 260096
Case "/12":
strHosts = 325120
Case "/11":
strHosts = 390144
Case "/10":
strHosts = 455168
Case "/9":
strHosts = 520192
Case "/8":
strHosts = 585216
Case "/7":
strHosts = 650240
Case "/6":
strHosts = 715264
Case "/5":
strHosts = 780288
Case "/4":
strHosts = 845312
Case "/3":
strHosts = 910336
Case "/2":
strHosts = 975360
Case "/1":
strHosts = 1040384
End Select
NumUsableIPs = strHosts
End Function