[Richard Suchenwirth] 2005-11-30 - As colleagues wanted the Windows gethostbyname() function exposed as a Tcl command, I hacked up the following code, starting from [Building Tcl DLL's for Windows] and some pasted samples from MSDN. Building it is a single call to the VisualC compiler ''cl'' as documented in a comment. Code review welcome! (I'm not sure about tclstubs84.lib - had to explicitly specify tcl84.lib to make the build succeed...)

----
 /* gethost.c -- DLL to expose the gethostbyname() function 
   as Tcl command [gethost $name]
   Returns a list of IP numbers ({} if not found)
   
   build with:
   cl gethost.c /Id:/usr/local/include /LD /link d:/usr/local/lib/tcl84.lib ws2_32.lib
   
   test with (e.g.):
   echo "load gethost.dll;puts [gethost siemens.de]" | tclsh   
 */
 #include <Winsock2.h>
 #include <tcl.h>

 #ifndef DECLSPEC_EXPORT
 #define DECLSPEC_EXPORT __declspec(dllexport)
 #endif /* DECLSPEC_EXPORT */

 BOOL APIENTRY DllMain(HANDLE hModule, DWORD dwReason, LPVOID lpReserved) {
   return TRUE;
 }
 /*--------------------------------------------------------------------------*/
 static int gethostCmd(ClientData clientdata, Tcl_Interp *interp,
		      int objc, Tcl_Obj *CONST objv[]) {
  const char* host_name;
  unsigned int addr;
  char FAR FAR *cp;
  int i;
  int wsaError;
  char* errorText = "none";
  WORD    wVersionRequested;
  WSADATA wsaData;
  int err;
  char s[18];
  
  struct hostent* remoteHost = NULL;
  Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
  
  if(objc != 2) {
    Tcl_WrongNumArgs(interp, 2, objv, "");
    return TCL_ERROR;
  }
  wVersionRequested = MAKEWORD( 2, 2 );
  err = WSAStartup( wVersionRequested, &wsaData );
  if ( err != 0 ) {
    Tcl_SetStringObj(resultPtr, "found no usable WinSock DLL", -1);
    return TCL_ERROR;
  }
  if ( LOBYTE( wsaData.wVersion ) != 2 ||
       HIBYTE( wsaData.wVersion ) != 2 ) {
    Tcl_SetStringObj(resultPtr, "found no usable 2.2 WinSock DLL", -1);
    WSACleanup();
    return TCL_ERROR; 
  }
  host_name = Tcl_GetStringFromObj(objv[1], NULL);
  
  if (isalpha(host_name[0])) {   /* host address is a name */
    remoteHost = gethostbyname(host_name);
  } else { 
    Tcl_SetStringObj(resultPtr, "must be alpha host name", -1);
    return TCL_ERROR;
  }
  wsaError = WSAGetLastError();
  if(wsaError == WSAHOST_NOT_FOUND || wsaError == WSANO_DATA) {
    return TCL_OK;
  }
  if(wsaError != 0 || remoteHost == NULL) {
    switch (wsaError) {
    case WSANOTINITIALISED: errorText = "Not initialized"; break; 
    case WSAENETDOWN:       errorText = "Error: Net down"; break; 
    case WSATRY_AGAIN:      errorText = "Try again"; break; 
    case WSANO_RECOVERY:    errorText = "no recovery"; break; 
    case WSAEINPROGRESS:    errorText = "Error: in progress"; break; 
    case WSAEFAULT:         errorText = "Error: invalid name"; break; 
    case WSAEINTR:          errorText = "blocking call interrupted"; break;
    default:                errorText = "unknown failure"; break;
    }
    Tcl_SetStringObj(resultPtr, errorText, -1);
    return TCL_ERROR;
  }
  for(i=0; cp=remoteHost->h_addr_list[i]; i++) {
    sprintf(s,"%d.%d.%d.%d", cp[0]&255, cp[1]&255, cp[2]&255, cp[3]&255);
    Tcl_AppendElement(interp, s);
  }
  return TCL_OK;
 }
 /* ------------------------------------------------------------------------*/
 EXTERN_C int DECLSPEC_EXPORT Gethost_Init(Tcl_Interp* interp) {
  int r;
 #ifdef USE_TCL_STUBS
  Tcl_InitStubs(interp, "8.3", 0);
 #endif
   Tcl_Obj *version = Tcl_SetVar2Ex(interp, "gethost_version", NULL,
				   Tcl_NewDoubleObj(0.1), TCL_LEAVE_ERR_MSG);
  if (version == NULL)
    return TCL_ERROR;
  r = Tcl_PkgProvide(interp, "gethost", Tcl_GetString(version));
  
  Tcl_CreateObjCommand(interp, "gethost", (Tcl_ObjCmdProc *)gethostCmd,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);  
  return r;
 }

 EXTERN_C int DECLSPEC_EXPORT Gethost_SafeInit(Tcl_Interp* interp) {
   /* We don't need to be specially safe so... */
   return Gethost_Init(interp);
 }

----
Build and test log:
 SuchRich@KSTBWP74[/Tcl]535:cl gethost.c /Id:/usr/local/include /LD /link d:/usr/local/lib/tcl84.lib ws2_32.lib
 Microsoft (R) 32-bit C/C++ Optimizing Compiler Version 12.00.8804 for 80x86
 Copyright (C) Microsoft Corp 1984-1998. All rights reserved.

 gethost.c
 Microsoft (R) Incremental Linker Version 6.00.8447
 Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

 /out:gethost.dll
 /dll
 /implib:gethost.lib
 d:/usr/local/lib/tcl84.lib
 ws2_32.lib
 gethost.obj
   Creating library gethost.lib and object gethost.exp
 SuchRich@KSTBWP74[/Tcl]536:echo 'load gethost.dll;foreach i {siemens.de google.com nix tcl.tk} {puts "$i -> [gethost $i]"}' | tclsh
 siemens.de -> 192.138.228.1
 google.com -> 72.14.207.99 64.233.187.99
 nix ->
 tcl.tk -> 209.17.179.230

----

[Arts and crafts of Tcl-Tk programming]