/*
 * 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, v1.0 12/11/2003, Scott J. Nichols
 * [email protected]
 *
 * 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);
 }