"Enter"a basıp içeriğe geçin

Excel Makro ile Host Alan Adı Listesinden IP Adresi Listesini Alma

Siber güvenlik konularıyla ilgilenen, BT işiyle uğraşanlar, BT sistem mühendisleri ya da SEO işiyle uğraşanlar zaman zaman host adreslerine topluca ping atıp bu hostların ayakta olup olmadığını, ayaktaysa ip adreslerinin ne olduğunu bilmek isteyebilirler.

Bu işlem için farklı alternatif yöntemler ve araçlar mevcut ancak ben ufak bir Excel makrosu ile bunu hallettim. Makro şöyle çalışıyor. Öncelikle TumHostIPleriniGetir fonksiyonu içerisindeki VBA kodu, A2 hücresinden itibaren A sütunundaki tüm dolu hücrelerdeki host isimlerini alarak bunlara WMI (Windows Management Instrumentation) altyapısını kullanarak ping atıyor ve ayakta olanların ip adreslerini alarak, B2 hücresinden itibaren ip karşılıklarını B sütunundaki hücrelere, A sütunundaki host isimlerine karşılık gelecek şekilde yazıyor.

Makroyu ister xlsm formatında buradan indirebilir, isterseniz aşağıdaki VBA makro kodu halini kendi Excel dosyanıza kopyala-yapıştır yaparak kendiniz de hazırlayabilirsiniz.

Sub TumHostIPleriniGetir()
    
    IpHucreleriniTemizle
    
    Dim strHostAdi As String
    Dim strIpAdresi As String
    
    Application.ScreenUpdating = True
    
    For introw = 2 To ActiveSheet.Cells(65536, 1).End(xlUp).Row
        strHostAdi = ActiveSheet.Cells(introw, 1).Value
        strIpAdresi = HostIpAresiniAl(strHostAdi)
        If strIpAdresi = "Kapalı" Then
            ActiveSheet.Cells(introw, 2).Value = strIpAdresi
            ActiveSheet.Cells(introw, 2).Font.Color = RGB(150, 0, 0)
        Else
            ActiveSheet.Cells(introw, 2).Value = strIpAdresi
            ActiveSheet.Cells(introw, 2).Font.Color = RGB(0, 150, 0)
        End If
    Next
End Sub

Function HostIpAresiniAl(p_sHostAdi)
    Dim wmiQuery
    Dim objWMIService
    Dim objPing
    Dim objStatus

    wmiQuery = "Select * From Win32_PingStatus Where Address = '" & p_sHostAdi & "'"

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set objPing = objWMIService.ExecQuery(wmiQuery)

    For Each objStatus In objPing
        If objStatus.StatusCode = 0 Then
            HostIpAresiniAl = objStatus.ProtocolAddress
        Else
            HostIpAresiniAl = "Kapalı"
        End If
    Next
End Function

Function Ping(p_sHostAdr)
    Dim objshell, boolcode
    Set objshell = CreateObject("wscript.shell")
    
    boolcode = objshell.Run("ping -n 1 -w 1000 " & p_sHostAdr, 0, True)
    
    If boolcode = 0 Then
        Ping = True
    Else
        Ping = False
    End If
End Function

Sub IpHucreleriniTemizle()
    Range("B2:B" & Rows.Count).Clear
End Sub

Kaynaklar

İlk Yorumu Siz Yapın

Bir yanıt yazın

E-posta adresiniz yayınlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir