Announcement

Collapse
No announcement yet.

GetHostByName

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

  • GetHostByName

    Click image for larger version  Name:	GetHostByName.png Views:	0 Size:	11.3 KB ID:	792786
    Code:
    'Note: GetHostByName is deprecated by GetAddrInfo.
    
    #COMPILE EXE '#Win# 'PB and JR includes compatible
    #DIM ALL
    #INCLUDE "Win32Api.inc"
    
    %MAX_HOSTNAME_LEN = 128
    
    GLOBAL hDlg AS DWORD
    
    $AppName          = "GetHostByName"
    %Edit             = 101
    %ComboboxHostName = 201
    '_____________________________________________________________________________
    
    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
    
     'Insert the string at caret position.
     SendMessage(hEdit, %EM_REPLACESEL, %TRUE, BYVAL STRPTR(sText))
    
    END SUB
    '_____________________________________________________________________________
    
    FUNCTION WinError$(BYVAL ErrorCode AS DWORD) AS STRING
     LOCAL pzError  AS ASCIIZ POINTER 'Max is 64K
     LOCAL ErrorLen AS DWORD
    
     ErrorLen = FormatMessage(%FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_ALLOCATE_BUFFER, _
                              BYVAL %NULL, ErrorCode, %NULL, BYVAL VARPTR(pzError), %NULL, BYVAL %NULL)
     IF ErrorLen THEN
       REPLACE $CRLF WITH $SPC IN @pzError
       FUNCTION = "Error" & STR$(ErrorCode) & " (0x" & HEX$(ErrorCode) & ") : " & @pzError
       LocalFree(pzError)
     ELSE
       FUNCTION = "Unknown error" & STR$(ErrorCode) & " (0x" & HEX$(ErrorCode) & ")"
     END IF
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION AddrTypeString(AddrType AS INTEGER)AS STRING
    
     SELECT CASE AddrType
       CASE %AF_UNSPEC       : FUNCTION = "AF_UNSPEC"       ' 0 - Unspecified
       CASE %AF_UNIX         : FUNCTION = "AF_UNIX"         ' 1 - Local to host (pipes, portals)
       CASE %AF_INET         : FUNCTION = "AF_INET"         ' 2 - Internetwork: UDP, TCP, etc.
       CASE %AF_IMPLINK      : FUNCTION = "AF_IMPLINK"      ' 3 - Arpanet imp addresses
       CASE %AF_PUP          : FUNCTION = "AF_PUP"          ' 4 - Pup protocols: e.g. BSP
       CASE %AF_CHAOS        : FUNCTION = "AF_CHAOS"        ' 5 - Mit CHAOS protocols
       CASE %AF_IPX, %AF_NS  : FUNCTION = "F_IPX - AF_NS"   ' 6 - IPX and SPX, XEROX NS protocols
       CASE %AF_ISO, %AF_OSI : FUNCTION = "AF_ISO - AF_OSI" ' 7 - ISO protocols
       CASE %AF_ECMA         : FUNCTION = "AF_ECMA"         ' 8 - European computer manufacturers
       CASE %AF_DATAKIT      : FUNCTION = "AF_DATAKIT"      ' 9 - Datakit protocols
       CASE %AF_CCITT        : FUNCTION = "AF_CCITT"        '10 - CCITT protocols, X.25 etc
       CASE %AF_SNA          : FUNCTION = "AF_SNA"          '11 - IBM SNA
       CASE %AF_DECnet       : FUNCTION = "AF_DECnet"       '12 - DECnet
       CASE %AF_DLI          : FUNCTION = "AF_DLI"          '13 - Direct data link interface
       CASE %AF_LAT          : FUNCTION = "AF_LAT"          '14 - LAT
       CASE %AF_HYLINK       : FUNCTION = "AF_HYLINK"       '15 - NSC Hyperchannel
       CASE %AF_APPLETALK    : FUNCTION = "AF_APPLETALK"    '16 - AppleTalk
       CASE %AF_NETBIOS      : FUNCTION = "AF_NETBIOS"      '17 - NetBios-style addresses
     END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION HostByNameGet(BYVAL zHostName AS ASCIIZ * %MAX_HOSTNAME_LEN) AS STRING
     LOCAL pHostEntry        AS HOSTENT POINTER
     LOCAL inAddr            AS IN_ADDR POINTER
     LOCAL pz                AS ASCIIZ POINTER
     LOCAL pDword            AS DWORD POINTER
     LOCAL WinSock           AS WSADATA
     LOCAL sLog              AS STRING
    
     IF WsaStartup(&H0202, WinSock) = %NOERROR THEN 'Initiates Windows Sockets
    
       pHostEntry = GetHostByName(zHostName) 'Returns a pointer to a hostent structure
    
       IF pHostEntry THEN '...GetHostByName was successfull
         sLog &= "Name: " & $TAB & (@[email protected]_name) & $CRLF 'Host name
         pDword = @pHostEntry.h_aliases
         IF @pDword = 0 THEN
           sLog &= "Aliasse: " & $TAB & "No aliasse" & $CRLF     'No aliasses
         ELSE
           WHILE @pDword                                         'Enumerate all aliasses
             pz = @pDword                                        'Use a valid type for an asciiz
             sLog &= "Aliasse: " & $TAB & (@pz) & $CRLF
             pDword+= 4                                          'Set next pointer
           WEND
         END IF
         sLog &= "Type: " & $TAB & AddrTypeString(@pHostEntry.h_addrtype) & $CRLF 'Address type
         sLog &= $CRLF
         IF @pHostEntry.h_length = 4 THEN   'Length of ipv4 is four bytes aka DWORD
           pDword = @pHostEntry.h_addr_list 'Pointer to an address list
           WHILE @pDword                    'If not zero then addtress is valid
             inAddr = pDword                'Use a valid type for inet_ntoa
             pz = inet_ntoa(@@inAddr)       'Converts ipv4 address to dotted string
             sLog &= "ip: " & $TAB  & @pz & $CRLF
             pDword += 4                    'Set next pointer
           WEND
         END IF
         WSACleanup()
       ELSE
         sLog = WinError$(WSAGetLastError()) 'Set error message in sLog
       END IF
     END IF
    
     FUNCTION = sLog
    
    END FUNCTION
    '_____________________________________________________________________________
    
    CALLBACK FUNCTION DlgProc
     LOCAL  zHostName AS ASCIIZ * %MAX_HOSTNAME_LEN
     LOCAL  sInfo     AS STRING
     STATIC hEdit     AS DWORD
    
     SELECT CASE CBMSG
    
       CASE %WM_INITDIALOG
         hEdit = GetDlgItem(CBHNDL, %Edit)
         'PostMessage(hEdit, %EM_SETSEL, -1, -1) 'Deselect text
         'PostMessage(hEdit, %EM_SETSEL, -2, -2) 'Put caret at the end
         PostMessage(hDlg, %WM_COMMAND, MAKDWD(%ComboboxHostName, %CBN_CLOSEUP), GetDlgItem(hDlg, %ComboboxHostName))
    
       CASE %WM_COMMAND
         SELECT CASE CBCTL
           CASE %ComboboxHostName, %IDOK
             IF CBCTLMSG = %CBN_CLOSEUP OR CBCTLMSG = 1 THEN    'ComboboxHostName
               COMBOBOX GET TEXT hDlg, %ComboboxHostName TO zHostName  'Use COMBOBOX GET
             ELSEIF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN '%IDOK
               CONTROL GET TEXT hDlg, %ComboboxHostName TO zHostName   'Use CONTROL GET TEXT
             END IF
             IF LEN(zHostName) THEN
               CONTROL DISABLE hDlg, %ComboboxHostName
               TextDel(hEdit)
               TextAdd(hEdit, "Searching: " & zHostName & $CRLF & $CRLF)
               TextAdd(hEdit, "Please wait...")
               CONTROL REDRAW hDlg, %Edit
               sInfo = HostByNameGet(zHostName)
               TextDel(hEdit)
               TextAdd(hEdit, "Searching: " & zHostName & $CRLF & $CRLF & sInfo)
               CONTROL ENABLE hDlg, %ComboboxHostName
             END IF
         END SELECT
    
       CASE %WM_SIZE
         LOCAL ClientSizeX AS LONG
         LOCAL ClientSizeY AS LONG
         IF CBWPARAM <> %SIZE_MINIMIZED THEN
           ClientSizeX = LO(WORD, CBLPARAM)
           ClientSizeY = HI(WORD, CBLPARAM)
           MoveWindow(GetDlgItem(hDlg, %ComboboxHostName), 3, 3, ClientSizeX - 6, 200, %TRUE)
           MoveWindow(hEdit, 3, 3 + 30, ClientSizeX - 6, ClientSizeY - 6 - 30, %TRUE)
         END IF
    
      END SELECT
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION PBMAIN() AS LONG
     LOCAL zHostName AS ASCIIZ * %MAX_HOSTNAME_LEN
     LOCAL WinSock   AS WSADATA
     LOCAL hIcon     AS DWORD
    
     DIALOG NEW %HWND_DESKTOP, $AppName, , , 150, 200, _
     %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU OR %WS_THICKFRAME, 0 TO hDlg
    
     IF WsaStartup(&H0202, WinSock) = %NOERROR THEN
       GetHostName(zHostName, SIZEOF(zHostName)) 'Get own host name
       WSACleanup()
     END IF
    
     CONTROL ADD COMBOBOX, hDlg, %ComboboxHostName, , 3, 3, 144, 150, %WS_TABSTOP OR %CBS_DROPDOWN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
     COMBOBOX ADD hDlg, %ComboboxHostName, zHostName
     COMBOBOX ADD hDlg, %ComboboxHostName, "microsoft.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "Google.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "ibm.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "powerbasic.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "att.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "localhost"
     COMBOBOX ADD hDlg, %ComboboxHostName, "127.0.0.1"
     COMBOBOX ADD hDlg, %ComboboxHostName, "mail.mrpcap.com"
     COMBOBOX ADD hDlg, %ComboboxHostName, "zzzzzzzzzzzzzzzz.com"
     COMBOBOX SELECT hDlg, %ComboboxHostName, 1
    
     CONTROL ADD TEXTBOX, hDlg, %Edit, "", 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
    
     hIcon = ExtractIcon(GETMODULEHANDLE(""), "Shell32.dll", 294)
     SetClassLong(hDlg, %GCL_HICON,hIcon)
    
     DIALOG SHOW MODAL hDlg CALL DlgProc
    
     DestroyIcon(hIcon)
    
    END FUNCTION
    '_____________________________________________________________________________
    '

  • #2
    No frill version...
    Code:
    '_____________________________________________________________________________
    
    FUNCTION HostByNameGet(BYVAL zHostName AS ASCIIZ * %MAX_HOSTNAME_LEN) AS STRING
     'Rerurn a string  made of all the host ip separated by tab.
     LOCAL pHostEntry        AS HOSTENT POINTER
     LOCAL inAddr            AS IN_ADDR POINTER
     LOCAL pz                AS ASCIIZ POINTER
     LOCAL pDword            AS DWORD POINTER
     LOCAL WinSock           AS WSADATA
     LOCAL sIp               AS STRING
    
     IF WsaStartup(&h0202, WinSock) = %NOERROR THEN 'Initiates Windows Sockets
       pHostEntry = GetHostByName(zHostName) 'Returns a pointer to a hostent structure
       IF pHostEntry THEN 'GetHostByName was successfull
         pDword = @pHostEntry.h_addr_list
         WHILE @pDword 'If not zero then addtress is valid
           inAddr = pDword 'Use a valid type for inet_ntoa
           pz = inet_ntoa(@@inAddr) 'Converts ipv4 address to dotted string
           sIp &= @pz & $TAB
           pDword += 4 'Set next pointer
         WEND
         WSACleanup()
         FUNCTION = LEFT$(sIp, -1)
       END IF
     END IF
    
    END FUNCTION
    '_____________________________________________________________________________
    
    FUNCTION HostNameGet() AS STRING
     'Return the local machine HostName
     LOCAL zHostName AS ASCIIZ * %MAX_HOSTNAME_LEN
     LOCAL WinSock   AS WSADATA
    
     IF WsaStartup(&h0202, WinSock) = %NOERROR THEN
       GetHostName(zHostName, SIZEOF(zHostName)) 'Get own host name
       WSACleanup()
       FUNCTION = zHostName
     END IF  
    
    END FUNCTION
    '_____________________________________________________________________________
    '

    Comment

    Working...
    X