Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

GetAddrInfo

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin GetAddrInfo

    GetAddrInfo: The getaddrinfo function provides protocol-independent translation from an ANSI host name to an address.

    Click image for larger version  Name:	GetAddrInfo.png Views:	62 Size:	16.8 KB ID:	782421

    Code:
    #COMPILE EXE '#Win#
    #DIM ALL
    #INCLUDE "Win32Api.inc"
    #INCLUDE "ws2def.inc."
    #INCLUDE "in6addr.inc"
    
    %MAX_HOSTNAME_LEN = 128
    %SNLEN            = 80
    
    %AF_BTM     =  32 'The Bluetooth address family.
    %IPPROTO_RM = 113 'The PGM protocol for reliable multicast.
    
    DECLARE FUNCTION GetAddrInfo LIB "ws2_32.dll" ALIAS "getaddrinfo" _
    (HostIpName AS ASCIIZ, ServicePortName AS ASCIIZ, Hints AS ADDRINFOA, BYVAL pRes AS ADDRINFOA POINTER) AS LONG
    
    DECLARE FUNCTION FreeAddrInfo LIB "ws2_32.dll" ALIAS "freeaddrinfo"(AddrInfoPointer AS DWORD)AS LONG
    
    DECLARE FUNCTION RtlIpv6AddressToStringA LIB "Ntdll.dll" ALIAS "RtlIpv6AddressToStringA" _
    (BYREF ADDR AS in6_addr, BYREF S AS ASCIIZ) AS DWORD
    
    GLOBAL hDlg AS DWORD
    
    $AppName      = "GetAddrInfo"
    %Edit         = 101
    %ComboboxIp   = 201
    %ComboboxPort = 202
    '_____________________________________________________________________________
    
    FUNCTION Ai_FlagsToString(ai_flags AS DWORD) AS STRING
     LOCAL sBuffer AS STRING
    
     IF ai_flags THEN
       IF (ai_flags AND %AI_PASSIVE)     THEN sBuffer =  "AI_PASSIVE, "
       IF (ai_flags AND %AI_CANONNAME)   THEN sBuffer &= "AI_CANONNAME, "
       IF (ai_flags AND %AI_NUMERICHOST) THEN sBuffer &= "AI_NUMERICHOST, "
       IF (ai_flags AND %AI_ADDRCONFIG)  THEN sBuffer &= "AI_ADDRCONFIG, "
       IF (ai_flags AND %AI_SECURE)      THEN sBuffer &= "AI_SECURE, "
       IF (ai_flags AND %AI_RETURN_PREFERRED_NAMES) THEN
         sBuffer &= "AI_RETURN_PREFERRED_NAMES, "
       END IF
       FUNCTION = LEFT$(sBuffer, -2)
     ELSE
       FUNCTION = "AI_NONE"
     END IF
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION Ai_FamilyToString(ai_family AS DWORD) AS STRING
    
     SELECT CASE ai_family
       CASE %AF_UNSPEC  : FUNCTION = "AF_UNSPEC"
       CASE %AF_INET    : FUNCTION = "AF_INET"
       CASE %AF_NETBIOS : FUNCTION = "AF_NETBIOS"
       CASE %AF_INET6   : FUNCTION = "AF_INET6"
       CASE %AF_IRDA    : FUNCTION = "AF_IRDA"
       CASE %AF_BTM     : FUNCTION = "AF_BTM"
       CASE ELSE        : FUNCTION = "AF_UNKNOWN" & STR$(ai_family)
     END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION Ai_SocktTypeToString(ai_sockttype AS DWORD) AS STRING
    
     SELECT CASE ai_sockttype
       CASE %SOCK_STREAM    : FUNCTION = "SOCK_STREAM"
       CASE %SOCK_DGRAM     : FUNCTION = "SOCK_DGRAM"
       CASE %SOCK_RAW       : FUNCTION = "SOCK_RAW"
       CASE %SOCK_RDM       : FUNCTION = "SOCK_RDM"
       CASE %SOCK_SEQPACKET : FUNCTION = "SOCK_SEQPACKET"
       CASE ELSE            : FUNCTION = "SOCK_UNKNOWN" & STR$(ai_sockttype)
     END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION Ai_ProtocolToString(ai_protocol AS DWORD) AS STRING
    
     SELECT CASE ai_protocol
       CASE 0            : FUNCTION = "IPPROTO_ZERO" 'Not IPv4 nor IPv6
       CASE %IPPROTO_TCP : FUNCTION = "IPPROTO_TCP"
       CASE %IPPROTO_UDP : FUNCTION = "IPPROTO_UDP"
       CASE %IPPROTO_RM  : FUNCTION = "IPPROTO_RM"
       CASE ELSE         : FUNCTION = "IPPROTO_UNKNOWN" & STR$(ai_protocol)
     END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION ipDwordToDot(ip AS DWORD) AS STRING
     LOCAL pByte AS BYTE POINTER
    
     pByte = VARPTR(ip)
     FUNCTION = USING$("#_.#_.#_.#", @pByte, @pByte[1], @pByte[2], @pByte[3])
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION WinErrMsg(BYVAL ErrNum AS DWORD)AS STRING
     LOCAL hLib      AS DWORD
     LOCAL errorFlag AS DWORD
     LOCAL os        AS OSVERSIONINFO
     LOCAL zError    AS ASCIIZ * 1024
    
     SELECT CASE AS LONG ErrNum
    
       CASE 2100 TO 2999 'NT, Network, NETWORK_ERROR_FIRST TO NETWORK_ERROR_LAST
         os.dwOSVersionInfoSize = SIZEOF(os)
         GetVersionEx os
         IF os.dwPlatformId = %VER_PLATFORM_WIN32_NT THEN _
           hLib = LoadLibraryEx("NETMSG.DLL", BYVAL 0, %LOAD_LIBRARY_AS_DATAFILE)
    
       CASE 12000 TO 12171 'Internet INTERNET_ERROR_FIRST TO NTERNET_ERROR_LAST
         hLib = LoadLibraryEx("WININET.DLL", BYVAL 0, %LOAD_LIBRARY_AS_DATAFILE)
    
     END SELECT
    
     errorFlag = %FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS OR _
                 %FORMAT_MESSAGE_MAX_WIDTH_MASK
     IF hLib THEN errorFlag = errorFlag OR %FORMAT_MESSAGE_FROM_HMODULE
    
     IF FormatMessage(errorFlag, BYVAL hLib, ErrNum, MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
                      zError, SIZEOF(zError), BYVAL 0) THEN
       FUNCTION = "Error" & STR$(ErrNum) & ":" & $SPC & zError
     ELSE
       FUNCTION = "Error" & STR$(ErrNum) & ", unknown."
     END IF
     IF hLib THEN FreeLibrary(hLib)
    
    END FUNCTION
    '_____________________________________________________________________________
    
    SUB TextDel(BYVAL hEdit AS DWORD)
    
     'Erase all, Microsoft recommended way
     SendMessage(hEdit, %WM_SETTEXT, 0, BYVAL 0)
    
    END SUB
    '_____________________________________________________________________________
    
    SUB TextAdd(BYVAL hEdit AS DWORD, BYVAL sText AS STRING)
    
     'Move the caret to the end of text.
     SendMessage(hEdit, %EM_SETSEL, -1, -1)
    
     sText = sText & $CRLF 'Add a CRLF if needed
    
     'Insert the string at caret position.
     SendMessage(hEdit, %EM_REPLACESEL, %TRUE, BYVAL STRPTR(sText))
    
    END SUB
    '_____________________________________________________________________________
    
    FUNCTION AddrInfoGet() AS STRING
     LOCAL pAi_Addr_In     AS SOCKADDR_IN POINTER
     LOCAL pAi_Addr        AS SOCKADDR POINTER
     LOCAL pRes            AS ADDRINFOA POINTER
     LOCAL pResFirst       AS ADDRINFOA POINTER
     LOCAL Hints           AS ADDRINFOA
     LOCAL WsaInfo         AS WSADATA
     LOCAL HostIpName      AS ASCIIZ * %MAX_HOSTNAME_LEN
     LOCAL ServicePortName AS ASCIIZ * %SNLEN
     LOCAL zIPv6           AS ASCIIZ * 40
     LOCAL sBuffer         AS STRING
     LOCAL Retval          AS LONG
    
     COMBOBOX GET TEXT hDlg, %ComboboxIp   TO HostIpName
     COMBOBOX GET TEXT hDlg, %ComboboxPort TO ServicePortName
    
     IF WSAStartup(&H0202, WsaInfo) = %ERROR_SUCCESS THEN
    
       IF 0 THEN 'Optional use of a ADDRINFO hint, see MSDN
         Hints.ai_flags    = %AI_ALL      '0x0100  IPv6 addresses and IPv4 addresses with AI_V4MAPPED.
         Hints.ai_family   = %AF_UNSPEC   'AF_INET and AF_INET6 AF_INET AF_INET6
         Hints.ai_socktype = %SOCK_STREAM '01
         Hints.ai_protocol = %IPPROTO_TCP '06
       END IF
    
       sBuffer = "HostIpName"       & $TAB & (HostIpName)      & $CRLF
       sBuffer &= "ServicePortName" & $TAB & (ServicePortName) & $CRLF
       sBuffer &= ""                & $TAB & ""                & $CRLF
    
       Retval = GetAddrInfo(HostIpName, ServicePortName, Hints, BYVAL VARPTR(pResFirst))
       IF Retval = %ERROR_SUCCESS THEN 'Thank to Jim for the Retval oversight ;-)
         pRes = pResFirst
         DO 'Scan each entry
           sBuffer &= "family:           " & $TAB & Ai_FamilyToString(@pRes.ai_family)      & $CRLF
           sBuffer &= "flags:            " & $TAB & Ai_FlagsToString(@pRes.ai_flags)        & $CRLF
           sBuffer &= "sockttype:        " & $TAB & Ai_sockttypeToString(@pRes.ai_socktype) & $CRLF
           sBuffer &= "protocol:         " & $TAB & Ai_ProtocolToString(@pRes.ai_protocol)  & $CRLF
           sBuffer &= "canonical-addr:   " & $TAB & HEX$(@pRes.ai_canonname)                & $CRLF
           IF @pRes.ai_canonname THEN
             sBuffer &= "canonical-string: " & $TAB & (@pRes.@ai_canonname) & $CRLF
           END IF
           pAi_Addr = @pRes.ai_addr
           sBuffer &= "addr-sa-family:   " & $TAB & Ai_FamilyToString((@pAi_Addr.sa_family)) & $CRLF
           SELECT CASE @pAi_Addr.sa_family
    
             CASE %AF_INET
               pAi_Addr_In = @pRes.ai_addr
               sBuffer &= "addr-sin-addr:    " & $TAB & ipDwordToDot(@pAi_Addr_In.sin_addr.S_un.s_addr) & $CRLF
               sBuffer &= "addr-sin-port:    " & $TAB & FORMAT$(@pAi_Addr_In.sin_port)                  & $CRLF
    
             CASE %AF_INET6
               RtlIpv6AddressToStringA(BYVAL VARPTR(@pAi_Addr.sa_data(0)) + 6, zIPv6)
               sBuffer &= "addr-sa-data:     " & $TAB & zIPv6 & $CRLF
    
             CASE %AF_UNSPEC
               sBuffer &= "AF_UNSPEC:     " & $TAB & "" & $CRLF
    
             CASE %AF_NETBIOS
               sBuffer &= "AF_NETBIOS:    " & $TAB & "" & $CRLF
    
           END SELECT
           sBuffer &= "" & $TAB & "" & $CRLF
           pRes = @pRes.ai_next 'Next pointer to a ADDRINFOA structure
         LOOP UNTIL pRes = 0
         FreeAddrInfo(pResFirst)
       END IF
       sBuffer &= "Error:            " & $TAB & WinErrMsg(Retval) & $CRLF 'Success returns zero. Failure returns a nonzero Windows Sockets error code
    
       WSACleanup()
    
       FUNCTION = sBuffer
     END IF
    
    END FUNCTION
    '_____________________________________________________________________________
    
    CALLBACK FUNCTION DlgProc
     STATIC hEdit AS DWORD
    
     SELECT CASE CBMSG
    
       CASE %WM_INITDIALOG
         hEdit = GetDlgItem(CBHNDL, %Edit)
         PostMessage(hEdit, %EM_SETSEL, -1, -1) 'Deselect text
         PostMessage(hDlg, %WM_COMMAND, MAKDWD(%ComboboxIp, %CBN_CLOSEUP), GetDlgItem(hDlg, %ComboboxIp))
    
       CASE %WM_COMMAND
         SELECT CASE CBCTL
           CASE %ComboboxIp, %ComboboxPort
             IF CBCTLMSG = %CBN_CLOSEUP OR CBCTLMSG = 1 THEN
               TextDel(hEdit)
               TextAdd(hEdit, AddrInfoGet())
             END IF
         END SELECT
    
       CASE %WM_SIZE 'Dialog size have changed
         LOCAL ClientSizeX AS LONG
         LOCAL ClientSizeY AS LONG
         IF CBWPARAM <> %SIZE_MINIMIZED THEN
           ClientSizeX = LO(WORD, CBLPARAM)
           ClientSizeY = HI(WORD, CBLPARAM)
           MoveWindow(hEdit, 3, 3 + 30, ClientSizeX - 6, ClientSizeY - 6 - 30, %TRUE)
         END IF
    
      END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION PBMAIN() AS LONG
     LOCAL sText AS STRING
     LOCAL hIcon AS DWORD
    
     DIALOG NEW %HWND_DESKTOP, $AppName, , , 220, 300, _
     %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU OR %WS_THICKFRAME, 0 TO hDlg
    
     hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 9)
     SetClassLong(hDlg, %GCL_HICON,hIcon)
    
     CONTROL ADD COMBOBOX, hDlg, %ComboboxIp, , 3, 3, 120, 150, %WS_TABSTOP OR %CBS_DROPDOWN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
     COMBOBOX ADD hDlg, %ComboboxIp, "microsoft.com"
     COMBOBOX ADD hDlg, %ComboboxIp, "powerbasic.com"
     COMBOBOX ADD hDlg, %ComboboxIp, "ibm.com"
     COMBOBOX ADD hDlg, %ComboboxIp, "att.com"
     COMBOBOX ADD hDlg, %ComboboxIp, "localhost"
     COMBOBOX ADD hDlg, %ComboboxIp, "mail.mrpcap.com"
     COMBOBOX ADD hDlg, %ComboboxIp, "i-n-v-a-l-i-d.com"
     COMBOBOX SELECT hDlg, %ComboboxIp, 5
    
     CONTROL ADD COMBOBOX, hDlg, %ComboboxPort, , 130, 3, 88, 150, %WS_TABSTOP OR %CBS_DROPDOWN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
     COMBOBOX ADD hDlg, %ComboboxPort, "http" '80
     COMBOBOX ADD hDlg, %ComboboxPort, "ftp"  '21
     COMBOBOX ADD hDlg, %ComboboxPort, "80"   'http
     COMBOBOX ADD hDlg, %ComboboxPort, "21"   'ftp
     COMBOBOX SELECT hDlg, %ComboboxPort, 1
    
     CONTROL ADD TEXTBOX, hDlg, %Edit, sText, 2, 2, 196, 96, %WS_CHILD OR %WS_VISIBLE OR _
     %WS_TABSTOP OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOVSCROLL OR %WS_VSCROLL OR _
     %ES_NOHIDESEL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
    
     DIALOG SHOW MODAL hDlg CALL DlgProc
     DestroyIcon(hIcon)
    
    END FUNCTION
    '_____________________________________________________________________________
    '
    Last edited by Pierre Bellisle; 3 Jul 2019, 11:05 AM.

  • #2
    Very nice!

    Comment

    Working...
    X