Koodit: VB6: Hosti IP:stä ja toisinpäin

Private Const AF_INET = 2
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const SOCKET_ERROR As Long = -1
Private Const WS_VERSION_REQD As Long = &H101
Type HOSTENT
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Type servent
    s_name As Long
    s_aliases As Long
    s_port As Long
    s_proto As Long
End Type
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal CP As String) As Long
Private Declare Function inet_ntoa Lib "WSOCK32.DLL" (ByVal LonkiIP As Long) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (Addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal host_name As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function lstrlen Lib "kernel32" (ByVal StringPointteriing As Any) As Integer

Public Function HaeIPNimestä(Hosti As String) As Long 'hakee ip:n (long-tyyppisen homman) nimestä (kuten www.ohjelmointiputka.net)...

    Dim IppeID As Long, HostiHomma As HOSTENT
    Dim addrListi As Long, Ippe As Long

    If WSInittaa = False Then Exit Function 'ws:ää tarvitaan, jos ei initointi onnistu niin ei mikään
    If inet_addr(Hosti) = -1 Then 'koklataan onko sitä
        IppeID = gethostbyname(Hosti) 'id homma
        If IppeID <> 0 Then 'jos on niin leikitään pointtereilla. c++:ssa olisi vähän helpompaa :D
            CopyMemory HostiHomma, ByVal IppeID, Len(HostiHomma)
            CopyMemory addrListi, ByVal HostiHomma.h_addr_list, 4
            CopyMemory Ippe, ByVal addrListi, HostiHomma.h_length
        End If
    End If
    HaeIPNimestä = Ippe
    WSACleanup 'turhat ws-hommat vek

End Function


Public Function HaeNimiIPstä(ByVal HakuOsote As String) As String 'hakee nimen ip-osoitteesta

    Dim HostEntti As Long
    Dim Osote As Long
    Dim Pituus As Long

    If WSInittaa() = False Then Exit Function 'ws:ää tarvitaan tässäki, jos ei initointi onnistu niin ei mikään
    Osote = inet_addr(HakuOsote) 'longhommaksi
    If Osote <> SOCKET_ERROR Then
        DoEvents 'doeventsiä tarttee jostain syystä, kokeilin ilman sitä muttei toiminut. funkkarit tarttee jonkun verran aikaa ihmettelemiseen
        HostEntti = gethostbyaddr(Osote, 4, AF_INET) 'hostent-pointteri
        DoEvents
        If HostEntti <> 0 Then
            CopyMemory HostEntti, ByVal HostEntti, 4 'kopsitaan hostenttiin osoittimen osoittama tieto
            Pituus = lstrlen(ByVal HostEntti)
            If Pituus > 0 Then
                HakuOsote = Space(Pituus)
                CopyMemory ByVal HakuOsote, ByVal HostEntti, Pituus 'ja osoitinleikkiä taas. yäk
                HaeNimiIPstä = HakuOsote
            End If
        Else
            HaeNimiIPstä = HakuOsote 'DNS:llä ei ole nimeä sille, eli takasi ip:ksi
        End If
        WSACleanup 'turhat ws-hommat vek
    End If

End Function

Public Function HaeTekstiIP(ByVal LonkiIP As Long) As String 'hakee tekstisen ip:n (niinku 127.0.0.1) long-tyyppisestä iphommasta

    Dim Pituus As Long
    Dim StringPointteri As Long
    Dim Tulos As String

    Tulos = String(32, 0) 'alustetaan se
    StringPointteri = inet_ntoa(LonkiIP) 'ptrejä lisää
    If StringPointteri Then 'jos se löytyy
        Pituus = lstrlen(StringPointteri)
        If Pituus > 32 Then Pituus = 32
        CopyMemory ByVal Tulos, ByVal StringPointteri, Pituus 'pointterin osoittama tieto tulokseen...
        Tulos = Left(Tulos, Pituus) 'irrotetaan turhat nollatavut
        HaeTekstiIP = Tulos
    End If

End Function

Private Function WSInittaa() As Boolean 'wsinitointifunkkari, helpompi leikkiä tällä kun parilla ylimääräisellä dimillä

   Dim WSAD As WSADATA 'pari tietoa
   Dim success As Long

   WSInittaa = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS 'wsinittaa on true jos wsastartup onnistuu

End Function