1 /*
2 * tclWinDde.c --
3 *
4 * This file provides procedures that implement the "send"
5 * command, allowing commands to be passed from interpreter
6 * to interpreter.
7 *
8 * Copyright (c) 1997 by Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclWinDde.c,v 1.13.2.1 2003/11/10 22:42:07 dgp Exp $
14 */
15
16 #include "tclPort.h"
17 #include <ddeml.h>
18
19 /*
20 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
21 * Registry_Init declaration is in the source file itself, which is only
22 * accessed when we are building a library.
23 */
24
25 #undef TCL_STORAGE_CLASS
26 #define TCL_STORAGE_CLASS DLLEXPORT
27
28 /*
29 * The following structure is used to keep track of the interpreters
30 * registered by this process.
31 */
32
33 typedef struct RegisteredInterp {
34 struct RegisteredInterp *nextPtr;
35 /* The next interp this application knows
36 * about. */
37 char *name; /* Interpreter's name (malloc-ed). */
38 Tcl_Interp *interp; /* The interpreter attached to this name. */
39 } RegisteredInterp;
40
41 /*
42 * Used to keep track of conversations.
43 */
44
45 typedef struct Conversation {
46 struct Conversation *nextPtr;
47 /* The next conversation in the list. */
48 RegisteredInterp *riPtr; /* The info we know about the conversation. */
49 HCONV hConv; /* The DDE handle for this conversation. */
50 Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
51 } Conversation;
52
53 typedef struct ThreadSpecificData {
54 Conversation *currentConversations;
55 /* A list of conversations currently
56 * being processed. */
57 RegisteredInterp *interpListPtr;
58 /* List of all interpreters registered
59 * in the current process. */
60 } ThreadSpecificData;
61 static Tcl_ThreadDataKey dataKey;
62
63 /*
64 * The following variables cannot be placed in thread-local storage.
65 * The Mutex ddeMutex guards access to the ddeInstance.
66 */
67 static HSZ ddeServiceGlobal = 0;
68 static DWORD ddeInstance; /* The application instance handle given
69 * to us by DdeInitialize. */
70 static int ddeIsServer = 0;
71
72 #define TCL_DDE_VERSION "1.2.2"
73 #define TCL_DDE_PACKAGE_NAME "dde"
74 #define TCL_DDE_SERVICE_NAME "TclEval"
75
76 TCL_DECLARE_MUTEX(ddeMutex)
77
78 /*
79 * Forward declarations for procedures defined later in this file.
80 */
81
82 static void DdeExitProc _ANSI_ARGS_((ClientData clientData));
83 static void DeleteProc _ANSI_ARGS_((ClientData clientData));
84 static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_((
85 RegisteredInterp *riPtr,
86 Tcl_Obj *ddeObjectPtr));
87 static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
88 char *name, HCONV *ddeConvPtr));
89 static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType,
90 UINT uFmt, HCONV hConv, HSZ ddeTopic,
91 HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
92 DWORD dwData2));
93 static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
94 int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */
95 Tcl_Interp *interp, /* The interp we are sending from */
96 int objc, /* Number of arguments */
97 Tcl_Obj *CONST objv[]); /* The arguments */
98
99 EXTERN int Dde_Init(Tcl_Interp *interp);
100
101 /*
102 *----------------------------------------------------------------------
103 *
104 * Dde_Init --
105 *
106 * This procedure initializes the dde command.
107 *
108 * Results:
109 * A standard Tcl result.
110 *
111 * Side effects:
112 * None.
113 *
114 *----------------------------------------------------------------------
115 */
116
117 int
Dde_Init(Tcl_Interp * interp)118 Dde_Init(
119 Tcl_Interp *interp)
120 {
121 ThreadSpecificData *tsdPtr;
122
123 if (!Tcl_InitStubs(interp, "8.0", 0)) {
124 return TCL_ERROR;
125 }
126
127 Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
128
129 tsdPtr = TCL_TSD_INIT(&dataKey);
130
131 Tcl_CreateExitHandler(DdeExitProc, NULL);
132
133 return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
134 }
135
136 /*
137 *----------------------------------------------------------------------
138 *
139 * Initialize --
140 *
141 * Initialize the global DDE instance.
142 *
143 * Results:
144 * None.
145 *
146 * Side effects:
147 * Registers the DDE server proc.
148 *
149 *----------------------------------------------------------------------
150 */
151
152 static void
Initialize(void)153 Initialize(void)
154 {
155 int nameFound = 0;
156 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
157
158 /*
159 * See if the application is already registered; if so, remove its
160 * current name from the registry. The deletion of the command
161 * will take care of disposing of this entry.
162 */
163
164 if (tsdPtr->interpListPtr != NULL) {
165 nameFound = 1;
166 }
167
168 /*
169 * Make sure that the DDE server is there. This is done only once,
170 * add an exit handler tear it down.
171 */
172
173 if (ddeInstance == 0) {
174 Tcl_MutexLock(&ddeMutex);
175 if (ddeInstance == 0) {
176 if (DdeInitialize(&ddeInstance, DdeServerProc,
177 CBF_SKIP_REGISTRATIONS
178 | CBF_SKIP_UNREGISTRATIONS
179 | CBF_FAIL_POKES, 0)
180 != DMLERR_NO_ERROR) {
181 ddeInstance = 0;
182 }
183 }
184 Tcl_MutexUnlock(&ddeMutex);
185 }
186 if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
187 Tcl_MutexLock(&ddeMutex);
188 if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
189 ddeIsServer = 1;
190 Tcl_CreateExitHandler(DdeExitProc, NULL);
191 ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
192 TCL_DDE_SERVICE_NAME, 0);
193 DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
194 } else {
195 ddeIsServer = 0;
196 }
197 Tcl_MutexUnlock(&ddeMutex);
198 }
199 }
200
201 /*
202 *--------------------------------------------------------------
203 *
204 * DdeSetServerName --
205 *
206 * This procedure is called to associate an ASCII name with a Dde
207 * server. If the interpreter has already been named, the
208 * name replaces the old one.
209 *
210 * Results:
211 * The return value is the name actually given to the interp.
212 * This will normally be the same as name, but if name was already
213 * in use for a Dde Server then a name of the form "name #2" will
214 * be chosen, with a high enough number to make the name unique.
215 *
216 * Side effects:
217 * Registration info is saved, thereby allowing the "send" command
218 * to be used later to invoke commands in the application. In
219 * addition, the "send" command is created in the application's
220 * interpreter. The registration will be removed automatically
221 * if the interpreter is deleted or the "send" command is removed.
222 *
223 *--------------------------------------------------------------
224 */
225
226 static char *
DdeSetServerName(Tcl_Interp * interp,char * name)227 DdeSetServerName(
228 Tcl_Interp *interp,
229 char *name /* The name that will be used to
230 * refer to the interpreter in later
231 * "send" commands. Must be globally
232 * unique. */
233 )
234 {
235 int suffix, offset;
236 RegisteredInterp *riPtr, *prevPtr;
237 Tcl_DString dString;
238 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
239
240 /*
241 * See if the application is already registered; if so, remove its
242 * current name from the registry. The deletion of the command
243 * will take care of disposing of this entry.
244 */
245
246 for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
247 prevPtr = riPtr, riPtr = riPtr->nextPtr) {
248 if (riPtr->interp == interp) {
249 if (name != NULL) {
250 if (prevPtr == NULL) {
251 tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
252 } else {
253 prevPtr->nextPtr = riPtr->nextPtr;
254 }
255 break;
256 } else {
257 /*
258 * the name was NULL, so the caller is asking for
259 * the name of the current interp.
260 */
261
262 return riPtr->name;
263 }
264 }
265 }
266
267 if (name == NULL) {
268 /*
269 * the name was NULL, so the caller is asking for
270 * the name of the current interp, but it doesn't
271 * have a name.
272 */
273
274 return "";
275 }
276
277 /*
278 * Pick a name to use for the application. Use "name" if it's not
279 * already in use. Otherwise add a suffix such as " #2", trying
280 * larger and larger numbers until we eventually find one that is
281 * unique.
282 */
283
284 suffix = 1;
285 offset = 0;
286 Tcl_DStringInit(&dString);
287
288 /*
289 * We have found a unique name. Now add it to the registry.
290 */
291
292 riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
293 riPtr->interp = interp;
294 riPtr->name = ckalloc(strlen(name) + 1);
295 riPtr->nextPtr = tsdPtr->interpListPtr;
296 tsdPtr->interpListPtr = riPtr;
297 strcpy(riPtr->name, name);
298
299 Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
300 (ClientData) riPtr, DeleteProc);
301 if (Tcl_IsSafe(interp)) {
302 Tcl_HideCommand(interp, "dde", "dde");
303 }
304 Tcl_DStringFree(&dString);
305
306 /*
307 * re-initialize with the new name
308 */
309 Initialize();
310
311 return riPtr->name;
312 }
313
314 /*
315 *--------------------------------------------------------------
316 *
317 * DeleteProc
318 *
319 * This procedure is called when the command "dde" is destroyed.
320 *
321 * Results:
322 * none
323 *
324 * Side effects:
325 * The interpreter given by riPtr is unregistered.
326 *
327 *--------------------------------------------------------------
328 */
329
330 static void
DeleteProc(clientData)331 DeleteProc(clientData)
332 ClientData clientData; /* The interp we are deleting passed
333 * as ClientData. */
334 {
335 RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
336 RegisteredInterp *searchPtr, *prevPtr;
337 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
338
339 for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
340 (searchPtr != NULL) && (searchPtr != riPtr);
341 prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
342 /*
343 * Empty loop body.
344 */
345 }
346
347 if (searchPtr != NULL) {
348 if (prevPtr == NULL) {
349 tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
350 } else {
351 prevPtr->nextPtr = searchPtr->nextPtr;
352 }
353 }
354 ckfree(riPtr->name);
355 Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
356 }
357
358 /*
359 *--------------------------------------------------------------
360 *
361 * ExecuteRemoteObject --
362 *
363 * Takes the package delivered by DDE and executes it in
364 * the server's interpreter.
365 *
366 * Results:
367 * A list Tcl_Obj * that describes what happened. The first
368 * element is the numerical return code (TCL_ERROR, etc.).
369 * The second element is the result of the script. If the
370 * return result was TCL_ERROR, then the third element
371 * will be the value of the global "errorCode", and the
372 * fourth will be the value of the global "errorInfo".
373 * The return result will have a refCount of 0.
374 *
375 * Side effects:
376 * A Tcl script is run, which can cause all kinds of other
377 * things to happen.
378 *
379 *--------------------------------------------------------------
380 */
381
382 static Tcl_Obj *
ExecuteRemoteObject(RegisteredInterp * riPtr,Tcl_Obj * ddeObjectPtr)383 ExecuteRemoteObject(
384 RegisteredInterp *riPtr, /* Info about this server. */
385 Tcl_Obj *ddeObjectPtr) /* The object to execute. */
386 {
387 Tcl_Obj *errorObjPtr;
388 Tcl_Obj *returnPackagePtr;
389 int result;
390
391 result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
392 returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
393 Tcl_ListObjAppendElement(NULL, returnPackagePtr,
394 Tcl_NewIntObj(result));
395 Tcl_ListObjAppendElement(NULL, returnPackagePtr,
396 Tcl_GetObjResult(riPtr->interp));
397 if (result == TCL_ERROR) {
398 errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
399 TCL_GLOBAL_ONLY);
400 Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
401 errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
402 TCL_GLOBAL_ONLY);
403 Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
404 }
405
406 return returnPackagePtr;
407 }
408
409 /*
410 *--------------------------------------------------------------
411 *
412 * DdeServerProc --
413 *
414 * Handles all transactions for this server. Can handle
415 * execute, request, and connect protocols. Dde will
416 * call this routine when a client attempts to run a dde
417 * command using this server.
418 *
419 * Results:
420 * A DDE Handle with the result of the dde command.
421 *
422 * Side effects:
423 * Depending on which command is executed, arbitrary
424 * Tcl scripts can be run.
425 *
426 *--------------------------------------------------------------
427 */
428
429 static HDDEDATA CALLBACK
DdeServerProc(UINT uType,UINT uFmt,HCONV hConv,HSZ ddeTopic,HSZ ddeItem,HDDEDATA hData,DWORD dwData1,DWORD dwData2)430 DdeServerProc (
431 UINT uType, /* The type of DDE transaction we
432 * are performing. */
433 UINT uFmt, /* The format that data is sent or
434 * received. */
435 HCONV hConv, /* The conversation associated with the
436 * current transaction. */
437 HSZ ddeTopic, /* A string handle. Transaction-type
438 * dependent. */
439 HSZ ddeItem, /* A string handle. Transaction-type
440 * dependent. */
441 HDDEDATA hData, /* DDE data. Transaction-type dependent. */
442 DWORD dwData1, /* Transaction-dependent data. */
443 DWORD dwData2) /* Transaction-dependent data. */
444 {
445 Tcl_DString dString;
446 int len;
447 DWORD dlen;
448 char *utilString;
449 Tcl_Obj *ddeObjectPtr;
450 HDDEDATA ddeReturn = NULL;
451 RegisteredInterp *riPtr;
452 Conversation *convPtr, *prevConvPtr;
453 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
454
455 switch(uType) {
456 case XTYP_CONNECT:
457
458 /*
459 * Dde is trying to initialize a conversation with us. Check
460 * and make sure we have a valid topic.
461 */
462
463 len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
464 Tcl_DStringInit(&dString);
465 Tcl_DStringSetLength(&dString, len);
466 utilString = Tcl_DStringValue(&dString);
467 DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
468 CP_WINANSI);
469
470 for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
471 riPtr = riPtr->nextPtr) {
472 if (stricmp(utilString, riPtr->name) == 0) {
473 Tcl_DStringFree(&dString);
474 return (HDDEDATA) TRUE;
475 }
476 }
477
478 Tcl_DStringFree(&dString);
479 return (HDDEDATA) FALSE;
480
481 case XTYP_CONNECT_CONFIRM:
482
483 /*
484 * Dde has decided that we can connect, so it gives us a
485 * conversation handle. We need to keep track of it
486 * so we know which execution result to return in an
487 * XTYP_REQUEST.
488 */
489
490 len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
491 Tcl_DStringInit(&dString);
492 Tcl_DStringSetLength(&dString, len);
493 utilString = Tcl_DStringValue(&dString);
494 DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
495 CP_WINANSI);
496 for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
497 riPtr = riPtr->nextPtr) {
498 if (stricmp(riPtr->name, utilString) == 0) {
499 convPtr = (Conversation *) ckalloc(sizeof(Conversation));
500 convPtr->nextPtr = tsdPtr->currentConversations;
501 convPtr->returnPackagePtr = NULL;
502 convPtr->hConv = hConv;
503 convPtr->riPtr = riPtr;
504 tsdPtr->currentConversations = convPtr;
505 break;
506 }
507 }
508 Tcl_DStringFree(&dString);
509 return (HDDEDATA) TRUE;
510
511 case XTYP_DISCONNECT:
512
513 /*
514 * The client has disconnected from our server. Forget this
515 * conversation.
516 */
517
518 for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
519 convPtr != NULL;
520 prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
521 if (hConv == convPtr->hConv) {
522 if (prevConvPtr == NULL) {
523 tsdPtr->currentConversations = convPtr->nextPtr;
524 } else {
525 prevConvPtr->nextPtr = convPtr->nextPtr;
526 }
527 if (convPtr->returnPackagePtr != NULL) {
528 Tcl_DecrRefCount(convPtr->returnPackagePtr);
529 }
530 ckfree((char *) convPtr);
531 break;
532 }
533 }
534 return (HDDEDATA) TRUE;
535
536 case XTYP_REQUEST:
537
538 /*
539 * This could be either a request for a value of a Tcl variable,
540 * or it could be the send command requesting the results of the
541 * last execute.
542 */
543
544 if (uFmt != CF_TEXT) {
545 return (HDDEDATA) FALSE;
546 }
547
548 ddeReturn = (HDDEDATA) FALSE;
549 for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
550 && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
551 /*
552 * Empty loop body.
553 */
554 }
555
556 if (convPtr != NULL) {
557 char *returnString;
558
559 len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
560 CP_WINANSI);
561 Tcl_DStringInit(&dString);
562 Tcl_DStringSetLength(&dString, len);
563 utilString = Tcl_DStringValue(&dString);
564 DdeQueryString(ddeInstance, ddeItem, utilString,
565 (DWORD) len + 1, CP_WINANSI);
566 if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
567 returnString =
568 Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
569 ddeReturn = DdeCreateDataHandle(ddeInstance,
570 returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT,
571 0);
572 } else {
573 Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
574 convPtr->riPtr->interp, utilString, NULL,
575 TCL_GLOBAL_ONLY);
576 if (variableObjPtr != NULL) {
577 returnString = Tcl_GetStringFromObj(variableObjPtr,
578 &len);
579 ddeReturn = DdeCreateDataHandle(ddeInstance,
580 returnString, (DWORD) len+1, 0, ddeItem,
581 CF_TEXT, 0);
582 } else {
583 ddeReturn = NULL;
584 }
585 }
586 Tcl_DStringFree(&dString);
587 }
588 return ddeReturn;
589
590 case XTYP_EXECUTE: {
591
592 /*
593 * Execute this script. The results will be saved into
594 * a list object which will be retrieved later. See
595 * ExecuteRemoteObject.
596 */
597
598 Tcl_Obj *returnPackagePtr;
599
600 for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
601 && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
602 /*
603 * Empty loop body.
604 */
605
606 }
607
608 if (convPtr == NULL) {
609 return (HDDEDATA) DDE_FNOTPROCESSED;
610 }
611
612 utilString = (char *) DdeAccessData(hData, &dlen);
613 len = dlen;
614 ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
615 Tcl_IncrRefCount(ddeObjectPtr);
616 DdeUnaccessData(hData);
617 if (convPtr->returnPackagePtr != NULL) {
618 Tcl_DecrRefCount(convPtr->returnPackagePtr);
619 }
620 convPtr->returnPackagePtr = NULL;
621 returnPackagePtr =
622 ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
623 Tcl_IncrRefCount(returnPackagePtr);
624 for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
625 && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
626 /*
627 * Empty loop body.
628 */
629
630 }
631 if (convPtr != NULL) {
632 convPtr->returnPackagePtr = returnPackagePtr;
633 } else {
634 Tcl_DecrRefCount(returnPackagePtr);
635 }
636 Tcl_DecrRefCount(ddeObjectPtr);
637 if (returnPackagePtr == NULL) {
638 return (HDDEDATA) DDE_FNOTPROCESSED;
639 } else {
640 return (HDDEDATA) DDE_FACK;
641 }
642 }
643
644 case XTYP_WILDCONNECT: {
645
646 /*
647 * Dde wants a list of services and topics that we support.
648 */
649
650 HSZPAIR *returnPtr;
651 int i;
652 int numItems;
653
654 for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
655 i++, riPtr = riPtr->nextPtr) {
656 /*
657 * Empty loop body.
658 */
659
660 }
661
662 numItems = i;
663 ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
664 (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
665 returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
666 len = dlen;
667 for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
668 i++, riPtr = riPtr->nextPtr) {
669 returnPtr[i].hszSvc = DdeCreateStringHandle(
670 ddeInstance, "TclEval", CP_WINANSI);
671 returnPtr[i].hszTopic = DdeCreateStringHandle(
672 ddeInstance, riPtr->name, CP_WINANSI);
673 }
674 returnPtr[i].hszSvc = NULL;
675 returnPtr[i].hszTopic = NULL;
676 DdeUnaccessData(ddeReturn);
677 return ddeReturn;
678 }
679
680 }
681 return NULL;
682 }
683
684 /*
685 *--------------------------------------------------------------
686 *
687 * DdeExitProc --
688 *
689 * Gets rid of our DDE server when we go away.
690 *
691 * Results:
692 * None.
693 *
694 * Side effects:
695 * The DDE server is deleted.
696 *
697 *--------------------------------------------------------------
698 */
699
700 static void
DdeExitProc(ClientData clientData)701 DdeExitProc(
702 ClientData clientData) /* Not used in this handler. */
703 {
704 DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
705 DdeUninitialize(ddeInstance);
706 ddeInstance = 0;
707 }
708
709 /*
710 *--------------------------------------------------------------
711 *
712 * MakeDdeConnection --
713 *
714 * This procedure is a utility used to connect to a DDE
715 * server when given a server name and a topic name.
716 *
717 * Results:
718 * A standard Tcl result.
719 *
720 *
721 * Side effects:
722 * Passes back a conversation through ddeConvPtr
723 *
724 *--------------------------------------------------------------
725 */
726
727 static int
MakeDdeConnection(Tcl_Interp * interp,char * name,HCONV * ddeConvPtr)728 MakeDdeConnection(
729 Tcl_Interp *interp, /* Used to report errors. */
730 char *name, /* The connection to use. */
731 HCONV *ddeConvPtr)
732 {
733 HSZ ddeTopic, ddeService;
734 HCONV ddeConv;
735
736 ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
737 ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
738
739 ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
740 DdeFreeStringHandle(ddeInstance, ddeService);
741 DdeFreeStringHandle(ddeInstance, ddeTopic);
742
743 if (ddeConv == (HCONV) NULL) {
744 if (interp != NULL) {
745 Tcl_AppendResult(interp, "no registered server named \"",
746 name, "\"", (char *) NULL);
747 }
748 return TCL_ERROR;
749 }
750
751 *ddeConvPtr = ddeConv;
752 return TCL_OK;
753 }
754
755 /*
756 *--------------------------------------------------------------
757 *
758 * SetDdeError --
759 *
760 * Sets the interp result to a cogent error message
761 * describing the last DDE error.
762 *
763 * Results:
764 * None.
765 *
766 *
767 * Side effects:
768 * The interp's result object is changed.
769 *
770 *--------------------------------------------------------------
771 */
772
773 static void
SetDdeError(Tcl_Interp * interp)774 SetDdeError(
775 Tcl_Interp *interp) /* The interp to put the message in.*/
776 {
777 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
778 int err;
779
780 err = DdeGetLastError(ddeInstance);
781 switch (err) {
782 case DMLERR_DATAACKTIMEOUT:
783 case DMLERR_EXECACKTIMEOUT:
784 case DMLERR_POKEACKTIMEOUT:
785 Tcl_SetStringObj(resultPtr,
786 "remote interpreter did not respond", -1);
787 break;
788
789 case DMLERR_BUSY:
790 Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
791 break;
792
793 case DMLERR_NOTPROCESSED:
794 Tcl_SetStringObj(resultPtr,
795 "remote server cannot handle this command", -1);
796 break;
797
798 default:
799 Tcl_SetStringObj(resultPtr, "dde command failed", -1);
800 }
801 }
802
803 /*
804 *--------------------------------------------------------------
805 *
806 * Tcl_DdeObjCmd --
807 *
808 * This procedure is invoked to process the "dde" Tcl command.
809 * See the user documentation for details on what it does.
810 *
811 * Results:
812 * A standard Tcl result.
813 *
814 * Side effects:
815 * See the user documentation.
816 *
817 *--------------------------------------------------------------
818 */
819
820 int
Tcl_DdeObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])821 Tcl_DdeObjCmd(
822 ClientData clientData, /* Used only for deletion */
823 Tcl_Interp *interp, /* The interp we are sending from */
824 int objc, /* Number of arguments */
825 Tcl_Obj *CONST objv[]) /* The arguments */
826 {
827 enum {
828 DDE_SERVERNAME,
829 DDE_EXECUTE,
830 DDE_POKE,
831 DDE_REQUEST,
832 DDE_SERVICES,
833 DDE_EVAL
834 };
835
836 static CONST char *ddeCommands[] = {"servername", "execute", "poke",
837 "request", "services", "eval",
838 (char *) NULL};
839 static CONST char *ddeOptions[] = {"-async", (char *) NULL};
840 static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
841 int index, argIndex;
842 int async = 0, binary = 0;
843 int result = TCL_OK;
844 HSZ ddeService = NULL;
845 HSZ ddeTopic = NULL;
846 HSZ ddeItem = NULL;
847 HDDEDATA ddeData = NULL;
848 HDDEDATA ddeItemData = NULL;
849 HCONV hConv = NULL;
850 HSZ ddeCookie = 0;
851 char *serviceName, *topicName, *itemString, *dataString;
852 char *string;
853 int firstArg, length, dataLength;
854 DWORD ddeResult;
855 HDDEDATA ddeReturn;
856 RegisteredInterp *riPtr;
857 Tcl_Interp *sendInterp;
858 Tcl_Obj *objPtr;
859 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
860
861 /*
862 * Initialize DDE server/client
863 */
864
865 if (objc < 2) {
866 Tcl_WrongNumArgs(interp, 1, objv,
867 "?-async? serviceName topicName value");
868 return TCL_ERROR;
869 }
870
871 if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
872 &index) != TCL_OK) {
873 return TCL_ERROR;
874 }
875
876 switch (index) {
877 case DDE_SERVERNAME:
878 if ((objc != 3) && (objc != 2)) {
879 Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
880 return TCL_ERROR;
881 }
882 firstArg = (objc - 1);
883 break;
884 case DDE_EXECUTE:
885 if ((objc < 5) || (objc > 6)) {
886 Tcl_WrongNumArgs(interp, 1, objv,
887 "execute ?-async? serviceName topicName value");
888 return TCL_ERROR;
889 }
890 if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
891 &argIndex) != TCL_OK) {
892 if (objc != 5) {
893 Tcl_WrongNumArgs(interp, 1, objv,
894 "execute ?-async? serviceName topicName value");
895 return TCL_ERROR;
896 }
897 async = 0;
898 firstArg = 2;
899 } else {
900 if (objc != 6) {
901 Tcl_WrongNumArgs(interp, 1, objv,
902 "execute ?-async? serviceName topicName value");
903 return TCL_ERROR;
904 }
905 async = 1;
906 firstArg = 3;
907 }
908 break;
909 case DDE_POKE:
910 if (objc != 6) {
911 Tcl_WrongNumArgs(interp, 1, objv,
912 "poke serviceName topicName item value");
913 return TCL_ERROR;
914 }
915 firstArg = 2;
916 break;
917 case DDE_REQUEST:
918 if ((objc < 5) || (objc > 6)) {
919 Tcl_WrongNumArgs(interp, 1, objv,
920 "request ?-binary? serviceName topicName value");
921 return TCL_ERROR;
922 }
923 if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
924 &argIndex) != TCL_OK) {
925 if (objc != 5) {
926 Tcl_WrongNumArgs(interp, 1, objv,
927 "request ?-binary? serviceName topicName value");
928 return TCL_ERROR;
929 }
930 binary = 0;
931 firstArg = 2;
932 } else {
933 if (objc != 6) {
934 Tcl_WrongNumArgs(interp, 1, objv,
935 "request ?-binary? serviceName topicName value");
936 return TCL_ERROR;
937 }
938 binary = 1;
939 firstArg = 3;
940 }
941 break;
942 case DDE_SERVICES:
943 if (objc != 4) {
944 Tcl_WrongNumArgs(interp, 1, objv,
945 "services serviceName topicName");
946 return TCL_ERROR;
947 }
948 firstArg = 2;
949 break;
950 case DDE_EVAL:
951 if (objc < 4) {
952 Tcl_WrongNumArgs(interp, 1, objv,
953 "eval ?-async? serviceName args");
954 return TCL_ERROR;
955 }
956 if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
957 &argIndex) != TCL_OK) {
958 if (objc < 4) {
959 Tcl_WrongNumArgs(interp, 1, objv,
960 "eval ?-async? serviceName args");
961 return TCL_ERROR;
962 }
963 async = 0;
964 firstArg = 2;
965 } else {
966 if (objc < 5) {
967 Tcl_WrongNumArgs(interp, 1, objv,
968 "eval ?-async? serviceName args");
969 return TCL_ERROR;
970 }
971 async = 1;
972 firstArg = 3;
973 }
974 break;
975 }
976
977 Initialize();
978
979 if (firstArg != 1) {
980 serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
981 } else {
982 length = 0;
983 }
984
985 if (length == 0) {
986 serviceName = NULL;
987 } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
988 ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
989 CP_WINANSI);
990 }
991
992 if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
993 topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
994 if (length == 0) {
995 topicName = NULL;
996 } else {
997 ddeTopic = DdeCreateStringHandle(ddeInstance,
998 topicName, CP_WINANSI);
999 }
1000 }
1001
1002 switch (index) {
1003 case DDE_SERVERNAME: {
1004 serviceName = DdeSetServerName(interp, serviceName);
1005 if (serviceName != NULL) {
1006 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1007 serviceName, -1);
1008 } else {
1009 Tcl_ResetResult(interp);
1010 }
1011 break;
1012 }
1013 case DDE_EXECUTE: {
1014 dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
1015 if (dataLength == 0) {
1016 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1017 "cannot execute null data", -1);
1018 result = TCL_ERROR;
1019 break;
1020 }
1021 hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1022 DdeFreeStringHandle(ddeInstance, ddeService);
1023 DdeFreeStringHandle(ddeInstance, ddeTopic);
1024
1025 if (hConv == NULL) {
1026 SetDdeError(interp);
1027 result = TCL_ERROR;
1028 break;
1029 }
1030
1031 ddeData = DdeCreateDataHandle(ddeInstance, dataString,
1032 (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
1033 if (ddeData != NULL) {
1034 if (async) {
1035 DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
1036 CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1037 DdeAbandonTransaction(ddeInstance, hConv,
1038 ddeResult);
1039 } else {
1040 ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
1041 hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1042 if (ddeReturn == 0) {
1043 SetDdeError(interp);
1044 result = TCL_ERROR;
1045 }
1046 }
1047 DdeFreeDataHandle(ddeData);
1048 } else {
1049 SetDdeError(interp);
1050 result = TCL_ERROR;
1051 }
1052 break;
1053 }
1054 case DDE_REQUEST: {
1055 itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1056 if (length == 0) {
1057 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1058 "cannot request value of null data", -1);
1059 goto errorNoResult;
1060 }
1061 hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1062 DdeFreeStringHandle(ddeInstance, ddeService);
1063 DdeFreeStringHandle(ddeInstance, ddeTopic);
1064
1065 if (hConv == NULL) {
1066 SetDdeError(interp);
1067 result = TCL_ERROR;
1068 } else {
1069 Tcl_Obj *returnObjPtr;
1070 ddeItem = DdeCreateStringHandle(ddeInstance,
1071 itemString, CP_WINANSI);
1072 if (ddeItem != NULL) {
1073 ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
1074 CF_TEXT, XTYP_REQUEST, 5000, NULL);
1075 if (ddeData == NULL) {
1076 SetDdeError(interp);
1077 result = TCL_ERROR;
1078 } else {
1079 DWORD tmp;
1080 dataString = DdeAccessData(ddeData, &tmp);
1081 dataLength = tmp;
1082 if (binary) {
1083 returnObjPtr = Tcl_NewByteArrayObj(dataString,
1084 dataLength);
1085 } else {
1086 returnObjPtr = Tcl_NewStringObj(dataString, -1);
1087 }
1088 DdeUnaccessData(ddeData);
1089 DdeFreeDataHandle(ddeData);
1090 Tcl_SetObjResult(interp, returnObjPtr);
1091 }
1092 } else {
1093 SetDdeError(interp);
1094 result = TCL_ERROR;
1095 }
1096 }
1097
1098 break;
1099 }
1100 case DDE_POKE: {
1101 itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1102 if (length == 0) {
1103 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1104 "cannot have a null item", -1);
1105 goto errorNoResult;
1106 }
1107 dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
1108
1109 hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1110 DdeFreeStringHandle(ddeInstance, ddeService);
1111 DdeFreeStringHandle(ddeInstance, ddeTopic);
1112
1113 if (hConv == NULL) {
1114 SetDdeError(interp);
1115 result = TCL_ERROR;
1116 } else {
1117 ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
1118 CP_WINANSI);
1119 if (ddeItem != NULL) {
1120 ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
1121 hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
1122 if (ddeData == NULL) {
1123 SetDdeError(interp);
1124 result = TCL_ERROR;
1125 }
1126 } else {
1127 SetDdeError(interp);
1128 result = TCL_ERROR;
1129 }
1130 }
1131 break;
1132 }
1133
1134 case DDE_SERVICES: {
1135 HCONVLIST hConvList;
1136 CONVINFO convInfo;
1137 Tcl_Obj *convListObjPtr, *elementObjPtr;
1138 Tcl_DString dString;
1139 char *name;
1140
1141 convInfo.cb = sizeof(CONVINFO);
1142 hConvList = DdeConnectList(ddeInstance, ddeService,
1143 ddeTopic, 0, NULL);
1144 DdeFreeStringHandle(ddeInstance,ddeService);
1145 DdeFreeStringHandle(ddeInstance, ddeTopic);
1146 hConv = 0;
1147 convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1148 Tcl_DStringInit(&dString);
1149
1150 while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
1151 elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1152 DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
1153 length = DdeQueryString(ddeInstance,
1154 convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
1155 Tcl_DStringSetLength(&dString, length);
1156 name = Tcl_DStringValue(&dString);
1157 DdeQueryString(ddeInstance, convInfo.hszSvcPartner,
1158 name, (DWORD) length + 1, CP_WINANSI);
1159 Tcl_ListObjAppendElement(interp, elementObjPtr,
1160 Tcl_NewStringObj(name, length));
1161 length = DdeQueryString(ddeInstance, convInfo.hszTopic,
1162 NULL, 0, CP_WINANSI);
1163 Tcl_DStringSetLength(&dString, length);
1164 name = Tcl_DStringValue(&dString);
1165 DdeQueryString(ddeInstance, convInfo.hszTopic, name,
1166 (DWORD) length + 1, CP_WINANSI);
1167 Tcl_ListObjAppendElement(interp, elementObjPtr,
1168 Tcl_NewStringObj(name, length));
1169 Tcl_ListObjAppendElement(interp, convListObjPtr,
1170 elementObjPtr);
1171 }
1172 DdeDisconnectList(hConvList);
1173 Tcl_SetObjResult(interp, convListObjPtr);
1174 Tcl_DStringFree(&dString);
1175 break;
1176 }
1177 case DDE_EVAL: {
1178 if (serviceName == NULL) {
1179 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1180 "invalid service name \"\"", -1);
1181 goto errorNoResult;
1182 }
1183
1184 objc -= (async + 3);
1185 ((Tcl_Obj **) objv) += (async + 3);
1186
1187 /*
1188 * See if the target interpreter is local. If so, execute
1189 * the command directly without going through the DDE server.
1190 * Don't exchange objects between interps. The target interp could
1191 * compile an object, producing a bytecode structure that refers to
1192 * other objects owned by the target interp. If the target interp
1193 * is then deleted, the bytecode structure would be referring to
1194 * deallocated objects.
1195 */
1196
1197 for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
1198 riPtr = riPtr->nextPtr) {
1199 if (stricmp(serviceName, riPtr->name) == 0) {
1200 break;
1201 }
1202 }
1203
1204 if (riPtr != NULL) {
1205 /*
1206 * This command is to a local interp. No need to go through
1207 * the server.
1208 */
1209
1210 Tcl_Preserve((ClientData) riPtr);
1211 sendInterp = riPtr->interp;
1212 Tcl_Preserve((ClientData) sendInterp);
1213
1214 /*
1215 * Don't exchange objects between interps. The target interp
1216 * would compile an object, producing a bytecode structure that
1217 * refers to other objects owned by the target interp. If the
1218 * target interp is then deleted, the bytecode structure would
1219 * be referring to deallocated objects.
1220 */
1221
1222 if (objc == 1) {
1223 result = Tcl_EvalObjEx(sendInterp, objv[0],
1224 TCL_EVAL_GLOBAL);
1225 } else {
1226 objPtr = Tcl_ConcatObj(objc, objv);
1227 Tcl_IncrRefCount(objPtr);
1228 result = Tcl_EvalObjEx(sendInterp, objPtr,
1229 TCL_EVAL_GLOBAL);
1230 Tcl_DecrRefCount(objPtr);
1231 }
1232 if (interp != sendInterp) {
1233 if (result == TCL_ERROR) {
1234 /*
1235 * An error occurred, so transfer error information
1236 * from the destination interpreter back to our
1237 * interpreter.
1238 */
1239
1240 Tcl_ResetResult(interp);
1241 objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
1242 TCL_GLOBAL_ONLY);
1243 string = Tcl_GetStringFromObj(objPtr, &length);
1244 Tcl_AddObjErrorInfo(interp, string, length);
1245
1246 objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
1247 TCL_GLOBAL_ONLY);
1248 Tcl_SetObjErrorCode(interp, objPtr);
1249 }
1250 Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
1251 }
1252 Tcl_Release((ClientData) riPtr);
1253 Tcl_Release((ClientData) sendInterp);
1254 } else {
1255 /*
1256 * This is a non-local request. Send the script to the server
1257 * and poll it for a result.
1258 */
1259
1260 if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
1261 goto error;
1262 }
1263
1264 objPtr = Tcl_ConcatObj(objc, objv);
1265 string = Tcl_GetStringFromObj(objPtr, &length);
1266 ddeItemData = DdeCreateDataHandle(ddeInstance, string,
1267 (DWORD) length+1, 0, 0, CF_TEXT, 0);
1268
1269 if (async) {
1270 ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
1271 0xFFFFFFFF, hConv, 0,
1272 CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1273 DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
1274 } else {
1275 ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
1276 0xFFFFFFFF, hConv, 0,
1277 CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1278 if (ddeData != 0) {
1279
1280 ddeCookie = DdeCreateStringHandle(ddeInstance,
1281 "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
1282 ddeData = DdeClientTransaction(NULL, 0, hConv,
1283 ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
1284 }
1285 }
1286
1287 Tcl_DecrRefCount(objPtr);
1288
1289 if (ddeData == 0) {
1290 SetDdeError(interp);
1291 goto errorNoResult;
1292 }
1293
1294 if (async == 0) {
1295 Tcl_Obj *resultPtr;
1296
1297 /*
1298 * The return handle has a two or four element list in
1299 * it. The first element is the return code (TCL_OK,
1300 * TCL_ERROR, etc.). The second is the result of the
1301 * script. If the return code is TCL_ERROR, then the third
1302 * element is the value of the variable "errorCode", and
1303 * the fourth is the value of the variable "errorInfo".
1304 */
1305
1306 resultPtr = Tcl_NewObj();
1307 length = DdeGetData(ddeData, NULL, 0, 0);
1308 Tcl_SetObjLength(resultPtr, length);
1309 string = Tcl_GetString(resultPtr);
1310 DdeGetData(ddeData, string, (DWORD) length, 0);
1311 Tcl_SetObjLength(resultPtr, (int) strlen(string));
1312
1313 if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
1314 != TCL_OK) {
1315 Tcl_DecrRefCount(resultPtr);
1316 goto error;
1317 }
1318 if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
1319 Tcl_DecrRefCount(resultPtr);
1320 goto error;
1321 }
1322 if (result == TCL_ERROR) {
1323 Tcl_ResetResult(interp);
1324
1325 if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
1326 != TCL_OK) {
1327 Tcl_DecrRefCount(resultPtr);
1328 goto error;
1329 }
1330 length = -1;
1331 string = Tcl_GetStringFromObj(objPtr, &length);
1332 Tcl_AddObjErrorInfo(interp, string, length);
1333
1334 Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
1335 Tcl_SetObjErrorCode(interp, objPtr);
1336 }
1337 if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
1338 != TCL_OK) {
1339 Tcl_DecrRefCount(resultPtr);
1340 goto error;
1341 }
1342 Tcl_SetObjResult(interp, objPtr);
1343 Tcl_DecrRefCount(resultPtr);
1344 }
1345 }
1346 }
1347 }
1348 if (ddeCookie != NULL) {
1349 DdeFreeStringHandle(ddeInstance, ddeCookie);
1350 }
1351 if (ddeItem != NULL) {
1352 DdeFreeStringHandle(ddeInstance, ddeItem);
1353 }
1354 if (ddeItemData != NULL) {
1355 DdeFreeDataHandle(ddeItemData);
1356 }
1357 if (ddeData != NULL) {
1358 DdeFreeDataHandle(ddeData);
1359 }
1360 if (hConv != NULL) {
1361 DdeDisconnect(hConv);
1362 }
1363 return result;
1364
1365 error:
1366 Tcl_SetStringObj(Tcl_GetObjResult(interp),
1367 "invalid data returned from server", -1);
1368
1369 errorNoResult:
1370 if (ddeCookie != NULL) {
1371 DdeFreeStringHandle(ddeInstance, ddeCookie);
1372 }
1373 if (ddeItem != NULL) {
1374 DdeFreeStringHandle(ddeInstance, ddeItem);
1375 }
1376 if (ddeItemData != NULL) {
1377 DdeFreeDataHandle(ddeItemData);
1378 }
1379 if (ddeData != NULL) {
1380 DdeFreeDataHandle(ddeData);
1381 }
1382 if (hConv != NULL) {
1383 DdeDisconnect(hConv);
1384 }
1385 return TCL_ERROR;
1386 }
1387