Risultati da 1 a 4 di 4

Discussione: Creare funzione reverse dns lookup



  1. #1
    L'avatar di maximo890
    Clicca e Apri
    Data Registrazione
    Nov 2015
    Località
    Venezia
    Età
    28
    Messaggi
    4
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0

    Creare funzione reverse dns lookup

    Buonasera a tutti,

    sto cercando di far funzione di excel che mi permetta di convertire un IP di un server al suo DNS.
    Ho trovato le basi del seguente codice su un forum americano. Io le ho solo modificate aggiungendo PtrSafe per renderle compatibili con il mio sistema a 64bit.

    Ecco qui il codice:

    'In a module
    Public Const MIN_SOCKETS_REQD As Long = 1
    Public Const WS_VERSION_REQD As Long = &H101
    Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
    Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
    Public Const SOCKET_ERROR As Long = -1
    Public Const WSADESCRIPTION_LEN = 257
    Public Const WSASYS_STATUS_LEN = 129
    Public Const MAX_WSADescription = 256
    Public Const MAX_WSASYSStatus = 128
    Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
    End Type
    Declare PtrSafe Function WSACleanup Lib "WSOCK32" () As Long
    Declare PtrSafe Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
    Declare PtrSafe Function gethostbyaddr Lib "wsock32.dll" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
    Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Public Function GetHostName(ByVal Address As Long) As String
    Dim lLength As Long, lRet As Long
    If Not SocketsInitialize() Then Exit Function
    lRet = gethostbyaddr(Address, 4, AF_INET)
    If lRet <> 0 Then
    CopyMemory lRet, ByVal lRet, 4
    lLength = lstrlenA(lRet)
    If lLength > 0 Then
    GetHostName = Space$(lLength)
    CopyMemory ByVal GetHostName, ByVal lRet, lLength
    End If
    Else
    GetHostName = ""
    End If
    SocketsCleanup
    End Function
    Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
    End Function
    Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
    End Function
    Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
    MsgBox "Socket error occurred in Cleanup."
    End If
    End Sub
    Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    Dim sLoByte As String
    Dim sHiByte As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
    MsgBox "The 32-bit Windows Socket is not responding."
    SocketsInitialize = False
    Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
    MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
    SocketsInitialize = False
    Exit Function
    End If
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
    sHiByte = CStr(HiByte(WSAD.wVersion))
    sLoByte = CStr(LoByte(WSAD.wVersion))
    MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
    SocketsInitialize = False
    Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
    End Function


    Il problema che la formula non funziona.

    Continua a darmi il seguente messaggio “Winsock error” quando la utilizzo in excel.

    Voi per caso avete qualche idea perché mi dia questo messaggio? Avete anche qualche soluzione per farla funzionare?

    Grazie a tutti in anticipo
    Massimo

  2. #2
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4916
    Versione Office
    2013
    Likes ricevuti
    1117
    Likes dati
    1126
    Ciao Massimo
    Benvenuto in ForumExcel.it quando hai dei codici VBA molto lunghi e copi ed incolli, c'è il rischio che perdi delle informazioni, indi per cui ti consiglio di mettere tutto tra TAG [CODE]
    procedi cosi:
    Rispondi>>> modalità avanzata>> clicca sul cancelletto [#] e poi incolli il tuo codice VBA in mezzo alle scritte '[CODE]inserisci codice[CODE]
    e vedrai che si visualizzarà un codice come questo qui sotto.

    In merito alla domanda che hai fatto credo che manca l'istruzione iniziale ...Forse....

    Function nome_funzione ()



    Codice: 
    
    Public Const MIN_SOCKETS_REQD As Long = 1
    Public Const WS_VERSION_REQD As Long = &H101
    Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
    Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
    Public Const SOCKET_ERROR As Long = -1
    Public Const WSADESCRIPTION_LEN = 257
    Public Const WSASYS_STATUS_LEN = 129
    Public Const MAX_WSADescription = 256
    Public Const MAX_WSASYSStatus = 128
    Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
    End Type
    Declare PtrSafe Function WSACleanup Lib "WSOCK32" () As Long
    Declare PtrSafe Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
    Declare PtrSafe Function gethostbyaddr Lib "wsock32.dll" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
    Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Public Function GetHostName(ByVal Address As Long) As String
    Dim lLength As Long, lRet As Long
    If Not SocketsInitialize() Then Exit Function
    lRet = gethostbyaddr(Address, 4, AF_INET)
    If lRet <> 0 Then
    CopyMemory lRet, ByVal lRet, 4
    lLength = lstrlenA(lRet)
    If lLength > 0 Then
    GetHostName = Space$(lLength)
    CopyMemory ByVal GetHostName, ByVal lRet, lLength
    End If
    Else
    GetHostName = ""
    End If
    SocketsCleanup
    End Function
    Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
    End Function
    Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
    End Function
    Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
    MsgBox "Socket error occurred in Cleanup."
    End If
    End Sub
    Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    Dim sLoByte As String
    Dim sHiByte As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
    MsgBox "The 32-bit Windows Socket is not responding."
    SocketsInitialize = False
    Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
    MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
    SocketsInitialize = False
    Exit Function
    End If
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
    sHiByte = CStr(HiByte(WSAD.wVersion))
    sLoByte = CStr(LoByte(WSAD.wVersion))
    MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
    SocketsInitialize = False
    Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
    End Function
    Ultima modifica fatta da:Gerardo Zuccalà; 01/11/15 alle 21:35

  3. #3
    L'avatar di maximo890
    Clicca e Apri
    Data Registrazione
    Nov 2015
    Località
    Venezia
    Età
    28
    Messaggi
    4
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0
    Ho rimesso il codice in maniera pulita. Grazie gerardo per la segnalazione.


    Codice: 
    'In a module
    Public Const MIN_SOCKETS_REQD As Long = 1
    Public Const WS_VERSION_REQD As Long = &H101
    Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
    Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
    Public Const SOCKET_ERROR As Long = -1
    Public Const WSADESCRIPTION_LEN = 257
    Public Const WSASYS_STATUS_LEN = 129
    Public Const MAX_WSADescription = 256
    Public Const MAX_WSASYSStatus = 128
    Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
    End Type
    Declare PtrSafe Function WSACleanup Lib "WSOCK32" () As Long
    Declare PtrSafe Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
    Declare PtrSafe Function gethostbyaddr Lib "wsock32.dll" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
    Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Public Function GetHostName(ByVal Address As Long) As String
    Dim lLength As Long, lRet As Long
    If Not SocketsInitialize() Then Exit Function
    lRet = gethostbyaddr(Address, 4, AF_INET)
    If lRet <> 0 Then
    CopyMemory lRet, ByVal lRet, 4
    lLength = lstrlenA(lRet)
    If lLength > 0 Then
    GetHostName = Space$(lLength)
    CopyMemory ByVal GetHostName, ByVal lRet, lLength
    End If
    Else
    GetHostName = ""
    End If
    SocketsCleanup
    End Function
    Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
    End Function
    Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
    End Function
    Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
    MsgBox "Socket error occurred in Cleanup."
    End If
    End Sub
    Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    Dim sLoByte As String
    Dim sHiByte As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
    MsgBox "The 32-bit Windows Socket is not responding."
    SocketsInitialize = False
    Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
    MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
    SocketsInitialize = False
    Exit Function
    End If
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
    sHiByte = CStr(HiByte(WSAD.wVersion))
    sLoByte = CStr(LoByte(WSAD.wVersion))
    MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
    SocketsInitialize = False
    Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
    End Function

    Quindi secondo te dovrei aggiungere solo il nome della funzione? Come si farebbe? grazie in anticipo

  4. #4
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4916
    Versione Office
    2013
    Likes ricevuti
    1117
    Likes dati
    1126
    Ciao Massimo
    Massimo scrive:
    Quindi secondo te dovrei aggiungere solo il nome della funzione? Come si farebbe?
    Massimo io non sono un esperto di VBA ma il mio intervento era volto a farti inserire la domanda nel modo corretto, cosi da non essere ignorata e poi notavo che in alto al Codice VBA non c' era il nome della procedura SUB, Function ecc. ecc. e forse quello era il problema....
    Sono sicuro che qui cè qualcuno esperto che vuole aiutarti, quindi dovremmo tentare in altri modi, e ti suggerisco anzichè mettere un codice, perchè non provi ad allegare un file con una descrizione del risultato desiderato e magari con una simulazione del risultato scritto a mano, e chissà magari qualcuno ha la soluzione, perchè questo codice sembra che non sia stato apprezzato e di conseguenza è stato ignorato
    Ciao

Discussioni Simili

  1. macro per creare una tabella dei risultati in funzione di due variabili
    Di kebenaz nel forum Domande su Excel VBA e MACRO
    Risposte: 1
    Ultimo Messaggio: 28/09/16, 16:48
  2. Funzione indice/confronta all'interno della Funzione "O" ed "E"
    Di Rosaria79 nel forum Domande su Excel in generale
    Risposte: 6
    Ultimo Messaggio: 28/06/16, 20:57

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •