Побитовое и с большими числами в VBA

Question

Я продолжаю получать переполнение побитового и в этой первой функции. Я исправил другие переполнения, перейдя с 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 

Answer 1

Это совершенно математический подход к работе с адресами IPv4 в VBA (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 

Edited удалить остатки отладки кода (это работает для меня так долго, что я совершенно забыл об этом).

Как в стороне, быстрее выполнять математические операции на компьютере, чем работать со строкой.

Answer 2

Whoah, это definitelly интересная функциональность. Но я бы сделал это совсем по-другому. Я бы рассматривал IP-адрес и Mask как массив из четырех байтов. Более того, насколько я помню (ну, это было некоторое время назад) CIDR и маска могут быть преобразованы друг в друга в очень simply way (вы посмотрели на таблицу?). Почему бы вам не применять побитовые операции для каждого байта отдельно? BR.

изменить: ok Я посмотрел ближе к коду. Причина, по которой она переполнена, заключается в том, что вы не можете использовать currency и and. Я думаю, что and внутренне определен как длинный и не может возвращать большие значения. Это очень часто встречается и на других языках. Я помню, что однажды у меня была эта проблема на другом языке (Pascal?). Вы можете попытаться заменить and делением. Это будет медленно, но это не может иметь значения здесь, я полагаю. Другое решение, как я уже писал, обрабатывать значения valueas все время как массивы байтов и выполнять побитовые операции над каждым байтом.

Answer 3

Это был мой "обман" способом:

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