Tcl Source Code

dde \- Execute a Dynamic Data Exchange command
.SH SYNOPSIS
.sp
\fBpackage require dde 1.3\fR
.sp
\fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
.sp
.VS 8.6
\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
.sp
\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
.VE 8.6
.sp
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.sp
\fBdde services \fIservice topic\fR
.sp
\fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR?
.BE

The \fB\-handler\fR option specifies a Tcl procedure that will be called to
process calls to the dde server. If the package has been loaded into a
safe interpreter then a \fB\-handler\fR procedure must be defined. The
procedure is called with all the arguments provided by the remote
call.
.RE
.TP
\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
.
\fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
by \fIservice\fR with the topic indicated by \fItopic\fR. Typically,
\fIservice\fR is the name of an application, and \fItopic\fR is a file to
work on.  The \fIdata\fR field is given to the remote application.
Typically, the application treats the \fIdata\fR field as a script, and the
script is run in the application.  The \fB\-async\fR option requests
asynchronous invocation.  The command returns an error message if the
script did not run, unless the \fB\-async\fR flag was used, in which case
the command returns immediately with no error.
.VS 8.6
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
string is sent.  Combining \fB-binary\fR with the result of
\fBencoding convertto\fR may be used to send data in arbitrary encodings.
.VE 8.6
.TP
\fBdde poke ?\fB\-binary\fR? \fIservice topic item data\fR
.
\fBdde poke\fR passes the \fIdata\fR to the server indicated by
\fIservice\fR using the \fItopic\fR and \fIitem\fR specified.  Typically,
\fIservice\fR is the name of an application.  \fItopic\fR is application
specific but can be a command to the server or the name of a file to work
on.  The \fIitem\fR is also application specific and is often not used, but
it must always be non-null.  The \fIdata\fR field is given to the remote
application.
.VS 8.6
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
string is sent.
.VE 8.6
.TP
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.
\fBdde request\fR is typically used to get the value of something; the
value of a cell in Microsoft Excel or the text of a selection in
Microsoft Word. \fIservice\fR is typically the name of an application,
\fItopic\fR is typically the name of the file, and \fIitem\fR is

package require dde
\fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/
.CE
.SH "SEE ALSO"
tk(n), winfo(n), send(n)
.SH KEYWORDS
application, dde, name, remote execution
'\"Local Variables:
'\"mode: nroff
'\"End:

if {![package vsatisfies [package provide Tcl] 8.4]} return
if {[string compare [info sharedlibextension] .dll]} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
} else {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
}

    dde eval self set a "foo"
} foo
test winDde-3.5 {DDE request locally} {win dde} {
    set a ""
    dde execute TclEval self {set a "foo"}
    dde request -binary TclEval self a
} "foo\x00"
# Set variable a to A with diaeresis (unicode C4) by relying on the fact
# that utf8 is sent (e.g. "c3 84" on the wire)
test winDde-3.6 {DDE request utf8} {win dde} {
    set a "not set"
    dde execute TclEval self "set a \xc4"
    scan $a %c
} 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} {win dde} {
    set a "not set"
    dde execute -binary TclEval self "set a \xc3\x84\x00"
    scan $a %c
} 196

# -------------------------------------------------------------------------

test winDde-4.1 {DDE execute remotely} {stdio win dde} {
    set a ""
    set name child-4.1
    set child [createChildProcess $name]

    set a
} foo

# -------------------------------------------------------------------------

test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
    dde execute "" "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
    dde execute "" "" ""
} -returnCodes error -result {cannot execute null data}
test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
    dde execute -foo "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
    dde eval "" "foo"
} -returnCodes error -result {invalid service name ""}

# -------------------------------------------------------------------------

