Recently I ran into a problem using the tcom extension. The COM method I was calling returned a date value that the Tcl clock command did not understand. The DATE type returned was a floating-point value, measuring days from midnight, 30 December 1899. So, midnight, 31 December 1899 is represented by 1.0. The number to the left of the decimal point is the number of days since Midnight, December 30th 1899, and the number to right of the decimal point is a fraction of one day. There may be some Tcl'ers out there that could right a Tcl proc to convert this, but that would require some thinking. So, I wrote a small Tcl C++ extension instead. Sources below, and sample how to call it from Tcl. I also provided a GUID generator that I now other Tcl'ers have written in Tcl. Has anyone else ran into this problem? The code works below with some help from Tcl clock scan.
Begin Windows Header DLL Code for TclGUID.h
/*
* TclGUID.h v1.1 2-26-2004 Scott Nichols
*
* This software is provided "AS IS", without a warranty of any kind.
* You are free to use/modify this code but leave this header intact.
*
*/
/* TCL Function prototype declarations */
#ifndef TclGUID_H
#define TclGUID_H
#define USE_NON_CONST
#define TCL_USE_STUBS
#include <tcl.h>
#include "StdAfx.h"
#include <afxdisp.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[]));
static int GetDate_ObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
#endifBegin Main Windows DLL Code
/*
* TclGUID.cpp, v1.1 2/26/2004,
* Authored by Scott J. Nichols
*
*
*
* This software is provided "AS IS", without a warranty of any kind.
* You are free to use/modify this code but leave this header intact.
*
*/
#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;
}
}
static int GetDate_ObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
{
if (objc < 2)
{
Tcl_WrongNumArgs(interp,1,objv,
"GetDate value");
return TCL_ERROR;
}
double f;
Tcl_GetDoubleFromObj(interp,objv[1],&f);
COleDateTime d = COleDateTime::COleDateTime(f);
int M = d.GetMonth();
int D = d.GetDay();
int Y = d.GetYear();
int h = d.GetHour();
int m = d.GetMinute();
int s = d.GetSecond();
char date[20];
sprintf(date,"%i/%i/%i %i:%i:%i",M,D,Y,h,m,s);
// Return the GUID to the Tcl Interpreter
Tcl_Obj *obj_result = Tcl_NewStringObj((const char *)date,
strlen((const char *)date));
Tcl_SetObjResult(interp,obj_result);
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);
Tcl_CreateObjCommand(interp, "GetDate", GetDate_ObjCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
return (Tcl_PkgProvide(interp,"TclGUID","1.0") == TCL_ERROR ? TCL_ERROR : TCL_OK);
}Begin Sample Tcl Call Code
package require TclGUID clock format [clock scan [GetDate 38409.7202431]]
Returns:
Sat Feb 26 5:17:09 PM Central Standard Time 2005