Re: GNAT, Windsock, and DLLs

[jerry@jvdsys.nextjk.stuyts.nl (Jerry van Dijk)]

Do-While Jones (do_while@ridgecrest.ca.us) wrote:

: In particular, "What do I need to do to get a demo program (included at
: the end of this message) to call the gethostname service in windsock.dll?"

Although WinSock looks a lot like normal sockets, there are some 
differences.

Here's an example of getting the host name under Win95, hopefully this
will get you on the right track:

-----------------------------------------------------------------------
--
--  File:        test.adb
--  Description: test of the Win32 sockets DLL
--  Rev:         0.1
--  Date:        16-apr-1998
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1998
--  Billie Holidaystraat 28
--  2324 LK Leiden
--  THE NETHERLANDS
--  tel int + 31 71 531 4365
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

with Winsock;     use Winsock;
with Ada.Text_IO; use Ada.Text_IO;

procedure Test is
begin

   Startup_Sockets;

   Put_Line ("The name of this host is " & Get_Host_Name);

   Cleanup_Sockets;

end Test;


-----------------------------------------------------------------------
--
--  File:        winsock.ads
--  Description: very partial interface to the Win32 sockets DLL for GNAT
--  Rev:         0.1
--  Date:        16-apr-1998
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1998
--  Billie Holidaystraat 28
--  2324 LK Leiden
--  THE NETHERLANDS
--  tel int + 31 71 531 4365
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

pragma Linker_Options ("-lwsock32");

with Ada.Unchecked_Deallocation;

with Interfaces;           use Interfaces;
with Interfaces.C;         use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;

package Winsock is

   ----------------
   -- Exceptions --
   ----------------

   WSAEFAULT             : exception; -- A namelen parameter is too small
   WSAEINVAL             : exception; -- Socket version not supported by DLL
   WSAENETDOWN           : exception; -- Network subsystem failed
   WSAEINPROGRESS        : exception; -- Blocking sockets operation active
   WSASYSNOTREADY        : exception; -- Network not ready for communication
   WSANOTINITIALISED     : exception; -- Sockets are not initialized
   WSAVERNOTSUPPORTED    : exception; -- Application socket version unsupported

   UNKNOWN_SOCKETS_ERROR : exception; -- Catch all others exception

   --------------------------------
   -- Init/Cleanup sockets usage --
   --------------------------------

   procedure Startup_Sockets;
   procedure Cleanup_Sockets;

   ----------------------
   -- Socket functions --
   ----------------------

   function Get_Host_Name return String;

end Winsock;


-----------------------------------------------------------------------
--
--  File:        winsock.adb
--  Description: very partial interface to the Win32 sockets DLL for GNAT
--  Rev:         0.1
--  Date:        16-apr-1998
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1998
--  Billie Holidaystraat 28
--  2324 LK Leiden
--  THE NETHERLANDS
--  tel int + 31 71 531 4365
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

package body Winsock is

   --------------------------------------------------------------------

   Sockets_Version : constant unsigned_16 := 16#0101#;

   --------------------------------------------------------------------

   WSAEFAULT_VALUE          : constant Integer := 10014;
   WSAEINVAL_VALUE          : constant Integer := 10022;
   WSAENETDOWN_VALUE        : constant Integer := 10050;
   WSAEINPROGRESS_VALUE     : constant Integer := 10036;
   WSASYSNOTREADY_VALUE     : constant Integer := 10091;
   WSANOTINITIALISED_VALUE  : constant Integer := 10093;
   WSAVERNOTSUPPORTED_VALUE : constant Integer := 10092;

   function WSAGetLastError return Integer;
   pragma Import (StdCall, WSAGetLastError, "WSAGetLastError");

   procedure Check_Result (Result : in Integer) is
   begin
      if Result /= 0 then
         case Result is
            when WSAEINVAL_VALUE          => raise WSAEINVAL;
            when WSAEFAULT_VALUE          => raise WSAEFAULT;
            when WSAENETDOWN_VALUE        => raise WSAENETDOWN;
            when WSAEINPROGRESS_VALUE     => raise WSAEINPROGRESS;
            when WSASYSNOTREADY_VALUE     => raise WSASYSNOTREADY;
            when WSANOTINITIALISED_VALUE  => raise WSANOTINITIALISED;
            when WSAVERNOTSUPPORTED_VALUE => raise WSAVERNOTSUPPORTED;
            when others                   => raise UNKNOWN_SOCKETS_ERROR;
         end case;
      end if;
   end Check_Result;
   pragma Inline (Check_Result);

   --------------------------------------------------------------------

   WSASYS_STATUS_LEN  : constant := 128;
   WSADESCRIPTION_LEN : constant := 256;

   type WSADATA is
      record
         wVersion       : unsigned_16;
         wHighVersion   : unsigned_16;
         szDescription  : char_array (1 .. WSADESCRIPTION_LEN+1);
         szSystemStatus : char_array (1 .. WSASYS_STATUS_LEN+1);
         iMaxSockets    : unsigned_16;
         iMaxUdpDg      : unsigned_16;
         lpVendorInfo   : chars_ptr;
      end record;
   pragma Convention (C, WSADATA);

   type WSADATA_Access is access all WSADATA;
   pragma Convention (C, WSADATA_Access);

   procedure Free is new Ada.Unchecked_Deallocation (WSADATA, WSADATA_Access);

   function WSAStartup (wVersionRequested : Unsigned_16;
                        lpWSAData         : WSADATA_Access) return Integer;
   pragma Import (StdCall, WSAStartup, "WSAStartup");

   function WSACleanup return Integer;
   pragma Import (StdCall, WSACleanup, "WSACleanup");

   --------------------------------------------------------------------

   function gethostname (name : char_array; length : size_t) return Integer;
   pragma Import (StdCall, gethostname, "gethostname");

   --------------------------------------------------------------------

   procedure Startup_Sockets is
      Result   : Integer;
      Data_Ptr : WSADATA_Access := new WSADATA;
      Version  : unsigned_16 := Sockets_Version;
   begin
      Result := WSAStartup (Version, Data_Ptr);
      Check_Result (Result);
      Free (Data_Ptr);
      if Version /= Sockets_Version then
         Result := WSACleanup;
         raise WSAVERNOTSUPPORTED;
      end if;
   end Startup_Sockets;

   --------------------------------------------------------------------

   procedure Cleanup_Sockets is
      Result : Integer;
   begin
      Result := WSACleanup;
      Check_Result (WSAGetLastError);
   end Cleanup_Sockets;

   --------------------------------------------------------------------

   function Get_Host_Name return String is
      Result      : Integer;
      Temp_Length : constant size_t := 256;
      Temp_Name   : char_array (1 .. Temp_Length) := (others => ' ');
   begin
      Result := gethostname (Temp_Name, Temp_Length);
      Check_Result (WSAGetLastError);
      return To_Ada (Temp_Name);
   end Get_Host_Name;

end Winsock;
-- 
-- Jerry van Dijk  | email: jdijk@acm.org
-- Leiden, Holland | member Team-Ada