snichols 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. 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 wright a Tcl proc to convert this, but that would require some thinking and a more time then the hour or so I spent on this. So, I wrote a small Tcl C++ extension instead. The sources arebelow, and below them is som sample Tcl code on how to call it. I also provided a GUID generator that I know other Tcl'ers have written in Tcl, but it was a small extension, so I reused it.
Has anyone else ran into this problem with Dates and COM? The code works below and with some help from Tcl clock scan makes it look real nice. Thanks goes to wiki user,mistachkin for suggesting sprintf below. I believe there is a TCL C API equivalent of that too. :)
Begin Windows Header DLL Code for TclGUID.h
/*
* TclGUID.h v1.1 2-26-2005 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/2005,
* 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