VBA处理搜集的IP地址信息
对于目标检测，通过NMap可以得到IP地址信息，为XML文件，现在需要对应到具体的单位。
这个工作很多单位都在做，比如搜索到一些存在高危端口或者漏洞的计算机，现在需要将信息下发到具体的单位方便整改，这就需要做一些准备工作。
对于这个工作，想法很简单也最好实施：就准备一个数据表，准备单位名称、网络起始地址，具体对应的时候就可以通过IP网关信息和子网掩码找到对应的网络起始地址，这样就好对应了。想法是好的，问题是目前只有IP地址信息，没有网关地址和子网掩码就不能得到网络的首地址也就无法按这样的方法进行比较。
可以按照下面的操作方法进行对比。
⑴准备一个Vlan信息表
包含信息：单位名称、网络地址前三位、IP起始地址、IP结束地址
⑵准备一个数据表存储特殊例外的IP信息
包括信息：单位名称、IP地址、MAC地址、主机名称、备注信息
为了加快检索速度，需要将这些信息一次性读入内存，这样对比就很快，尽量减少重复信息，使用的方法是先定义结构体数组，然后在结构体数组中再定义结构体数组。
声明：
Option Explicit
Public MyIPAddressIndex(5) As IPAddrIndex
Public ArrCount(5) As Integer
Public MyIPSpecialIP() As SpecialIP
Type IPAddressRangInfo
unit As String '单位名称
StartAddr As Integer '起始地址
EndAddr As Integer '结束地址
End Type
Type SpecialIP
unit As String '单位名称
IPAddr As String 'IP地址
MacAddr As String 'MAC地址
HostName As String '主机名称
Memo As String '备注
End Type
Type IPAddrIndex
Prefix As String '网络地址前三位
MyIPAddrRange() As IPAddressRangInfo 'IP地址范围信息
End Type
读取信息：
Sub ReadyNetworkData()
Dim ws As Worksheet
Dim PrefixCol As Range
Dim UnitCol As Range
Dim StartAddrCol As Range
Dim EndAddrCol As Range
Dim MaxRows As Integer
Dim iFor As Integer
Dim StrPrefix As String
Dim StrCurrent As String
Dim ICount As Integer
Dim ISubCount As Integer
Dim ArrIndex As Integer
Dim StrAddrStart As String
Dim StrAddrEnd As String
Dim StrUnit As String
Dim StrTemp As String
Dim ITemp As Integer
Dim UnitCol_B As Range
Dim IPAddrCol As Range
Dim MacAddrCol As Range
Dim HontNameCol As Range
Dim MemoCol As Range
'读取Vlan信息表
Set ws = Worksheets("VlanMarkings")
MaxRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set PrefixCol = ws.Range("H2:H" & Trim(str(MaxRows)))
Set UnitCol = ws.Range("B2:B" & Trim(str(MaxRows)))
Set StartAddrCol = ws.Range("I2:I" & Trim(str(MaxRows)))
Set EndAddrCol = ws.Range("J2:J" & Trim(str(MaxRows)))
StrPrefix = ""
'读取有多少段地址
ICount = 0
For iFor = 1 To MaxRows - 1
'读取IP地址
StrCurrent = UCase(Trim(PrefixCol(iFor).Value))
If StrPrefix <> StrCurrent Then
MyIPAddressIndex(ICount).Prefix = StrCurrent
StrPrefix = StrCurrent
ICount = ICount + 1
End If
Next
'每段有多少个细分范围
For iFor = 0 To UBound(MyIPAddressIndex)
StrTemp = MyIPAddressIndex(iFor).Prefix
ITemp = WorksheetFunction.CountIf(ws.Range("H2:H" & Trim(str(MaxRows))), "=" + StrTemp)
ArrIndex = GetArrIndex(StrTemp)
ReDim MyIPAddressIndex(ArrIndex).MyIPAddrRange(0 To ITemp)
Next
'GoTo L123
'读取每段地址范围
For iFor = 0 To 5
ArrCount(iFor) = 0
Next
For iFor = 1 To MaxRows - 1
'读取IP地址
StrPrefix = UCase(Trim(PrefixCol(iFor).Value))
ArrIndex = GetArrIndex(StrPrefix)
StrAddrStart = UCase(Trim(StartAddrCol(iFor).Value))
StrAddrEnd = UCase(Trim(EndAddrCol(iFor).Value))
StrUnit = UCase(Trim(UnitCol(iFor).Value))
MyIPAddressIndex(ArrIndex).MyIPAddrRange(ArrCount(ArrIndex)).StartAddr = StrAddrStart
MyIPAddressIndex(ArrIndex).MyIPAddrRange(ArrCount(ArrIndex)).EndAddr = StrAddrEnd
MyIPAddressIndex(ArrIndex).MyIPAddrRange(ArrCount(ArrIndex)).unit = StrUnit
ArrCount(ArrIndex) = ArrCount(ArrIndex) + 1
Next
'读取IP地址信息表
Set ws = Worksheets("SpecialMarkingsRes")
MaxRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ReDim MyIPSpecialIP(0 To MaxRows - 1)
Set UnitCol_B = ws.Range("B2:B" & Trim(str(MaxRows)))
Set IPAddrCol = ws.Range("C2:C" & Trim(str(MaxRows)))
Set MacAddrCol = ws.Range("D2:D" & Trim(str(MaxRows)))
Set HontNameCol = ws.Range("E2:E" & Trim(str(MaxRows)))
Set MemoCol = ws.Range("F2:F" & Trim(str(MaxRows)))
For iFor = 1 To MaxRows - 1
MyIPSpecialIP(iFor - 1).HostName = UCase(Trim(HontNameCol(iFor).Value))
MyIPSpecialIP(iFor - 1).IPAddr = UCase(Trim(IPAddrCol(iFor).Value))
MyIPSpecialIP(iFor - 1).MacAddr = UCase(Trim(MacAddrCol(iFor).Value))
MyIPSpecialIP(iFor - 1).Memo = UCase(Trim(MemoCol(iFor).Value))
MyIPSpecialIP(iFor - 1).unit = UCase(Trim(UnitCol_B(iFor).Value))
ICount = ICount + 1
Next
L123:
'验证读取的数据
'Dim Jfor As Integer
'For iFor = 0 To 5
'For Jfor = LBound(MyIPAddressIndex(iFor).MyIPAddrRange) To UBound(MyIPAddressIndex(iFor).MyIPAddrRange)
'Debug.Print Str(MyIPAddressIndex(iFor).MyIPAddrRange(Jfor).StartAddr) + "|" + Str(MyIPAddressIndex(iFor).MyIPAddrRange(Jfor).EndAddr) + "|" + MyIPAddressIndex(iFor).MyIPAddrRange(Jfor).Unit
'Next
'Next
'Debug.Print MaxRows - 1
'For iFor = 0 To UBound(MyIPSpecialIP) - 1
' Debug.Print MyIPSpecialIP(iFor).HostName + "|" + MyIPSpecialIP(iFor).IPAddr + "|" + MyIPSpecialIP(iFor).MacAddr + "|" + MyIPSpecialIP(iFor).Memo + "|" + MyIPSpecialIP(iFor).unit
'Next
Debug.Print "完成"
End Sub
Function GetArrIndex(str As String) As Integer
Dim iFor As Integer
For iFor = 0 To 5
If MyIPAddressIndex(iFor).Prefix = str Then
GetArrIndex = iFor
Exit For
End If
Next
End Function有了上面的信息，就可以对比检索NMap保存的XML文件，将IP地址和具体单位一一对应起来了，剩下的工作就比较好做了。
下面的代码是根据给定的IP得到这个IP地址对应的单位以及是否是网关地址、网络打印机、视频设备等（这个数据可以根据需要添加）。
Sub JudgeData()
Dim XmlFile As String
Dim CurrentFilePath As String
CurrentFilePath = Application.ActiveWorkbook.Path
Dim XmlDoc As DOMDocument60
Dim hostNodes As Object
Dim iFor As Integer
Dim hostnode As Object
Dim addressNode As Object
Dim StrIpAddr As String
Dim Unit As String
Dim HostName As String
Dim IRecord As Integer
IRecord = 234
Set XmlDoc = New DOMDocument60
XmlFile = CurrentFilePath + "\20231010-B.xml"
ReadyNetworkData
Sheets("BeDetectedData").Activate
If XmlDoc.Load(XmlFile) = True Then
'读取数据并进行判断
Set hostNodes = XmlDoc.getElementsByTagName("host")
' 遍历host节点集合，获取IP地址
For iFor = 0 To hostNodes.Length - 1
Set hostnode = hostNodes(iFor)
Set addressNode = hostnode.getElementsByTagName("address")(0)
If addressNode.getAttribute("addrtype") = "ipv4" Then
StrIpAddr = addressNode.getAttribute("addr")
Unit = GetUserUnit(StrIpAddr)
HostName = GetHostName(StrIpAddr)
'存入表中
IRecord = IRecord + 1
'IP地址
Range("B" & Trim(str(IRecord))).Select
Selection.FormulaR1C1 = StrIpAddr
'所属单位
Range("C" & Trim(str(IRecord))).Select
Selection.FormulaR1C1 = Unit
'主机名称
Range("D" & Trim(str(IRecord))).Select
Selection.FormulaR1C1 = HostName
End If
Next iFor
MsgBox "完成！"
Else
MsgBox "检查XML文件内容！"
End If
End Sub今天处理NMap输出的XML文件时遇到错误，我还以为是代码有问题，郁闷了很长时间，后面查明是NMap添加了无用信息导致，删除就好了。