option explicit
' on error resume next
Const InputFile = "URLLIST.csv"
Const OutputFile = "DNSLIST.csv"

dim FSI,InF,FSO,OutF  ' File system object
dim IOBuf,NAME,URL,DNSNAME,IP,DNSROOT 'String
dim SepLoc,I
dim WrkStr

Set FSI = Createobject("scripting.filesystemobject")
set InF = FSI.OpenTextFile(Inputfile, 1)
Set FSO = Createobject("scripting.filesystemobject")
Set OutF = FSI.OpenTextFile(Outputfile,8,True)


Do While InF.AtEndOfStream<>True
  IOBuf = InF.ReadLine
  SepLoc = Instr(IOBuf,",")
  NAME =  mid(IOBuf,1,SepLoc-1)
  URL = trim( LCase(mid(IOBUF,SepLoc+1 )) )
  if URL <> "" then
    IP  = GetIP(URL)
    if IP <> "" then 
      DNSNAME = GetDNSName(IP)
    else
      DNSNAME = ""
    end if
  else
    IP = ""
    DNSNAME = ""
  End if

  if DNSNAME <> "" then
    DNSROOT = MID(DNSNAME,InStr(DNSNAME,".") )
  else
    DNSROOT = ""
  END IF

  WrkStr = NAME & "," & URL & "," & DNSNAME & "," & DNSROOT & "," & IP

  OutF.writeline WRKStr
Loop

InF.close
OUtF.Close

set OutF = nothing
set FSO = nothing
set InF = nothing
set FSI = nothing
msgbox "FINISH...."

Function GetIP(URL)
  dim WrkStr,WrkArray
  WrkStr = wshnslookup(URL)
  WrkArray = split(WrkStr,VbCrlf,-1,1)

  for I = 0 to ubound(WrkArray)
    if Instr(WrkArray(I),"Address:") then
      GetIP = Trim( Mid(WrkArray(I),9) )
    end if
  next
End Function


Function GetDNSName(IP)
    dim WrkStr,WrkArray
    WrkStr = wshnslookup(IP)
    WrkArray = split(WrkStr,VbCrlf,-1,1)

    for I = 0 to ubound(WrkArray)
      if Instr(WrkArray(I),"Name:") then
        GetDNSName = Trim( Mid(WrkArray(I),6) )
      end if
    next
End function

Function wshnslookup(URL)

  Const WshFailed = 2 
  Const WshFinished = 1 
  Const WshRunning = 0 

  dim WshShell,oWshScriptExec,I,WrkStr, WrkArray

  Set WshShell = WScript.CreateObject("WScript.Shell") 

  Set oWshScriptExec = WshShell.Exec("nslookup.exe " & URL) 'nslookup‚šŽĄsB 

  with oWshScriptExec
    Wshnslookup = .StdOut.ReadALL()

    do while .Status <> WshFinished
      Wscript.Sleep 100
    loop
  end with

  set oWshScriptExec = nothing
  set WshShell = nothing

End Function