test winDde-6.1 {DDE servername bad arguments} -constraints {win dde} -body {

	    if [ -f $$i ]; then \
		echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
		$(COPY) $$i "$(LIB_INSTALL_DIR)"; \
	    fi; \
	    done
	@if [ -f $(DDE_DLL_FILE) ]; then \
	    echo installing $(DDE_DLL_FILE); \
	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
		$(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    fi
	@if [ -f $(DDE_LIB_FILE) ]; then \
	    echo installing $(DDE_LIB_FILE); \
	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    fi
	@if [ -f $(REG_DLL_FILE) ]; then \
	    echo installing $(REG_DLL_FILE); \
	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi

install-libraries: libraries install-tzdata install-msgs
	@for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
		$(SCRIPT_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \

TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
TCL_DDE_PATCH_LEVEL="0"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
TCL_DDE_PATCH_LEVEL="0"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.0"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")

TCL_DECLARE_MUTEX(ddeMutex)

/*

    static const char *const ddeSrvOptions[] = {
	"-force", "-handler", "--", NULL
    };
    enum DdeSrvOptions {
	DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
    };
    static const char *const ddeExecOptions[] = {
	"-async", "-binary", NULL
    };
    enum DdeExecOptions {
        DDE_EXEC_ASYNC, DDE_EXEC_BINARY
    };
    static const char *const ddePokeOptions[] = {
	"-binary", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, length, argIndex;
    int async = 0, binary = 0, exact = 0;
    int result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const TCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;

	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum DdeSubcommands) index) {
    case DDE_SERVERNAME:
	for (i = 2; i < objc; i++) {

	    if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
		    "option", 0, &argIndex) != TCL_OK) {
		/*
		 * If it is the last argument, it might be a server name
		 * instead of a bad argument.
		 */

	firstArg = (objc == i) ? 1 : i;
	break;
    case DDE_EXECUTE:
	if (objc == 5) {
	    firstArg = 2;
	    break;
	} else if (objc >= 6 && objc <= 7) {
	    firstArg = objc - 3;
	    for (i = 2; i < firstArg; i++) {
		if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
			"option", 0, &argIndex) != TCL_OK) {
		    goto wrongDdeExecuteArgs;
		}
		if (argIndex == DDE_EXEC_ASYNC) {
		    async = 1;
		} else {
		    binary = 1;

		}
	    }
	    break;
	}
	/* otherwise... */
    wrongDdeExecuteArgs:
	Tcl_WrongNumArgs(interp, 2, objv,
		"?-async? ?-binary? serviceName topicName value");
	return TCL_ERROR;
    case DDE_POKE:
	if (objc == 6) {
	    firstArg = 2;
	    break;
	} else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
		ddePokeOptions, "option", 0, &argIndex) == TCL_OK)) {
	    binary = 1;
	    firstArg = 3;
	    break;
	}

	/*
	 * Otherwise...
	 */

	Tcl_WrongNumArgs(interp, 2, objv,
		"serviceName ?-binary? topicName item value");
	return TCL_ERROR;



    case DDE_REQUEST:
	if (objc == 5) {
	    firstArg = 2;
	    break;


	} else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
		ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
	    binary = 1;
	    firstArg = 3;
	    break;

	}

	/*
	 * Otherwise ...
	 */

	Tcl_WrongNumArgs(interp, 2, objv,

	break;
    case DDE_EVAL:
	if (objc < 4) {
	wrongDdeEvalArgs:
	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
	    return TCL_ERROR;
	} else {


	    firstArg = 2;
	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
		    0, &argIndex) == TCL_OK) {
		if (objc < 5) {
		    goto wrongDdeEvalArgs;
		}
		async = 1;
		firstArg++;
	    }
	    break;

	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	int dataLength;
	BYTE *dataString;

	if (binary) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    dataString = (BYTE *)
		    Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
	    dataLength += 1;
	}

	if (dataLength <= (binary ? 0 : sizeof(TCHAR))) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	    break;
	}

	ddeData = DdeCreateDataHandle(ddeInstance, dataString,
		(DWORD) dataLength, 0, 0, CF_TEXT, 0);
	if (ddeData != NULL) {
	    if (async) {
		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
	    } else {
		ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,

		    SetDdeError(interp);
		    result = TCL_ERROR;
		} else {
		    DWORD tmp;
		    const BYTE *dataString = DdeAccessData(ddeData, &tmp);

		    if (binary) {
			returnObjPtr =
				Tcl_NewByteArrayObj(dataString, (int) tmp);
		    } else {
			returnObjPtr = Tcl_NewStringObj((char *)dataString, -1);
		    }
		    DdeUnaccessData(ddeData);
		    DdeFreeDataHandle(ddeData);
		    Tcl_SetObjResult(interp, returnObjPtr);
		}

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	if (binary) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    dataString = (BYTE *)
		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);
	    length += 1;
	}

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	} else {
	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
		    CP_WINUNICODE);
	    if (ddeItem != NULL) {
		ddeData = DdeClientTransaction(dataString, (DWORD) length,
			hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		}
	    } else {
		SetDdeError(interp);