Updated 2011-09-07 07:59:42 by dkf ▲

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. This COM/OLE date value was important in my application because it gave the date when an object had changed in the software the Tcl script was integrated to. 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 are below, and below them is some 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(ClientData clientData,
                   Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

static int     GetDate_ObjCmd(ClientData clientData,
                   Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

#endif

Begin 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(
    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", -1);
        Tcl_SetObjResult(interp, obj_result);
        return TCL_ERROR;
    }

    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, -1);
    Tcl_SetObjResult(interp, obj_result);

    RpcStringFree(&str);
    return TCL_OK;
}

static int
GetDate_ObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc < 2) {
        Tcl_WrongNumArgs(interp,1,objv, "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 date value to the Tcl Interpreter
    Tcl_Obj *obj_result = Tcl_NewStringObj((const char *)date, -1);
    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

RS has taken this breakfast challenge to do some thinking :) The Unix "era" date is 1 Jan 1970, while OLE/COM's is 30 Dec 1899 - 25569 days earlier. Both seem to take a fixed day length of 86400 seconds, which ignores the problem of leap seconds, but anyway. The following code passes Scott's test:
 proc fdate f {expr {round(($f-25569)*86400)}}

and in the other direction, Unix time to OLE/COM time:
 proc date2fdate time {expr {$time/86400.+25569}}

Testing:
 % clock format [fdate 38409.7202431] -gmt 1
 Sat Feb 26 17:17:09 GMT 2005

snichols RS, your Tcl conversion code works great! Yours is much simpler than having to convert the value from a C/C++ Tcl extension. I'm going to use your Tcl code instead. Thank you.

male - 2007-08-17: I ran into the same problem, where a NC control returns DATE values over its COM interface. And I needed to use them as clock values. The result is ...
 % set date
 39280.84648148148
 % clock format [fdate $date]
 Tue Jul 17 22:18:56 +0200 2007
 % clock format [clock scan now]
 Fri Aug 17 21:15:58 +0200 2007

But ... perhabs the NC control has a wrong adjusted time.

Category Date and Time