----

[Scott Nichols]
I recommend adding this C++ code to the WinUtils library for creating unique global identifiers (GUIDs). I had a customer that required a GUID be generated with each SOAP transaction so I wrote the Tcl method call in C++ (below) for this, and thought it might be a good candidate for the WinUtils library. The C++ code below is using two dependent libs: tclstub83.lib and rpcrt4.lib. Rpcrt4.lib is part of the Windows OS, and should come with Visual Studio or .net. The source code is so short that I went ahead and posted both C++ source files below. The sources can be compiled into a Tcl library extension (DLL) for Windows platforms.

'''TclGUID.h:'''

 /*
 * TclGUID.h v1.0 12-11-2003 Scott Nichols
 *
 */

 /* TCL Function prototype declarations */
 #ifndef TclGUID_H
 #define TclGUID_H

 #define USE_NON_CONST
 #define TCL_USE_STUBS

 #include <tcl.h>
 #include "StdAfx.h"

 extern "C"
 {
    __declspec(dllexport) int Tclguid_Init(Tcl_Interp* interp);

 }

 static int	GetGUID_ObjCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));

 #endif


'''TclGUID.cpp:'''

 /*
 * TclGUID.cpp, v1.0 12/11/2003, Scott J. Nichols
 * scott.nichols4@comcast.net
 *
 * The GetGUID Tcl method returns a 128 bit unique identifier
 * to the Tcl interpreter. Microsoft calls it a globally unique identifier (GUID).
 * The application I am using it for is the transaction ID for SOAP messages. This was a customer
 * requirement of mine.
 *
 */

 #include "TclGUID.h"

 static int	GetGUID_ObjCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
 {

	GUID guid;

	// create random GUID
	guid = GUID_NULL;
	::CoCreateGuid(&guid);
	
	if (guid == GUID_NULL)
	{
		Tcl_Obj		*obj_result = Tcl_NewStringObj((const char *)"Unable to create GUID.",
                                strlen((const char *) "Unable to create GUID."));
		Tcl_SetObjResult(interp,obj_result);
		
		return TCL_ERROR;
	}
	else
	{
		BYTE * str;
		UuidToString((UUID*)&guid, &str);

		Tcl_UtfToUpper((char *)str); 
		
		// Return the GUID to the Tcl Interpreter
		Tcl_Obj	*obj_result = Tcl_NewStringObj((const char *)str,
		                      strlen((const char *)str));
		Tcl_SetObjResult(interp,obj_result);

		RpcStringFree(&str);

		return TCL_OK;
	}

 }

 /* Main Routine in the TCL Extension DLL */
 int Tclguid_Init(Tcl_Interp *interp)
 {

	#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1
		// Does the TCL interpreter support version 8.3 of TCL?
		if (Tcl_InitStubs(interp,"8.3",0) == NULL)
			return TCL_ERROR;
	#endif

	Tcl_CreateObjCommand(interp, "GetGUID", GetGUID_ObjCmd,
		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

	return (Tcl_PkgProvide(interp,"TclGUID","1.0") == TCL_ERROR ? TCL_ERROR : TCL_OK);
 }

Each time the GetGUID method is called from Tcl a different 128 bit number is returned that looks similar to this: DE4ED408-5200-46E5-8AD1-EEF7351A7C07

----

[PT]: Here is a pure-Tcl uuid generator. I can't vouch for the uniqueness, but it shouldn't 
be too bad.

 # uuid.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
 #
 # http://hegel.ittc.ukans.edu/topics/internet/internet-drafts/draft-l/draft-leach-uuids-guids-01.txt
 #
 #
 # UUIDs are 128 bit values that attempt to be unique in time and space.
 #
 # uuid: scheme:
 # http://www.globecom.net/ietf/draft/draft-kindel-uuid-uri-00.html
 #
 # Usage: uuid::uuid generate
 #        uuid::uuid compare $idA $idB
 
 namespace eval uuid {
     variable version 1.0.0
     variable uid
     if {![info exists uid]} {
         set uid 1
     }
 
     proc S {a b} {set a}
 }
 
 proc ::uuid::generate {} {
     package require md5 2
     variable uid
 
     set tok [md5::MD5Init]
     md5::MD5Update $tok [clock seconds]; # timestamp
     md5::MD5Update $tok [clock clicks];  # system incrementing counter
     md5::MD5Update $tok [incr uid];      # package incrementing counter 
     md5::MD5Update $tok [info hostname]; # spatial unique id (poor)
     md5::MD5Update $tok [array get ::tcl_platform]
     
     catch {
         set s [socket -server void -myaddr [info hostname] 0]
         S [fconfigure $s -sockname] [close $s]
     } r
     md5::MD5Update $tok $r
 
     if {[package provide Tk] != {}} {
         md5::MD5Update $tok [winfo pointerxy .]
         md5::MD5Update $tok [winfo id .]
     }
 
     set r [md5::MD5Final $tok]
     binary scan $r c* r
     
     # 3.4: set uuid versioning fields
     lset r 8 [expr {([lindex $r 8] & 0x7F) | 0x40}]
     lset r 6 [expr {([lindex $r 6] & 0x0F) | 0x40}]
     
     return [binary format c* $r]
 }
 
 proc ::uuid::tostring {uuid} {
     set s [md5::Hex $uuid]
     foreach {a b} {0 7 8 11 12 15 16 19 20 end} {
         append r [string range $s $a $b] -
     }
     return [string tolower [string trimright $r -]]
 }
 
 proc ::uuid::fromstring {uuid} {
     return [binary format H* [string map {- {}} $uuid]]
 }
 
 proc ::uuid::compare {left right} {
     set l [fromstring $left]
     set r [fromstring $right]
     return [string compare $l $r]
 }
 
 # uuid generate -> string rep of a new uuid
 # uuid equal uuid1 uuid2
 #
 proc uuid::uuid {cmd args} {
     switch -exact -- $cmd {
         generate {
             return [tostring [generate]]
         }
         compare {
             if {[llength $args] != 2} {
                 return -code error "wrong \# args:\
                     should be \"uuid compare uuid1 uuid2\""
             }
             foreach {left right} $args {}
             return [compare $left $right]
         }
         default {
             return -code error "bad option \"$cmd\":\
                 must be generate or compare"
         }
     }
 }
 
 # -------------------------------------------------------------------------
 
 package provide uuid $::uuid::version
 
 # -------------------------------------------------------------------------