Test Foro de elhacker.net SMF 2.1

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 ;)

Cita de: VanX en 10 Julio 2011, 16:47 PM
....y necesitaria que se pudiera copiar. He intentado con todo lo que he podido pero no consigo hacerlo...

Deberias buscar sobre la clase Clipboard

Cita de: VanX en 10 Julio 2011, 16:47 PM

Código (vb) [Seleccionar] Expandir


Private Sub Command1_Click()
    MsgBox Resolve("google.com", "208.67.222.222")
End Sub


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!!!

http://support.microsoft.com/kb/160215
http://support.microsoft.com/kb/154512

Tadaaaaa

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)

no me funciona lo del .txt, ya hace tiempo que los AV algunos lo detectan  :-\

gracias de todos modos