Autor
|
Tema: Obtener IP de una DNS vb6 (Leído 3,496 veces)
|
VanX
Wiki
Desconectado
Mensajes: 222
|
Hola, buscando en google encontré este code que sirve para sacar la IP a una DNS pero me manda la solución en un MsgBox y necesitaria que se pudiera copiar. He intentado con todo lo que he podido pero no consigo hacerlo... Option Explicit Private Declare Function DnsQuery Lib "dnsapi" Alias "DnsQuery_A" (ByVal strname As String, ByVal wType As Integer, ByVal fOptions As Long, ByVal pServers As Long, ppQueryResultsSet As Long, ByVal pReserved As Long) As Long Private Declare Function DnsRecordListFree Lib "dnsapi" (ByVal pDnsRecord As Long, ByVal FreeType As Long) As Long Private Declare Function lstrlen Lib "kernel32" (ByVal straddress As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long) Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal pIP As Long) As Long Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal sAddr As String) As Long Private Const DnsFreeRecordList As Long = 1 Private Const DNS_TYPE_A As Long = &H1 Private Const DNS_QUERY_BYPASS_CACHE As Long = &H8 Private Type VBDnsRecord pNext As Long pName As Long wType As Integer wDataLength As Integer flags As Long dwTel As Long dwReserved As Long prt As Long others(35) As Byte End Type Private Sub Command1_Click() MsgBox Resolve("google.com", "208.67.222.222") End Sub Private Function Resolve(sAddr As String, Optional sDnsServers As String) As String Dim pRecord As Long Dim pNext As Long Dim uRecord As VBDnsRecord Dim lPtr As Long Dim vSplit As Variant Dim laServers() As Long Dim pServers As Long Dim sName As String If LenB(sDnsServers) <> 0 Then vSplit = Split(sDnsServers) ReDim laServers(0 To UBound(vSplit) + 1) laServers(0) = UBound(laServers) For lPtr = 0 To UBound(vSplit) laServers(lPtr + 1) = inet_addr(vSplit(lPtr)) Next pServers = VarPtr(laServers(0)) End If If DnsQuery(sAddr, DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then pNext = pRecord Do While pNext <> 0 Call CopyMemory(uRecord, pNext, Len(uRecord)) If uRecord.wType = DNS_TYPE_A Then lPtr = inet_ntoa(uRecord.prt) sName = String(lstrlen(lPtr), 0) Call CopyMemory(ByVal sName, lPtr, Len(sName)) If LenB(Resolve) <> 0 Then Resolve = Resolve & " " End If Resolve = Resolve & sName End If pNext = uRecord.pNext Loop Call DnsRecordListFree(pRecord, DnsFreeRecordList) End If End Function
saludos y gracias de antemano
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
....y necesitaria que se pudiera copiar. He intentado con todo lo que he podido pero no consigo hacerlo...
Deberias buscar sobre la clase Clipboard Private Sub Command1_Click() MsgBox Resolve("google.com", "208.67.222.222") End Sub
|
|
« Última modificación: 10 Julio 2011, 17:46 pm por raul338 »
|
En línea
|
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
HOLA!!!
Bueno, yo opte por lo facil la vez que lo quise hacer...
Podes guardar en in txt un comando ping y lo lees.
O conectate con un socket y ahí revisas el remote host ip.
GRACIAS POR LEER!!!
|
|
|
En línea
|
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!" "La peor de las ignorancias es no saber corregirlas"
79137913 *Shadow Scouts Team*
|
|
|
Elemental Code
Desconectado
Mensajes: 622
Im beyond the system
|
http://support.microsoft.com/kb/160215http://support.microsoft.com/kb/154512Tadaaaaa Si lei bien con eso deberia ser suficiente.
Podia necesitarlo en un futuro, prefiero colgarlo aca para no perderlo. ' //////////////////////////////////////////////////////////////// ' // *GetIPfromHost // ' // *Autor: Elemental Code (Milton.Candelero@gmail.com) // ' // *Podeis agrandar o reducir el codigo, siempre y cuando se // ' // respete la autoria y se me comuniquen esos cambios. // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function GetIPfromHost(ByRef sURL As String) As String Dim WshShell, oExec, a$ Set WshShell = CreateObject("WScript.Shell") Set oExec = WshShell.Exec("ping " & sURL) a$ = "" Do While oExec.Status = 0 If Not oExec.StdOut.AtEndOfStream Then a$ = a$ & oExec.StdOut.Read(1) End If DoEvents Loop GetIPfromHost = Text_Between_Words(a$, "[", "]") Set oExec = Nothing Set WshShell = Nothing End Function ' //////////////////////////////////////////////////////////////// ' // *Text_Between_Words // ' // *Autor: *PsYkE1* (miguelin.majo@gmail.com) // ' // *Podeis agrandar o reducir el codigo, siempre y cuando se // ' // respete la autoria y se me comuniquen esos cambios. // ' // *Agradecimientos a BlackZeroX. // ' // *Visita http://foro.rthacker.net // ' //////////////////////////////////////////////////////////////// Public Function Text_Between_Words(Text As String, String1 As String, _ String2 As String) As String Dim Pos1 As Integer Dim Pos2 As Integer Dim Start As Integer Dim TotalLen As Integer Pos1 = InStr(Text, String1) Pos2 = InStr(Text, String2) If Pos1 = 0 Or Pos2 = 0 Then Exit Function Start = Pos1 + Len(String1) TotalLen = Pos2 - Start Text_Between_Words = Mid$(Text, Start, TotalLen) End Function
Mete esto en un modulo y llamalo asi: msgbox GetIPfromHost ("www.google.com")
Espero que sirva (Muestra una cmd en blanco :S, voy a ver si logro arreglarlo)
|
|
« Última modificación: 11 Julio 2011, 23:03 pm por Elemental Code »
|
En línea
|
I CODE FOR $$$ Programo por $$$ Hago tareas, trabajos para la facultad, lo que sea en VB6.0 Mis programas
|
|
|
VanX
Wiki
Desconectado
Mensajes: 222
|
no me funciona lo del .txt, ya hace tiempo que los AV algunos lo detectan gracias de todos modos
|
|
|
En línea
|
|
|
|
|
|