开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
win32.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：19k
源码类别：

通讯编程

开发平台：

Visual C++

win32.c：源码内容
  1. /*
  2.  * Copyright (c) 1996 The Regents of the University of California.
  3.  * All rights reserved.
  4.  * 
  5.  * Redistribution and use in source and binary forms, with or without
  6.  * modification, are permitted provided that the following conditions
  7.  * are met:
  8.  * 1. Redistributions of source code must retain the above copyright
  9.  *    notice, this list of conditions and the following disclaimer.
  10.  * 2. Redistributions in binary form must reproduce the above copyright
  11.  *    notice, this list of conditions and the following disclaimer in the
  12.  *    documentation and/or other materials provided with the distribution.
  13.  * 3. All advertising materials mentioning features or use of this software
  14.  *    must display the following acknowledgement:
  15.  *  This product includes software developed by the Network Research
  16.  *  Group at Lawrence Berkeley National Laboratory.
  17.  * 4. Neither the name of the University nor of the Laboratory may be used
  18.  *    to endorse or promote products derived from this software without
  19.  *    specific prior written permission.
  20.  * 
  21.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  22.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  25.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31.  * SUCH DAMAGE.
  32.  *
  33.  * This module contributed by John Brezak <brezak@apollo.hp.com>.
  34.  * January 31, 1996
  35.  */
  36. #ifndef lint
  37. static char rcsid[] =
  38.     "@(#) $Header: /cvsroot/nsnam/nam-1/win32.c,v 1.2 1997/11/22 22:59:36 tecklee Exp $ (LBL)";
  39. #endif
  41. #include <assert.h>
  42. #include <io.h>
  43. #include <process.h>
  44. #include <fcntl.h>
  45. #include <windows.h>
  46. #include <malloc.h>
  47. #include <string.h>
  48. #include <stdio.h>
  49. #include <time.h>
  50. #include <winsock.h>
  51. #include <tk.h>
  52. #include <locale.h>
  54. /* forward declarations */
  55. int WinGetUserName(ClientData, Tcl_Interp*, int ac, char**av);
  56. int WinGetHostName(ClientData, Tcl_Interp*, int ac, char**av);
  57. int WinPutRegistry(ClientData, Tcl_Interp*, int ac, char**av);
  58. int WinGetRegistry(ClientData, Tcl_Interp*, int ac, char**av);
  59. int WinExit(ClientData, Tcl_Interp*, int ac, char**av);
  60. void TkConsoleCreate();
  61. int TkConsoleInit(Tcl_Interp* interp);
  63. #ifdef STATIC_TCLTK
  64. extern HINSTANCE Tk_GetHINSTANCE();
  65. extern BOOL APIENTRY Tk_LibMain(HINSTANCE hInstance,DWORD reason,LPVOID reserved);
  66. extern BOOL APIENTRY Tcl_LibMain(HINSTANCE hInstance,DWORD reason,LPVOID reserved);
  67. void static_exit(void){
  68. HINSTANCE hInstance = Tk_GetHINSTANCE();
  69. Tcl_LibMain(hInstance, DLL_PROCESS_DETACH, NULL);
  70. Tk_LibMain(hInstance, DLL_PROCESS_DETACH, NULL);
  71. } 
  72. #endif
  75. int strcasecmp(const char *s1, const char *s2)
  76. {
  77.     return stricmp(s1, s2);
  78. }
  80. extern void TkWinXInit(HINSTANCE hInstance);
  81. extern int main(int argc, const char *argv[]);
  82. #ifndef STATIC_TCLTK
  83. extern int __argc;
  84. extern char **__argv;
  85. #endif
  87. static char argv0[255]; /* Buffer used to hold argv0. */
  89. char *__progname = "nam";
  91. void
  92. ShowMessage(int level, char *msg)
  93. {
  94.     MessageBeep(level);
  95.     MessageBox(NULL, msg, __progname,
  96.        level | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
  97. }
  99. int SetupConsole()
  100. {
  101.     // stuff from knowledge base Q105305 (see that for details)
  102.     // open a console and do the work around to get the console to work in all
  103.     // cases
  104.     int hCrt;
  105.     FILE *hf=0;
  106.     const COORD screenSz = {80, 2000}; /* size of console buffer */
  108.     AllocConsole();
  110.     hf=0;
  111.     hCrt = _open_osfhandle(
  112.             (long)GetStdHandle(STD_OUTPUT_HANDLE), _O_TEXT);
  113.     if (hCrt!=-1) hf = _fdopen(hCrt, "w");
  114.     if (hf!=0) *stdout = *hf;
  115.     if (hCrt==-1 || hf==0 || 0!=setvbuf(stdout, NULL, _IONBF, 0)) {
  116.             ShowMessage(MB_ICONINFORMATION,
  117.                         "unable to reroute stdout");
  118.             return FALSE;
  119.     }
  120.     SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), screenSz);
  122.     hf=0;
  123.     hCrt = _open_osfhandle(
  124.         (long)GetStdHandle(STD_ERROR_HANDLE), _O_TEXT);
  125.     if (hCrt!=-1) hf = _fdopen(hCrt, "w");
  126.     if (hf!=0) *stderr = *hf;
  127.     if (hCrt==-1 || hf==0 || 0!=setvbuf(stderr, NULL, _IONBF, 0)) {
  128.             ShowMessage(MB_ICONINFORMATION,
  129.                         "reroute stderr failed in SetupConsole");
  130.             return FALSE;
  131.     }
  133.     hf=0;
  134.     hCrt = _open_osfhandle((long)GetStdHandle(STD_INPUT_HANDLE), _O_TEXT);
  135.     if (hCrt!=-1) hf = _fdopen(hCrt, "r");
  136.     if (hf!=0) *stdin = *hf;
  137.     if (hCrt==-1 || hf==0 || 0!=setvbuf(stdin, NULL, _IONBF, 0)) {
  138.             ShowMessage(MB_ICONINFORMATION,
  139.                         "reroute stdin failed in SetupConsole");
  140.             return FALSE;
  141.     }
  142.     return TRUE;
  143. }
  145. int APIENTRY
  146. WinMain(
  147.     HINSTANCE hInstance,
  148.     HINSTANCE hPrevInstance,
  149.     LPSTR lpszCmdLine,
  150.     int nCmdShow)
  151. {
  152.     char *p;
  153.     WSADATA WSAdata;
  154.     int retcode;
  156. #ifdef STATIC_TCLTK
  157.     Tcl_LibMain(hInstance, DLL_PROCESS_ATTACH, NULL);
  158.     Tk_LibMain(hInstance, DLL_PROCESS_ATTACH, NULL);
  159.     atexit(static_exit);
  160. #endif
  161.  
  162.     setlocale(LC_ALL, "C");
  164.     /* XXX
  165.      * initialize our socket interface plus the tcl 7.5 socket
  166.      * interface (since they redefine some routines we call).
  167.      * eventually we should just call the tcl sockets but at
  168.      * the moment that's hard to set up since they only support
  169.      * tcp in the notifier.
  170.      */
  171.     if (WSAStartup(MAKEWORD (1, 1), &WSAdata)) {
  172.      perror("Windows Sockets init failed");
  173. abort();
  174.     }
  175. /*    TclHasSockets(NULL);
  177.     TkWinXInit(hInstance); */
  179.     /*
  180.      * Increase the application queue size from default value of 8.
  181.      * At the default value, cross application SendMessage of WM_KILLFOCUS
  182.      * will fail because the handler will not be able to do a PostMessage!
  183.      * This is only needed for Windows 3.x, since NT dynamically expands
  184.      * the queue.
  185.      */
  186.     SetMessageQueue(64);
  188.     GetModuleFileName(NULL, argv0, 255);
  189.     p = argv0;
  190.     __progname = strrchr(p, '/');
  191.     if (__progname != NULL) {
  192. __progname++;
  193.     }
  194.     else {
  195. __progname = strrchr(p, '\');
  196. if (__progname != NULL) {
  197.     __progname++;
  198. } else {
  199.     __progname = p;
  200. }
  201.     }
  203.     if (__argc>1) {            
  204.             SetupConsole();
  205.     }
  207.     retcode=main(__argc, (const char**)__argv);
  208.     if (retcode!=0) {
  209.             assert(FALSE);      // don't die without letting user know why
  210.     }
  211.     return retcode;
  212. }
  214. static char szTemp[4096];
  216. int outputErr(const char* szPrefix, Tcl_Interp* interp)
  217. {
  218. char *szError=Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  219.         int l = strlen(szPrefix) + strlen(interp->result) + 2 +
  220. strlen(szError) + 1;
  221.         char* szMsg = szTemp;
  222.         if (l>4096) szMsg = (char*)malloc(l*sizeof(char));
  223.         strcpy(szMsg, szPrefix);
  224. //        strcat(szMsg, interp->result);
  225. strcat(szMsg, "n");
  226. strcat(szMsg, szError);            
  227.         OutputDebugString(szMsg);
  228.         ShowMessage(MB_ICONERROR, szMsg);
  229.         assert(FALSE);
  230.         if (szMsg != szTemp) free(szMsg);
  231.         return 0;
  232. }       
  234. void
  235. win_perror(const char *msg)
  236. {
  237.     DWORD cMsgLen;
  238.     CHAR *msgBuf;
  239.     DWORD dwError = GetLastError();
  240.     
  241.     cMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
  242.     FORMAT_MESSAGE_ALLOCATE_BUFFER | 40, NULL,
  243.     dwError,
  244.     MAKELANGID(0, SUBLANG_ENGLISH_US),
  245.     (LPTSTR) &msgBuf, 512,
  246.     NULL);
  247.     if (!cMsgLen)
  248. fprintf(stderr, "%s%sError code %lun",
  249. msg?msg:"", msg?": ":"", dwError);
  250.     else {
  251. fprintf(stderr, "%s%s%sn", msg?msg:"", msg?": ":"", msgBuf);
  253. LocalFree((HLOCAL)msgBuf);
  254.     }
  255. }
  258. #if 0
  260. static char szTemp[4096];
  262. int
  263. printf(const char *fmt, ...)
  264. {
  265.     int retval;
  266.     
  267.     va_list ap;
  268.     va_start (ap, fmt);
  269.     retval = vsprintf(szTemp, fmt, ap);
  270.     OutputDebugString(szTemp);
  271.     ShowMessage(MB_ICONINFORMATION, szTemp);
  272.     va_end (ap);
  274.     return(retval);
  275. }
  277. int
  278. fprintf(FILE *f, const char *fmt, ...)
  279. {
  280.     int retval;
  281.     
  282.     va_list ap;
  283.     va_start (ap, fmt);
  284.     if (f == stderr) {
  285. retval = vsprintf(szTemp, fmt, ap);
  286. OutputDebugString(szTemp);
  287. ShowMessage(MB_ICONERROR, szTemp);
  288. va_end (ap);
  289.     }
  290.     else
  291. retval = vfprintf(f, fmt, ap);
  292.     
  293.     return(retval);
  294. }
  296. void
  297. perror(const char *msg)
  298. {
  299.     DWORD cMsgLen;
  300.     CHAR *msgBuf;
  301.     DWORD dwError = GetLastError();
  302.     
  303.     cMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
  304.     FORMAT_MESSAGE_ALLOCATE_BUFFER | 40, NULL,
  305.     dwError,
  306.     MAKELANGID(0, SUBLANG_ENGLISH_US),
  307.     (LPTSTR) &msgBuf, 512,
  308.     NULL);
  309.     if (!cMsgLen)
  310. fprintf(stderr, "%s%sError code %lun",
  311. msg?msg:"", msg?": ":"", dwError);
  312.     else {
  313. fprintf(stderr, "%s%s%sn", msg?msg:"", msg?": ":"", msgBuf);
  314. LocalFree((HLOCAL)msgBuf);
  315.     }
  316. }
  318. int
  319. WinPutsCmd(clientData, interp, argc, argv)
  320.     ClientData clientData; /* ConsoleInfo pointer. */
  321.     Tcl_Interp *interp; /* Current interpreter. */
  322.     int argc; /* Number of arguments. */
  323.     char **argv; /* Argument strings. */
  324. {
  325.     int i, newline;
  326.     char *fileId;
  328.     i = 1;
  329.     newline = 1;
  330.     if ((argc >= 2) && (strcmp(argv[1], "-nonewline") == 0)) {
  331. newline = 0;
  332. i++;
  333.     }
  334.     if ((i < (argc-3)) || (i >= argc)) {
  335. Tcl_AppendResult(interp, "wrong # args: should be "", argv[0],
  336. " ?-nonewline? ?fileId? string"", (char *) NULL);
  337. return TCL_ERROR;
  338.     }
  340.     /*
  341.      * The code below provides backwards compatibility with an old
  342.      * form of the command that is no longer recommended or documented.
  343.      */
  345.     if (i == (argc-3)) {
  346. if (strncmp(argv[i+2], "nonewline", strlen(argv[i+2])) != 0) {
  347.     Tcl_AppendResult(interp, "bad argument "", argv[i+2],
  348.     "": should be "nonewline"", (char *) NULL);
  349.     return TCL_ERROR;
  350. }
  351. newline = 0;
  352.     }
  353.     if (i == (argc-1)) {
  354. fileId = "stdout";
  355.     } else {
  356. fileId = argv[i];
  357. i++;
  358.     }
  360.     if (strcmp(fileId, "stdout") == 0 || strcmp(fileId, "stderr") == 0) {
  361. char *result;
  362. int level;
  364. if (newline) {
  365.     int len = strlen(argv[i]);
  366.     result = ckalloc(len+2);
  367.     memcpy(result, argv[i], len);
  368.     result[len] = 'n';
  369.     result[len+1] = 0;
  370. } else {
  371.     result = argv[i];
  372. }
  373. if (strcmp(fileId, "stdout") == 0) {
  374.     level = MB_ICONINFORMATION;
  375. } else {
  376.     level = MB_ICONERROR;
  377. }
  378. OutputDebugString(result);
  379. ShowMessage(level, result);
  380. if (newline)
  381.     ckfree(result);
  382. return TCL_OK;
  383.     } else {
  384. extern int Tcl_PutsCmd(ClientData clientData, Tcl_Interp *interp,
  385.        int argc, char **argv);
  387. return (Tcl_PutsCmd(clientData, interp, argc, argv));
  388.     }
  389. }
  390. #endif
  392. int
  393. WinGetUserName(clientData, interp, argc, argv)
  394.     ClientData clientData;
  395.     Tcl_Interp *interp; /* Current interpreter. */
  396.     int argc; /* Number of arguments. */
  397.     char *argv[]; /* Argument strings. */
  398. {
  399.     char user[256];
  400.     int size = sizeof(user);
  401.     
  402.     if (!GetUserName(user, &size)) {
  403. Tcl_AppendResult(interp, "GetUserName failed", NULL);
  404. return TCL_ERROR;
  405.     }
  406.     Tcl_AppendResult(interp, user, NULL);
  407.     return TCL_OK;
  408. }
  410. int WinGetHostName(clientData, interp, argc, argv)
  411.                    ClientData clientData;
  412.                    Tcl_Interp *interp; /* Current interpreter. */
  413.                    int argc; /* Number of arguments. */
  414.                    char *argv[]; /* Argument strings. */               
  415. {
  416.         char hostname[MAXGETHOSTSTRUCT];
  417.         if (SOCKET_ERROR == gethostname(hostname, MAXGETHOSTSTRUCT)) {
  418.                 Tcl_AddErrorInfo(interp, "gethostname failed!");
  419.         }
  420.         Tcl_AppendResult(interp, hostname, NULL);
  421.         return TCL_OK;
  422. }
  424. static HKEY
  425. regroot(root)
  426.     char *root;
  427. {
  428.     if (strcasecmp(root, "HKEY_LOCAL_MACHINE") == 0)
  429. return HKEY_LOCAL_MACHINE;
  430.     else if (strcasecmp(root, "HKEY_CURRENT_USER") == 0)
  431. return HKEY_CURRENT_USER;
  432.     else if (strcasecmp(root, "HKEY_USERS") == 0)
  433. return HKEY_USERS;
  434.     else if (strcasecmp(root, "HKEY_CLASSES_ROOT") == 0)
  435. return HKEY_CLASSES_ROOT;
  436.     else
  437. return NULL;
  438. }
  440. int
  441. WinGetRegistry(clientData, interp, argc, argv)
  442.     ClientData clientData;
  443.     Tcl_Interp *interp; /* Current interpreter. */
  444.     int argc; /* Number of arguments. */
  445.     char **argv; /* Argument strings. */
  446. {
  447.     HKEY hKey, hRootKey;
  448.     DWORD dwType;
  449.     DWORD len, retCode;
  450.     CHAR *regRoot, *regPath, *keyValue, *keyData;
  451.     int retval = TCL_ERROR;
  452.     
  453.     if (argc != 3) {
  454. Tcl_AppendResult(interp, "wrong # args: should be "", argv[0],
  455. "key value"", (char *) NULL);
  456. return TCL_ERROR;
  457.     }
  458.     regRoot = argv[1];
  459.     keyValue = argv[2];
  461.     regPath = strchr(regRoot, '\');
  462.     *regPath++ = '';
  463.     
  464.     if ((hRootKey = regroot(regRoot)) == NULL) {
  465. Tcl_AppendResult(interp, "Unknown registry root "",
  466.  regRoot, """, NULL);
  467. return (TCL_ERROR);
  468.     }
  469.     
  470.     retCode = RegOpenKeyEx(hRootKey, regPath, 0,
  471.    KEY_READ, &hKey);
  472.     if (retCode == ERROR_SUCCESS) {
  473. retCode = RegQueryValueEx(hKey, keyValue, NULL, &dwType,
  474.   NULL, &len);
  475. if (retCode == ERROR_SUCCESS &&
  476.     dwType == REG_SZ && len) {
  477.     keyData = (CHAR *) ckalloc(len);
  478.     retCode = RegQueryValueEx(hKey, keyValue, NULL, NULL,
  479.       keyData, &len);
  480.     if (retCode == ERROR_SUCCESS) {
  481. Tcl_AppendResult(interp, keyData, NULL);
  482. free(keyData);
  483. retval = TCL_OK;
  484.     }
  485. }
  486. RegCloseKey(hKey);
  487.     }
  488.     if (retval == TCL_ERROR) {
  489. Tcl_AppendResult(interp, "Cannot find registry entry "", regRoot,
  490.  "\", regPath, "\", keyValue, """, NULL);
  491.     }
  492.     return (retval);
  493. }
  495. int
  496. WinPutRegistry(clientData, interp, argc, argv)
  497.     ClientData clientData;
  498.     Tcl_Interp *interp; /* Current interpreter. */
  499.     int argc; /* Number of arguments. */
  500.     char **argv; /* Argument strings. */
  501. {
  502.     HKEY hKey, hRootKey;
  503.     DWORD retCode;
  504.     CHAR *regRoot, *regPath, *keyValue, *keyData;
  505.     DWORD new;
  506.     int result = TCL_OK;
  507.     
  508.     if (argc != 4) {
  509. Tcl_AppendResult(interp, "wrong # args: should be "", argv[0],
  510. "key value data"", (char *) NULL);
  511. return TCL_ERROR;
  512.     }
  513.     regRoot = argv[1];
  514.     keyValue = argv[2];
  515.     keyData = argv[3];
  516.     
  517.     regPath = strchr(regRoot, '\');
  518.     *regPath++ = '';
  519.     
  520.     if ((hRootKey = regroot(regRoot)) == NULL) {
  521. Tcl_AppendResult(interp, "Unknown registry root "",
  522.  regRoot, """, NULL);
  523. return (TCL_ERROR);
  524.     }
  526.     retCode = RegCreateKeyEx(hRootKey, regPath, 0,
  527.      "",
  528.      REG_OPTION_NON_VOLATILE,
  529.      KEY_ALL_ACCESS,
  530.      NULL,
  531.      &hKey, &new);
  532.     if (retCode == ERROR_SUCCESS) {
  533. retCode = RegSetValueEx(hKey, keyValue, 0, REG_SZ, keyData, strlen(keyData));
  534. if (retCode != ERROR_SUCCESS) {
  535.     Tcl_AppendResult(interp, "unable to set key "", regRoot, "\",
  536.      regPath, "" with value "", keyValue, """,
  537.      (char *) NULL);
  538.     result = TCL_ERROR;
  539. }
  540. RegCloseKey(hKey);
  541.     }
  542.     else {
  543. Tcl_AppendResult(interp, "unable to create key "", regRoot, "\",
  544.  regPath, """, (char *) NULL);
  545. result = TCL_ERROR;
  546.     }
  547.     return (result);
  548. }
  550. /* does everything the normal exit command does, but shows a dialog box if
  551.  * there is an error so that the console does not vaporize */
  552. int WinExit(dummy, interp, argc, argv)
  553.     ClientData dummy; /* Not used. */
  554.     Tcl_Interp *interp; /* Current interpreter. */
  555.     int argc; /* Number of arguments. */
  556.     char **argv;
  557. {
  558.         int value;
  559.         char buffer[100];
  561.         if ((argc != 1) && (argc != 2)) {
  562.                 Tcl_AppendResult(interp, "wrong # args: should be "", argv[0],
  563.                                  " ?returnCode?"", (char *) NULL);
  564.                 return TCL_ERROR;
  565.         }
  566.         if (argc == 1) {
  567.                 value = 0;
  568.         } else if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
  569.                 return TCL_ERROR;
  570.         }
  571.         /* all the error information should be in the console, so just
  572.          * show the message and wait for user input */
  573.         if (value != 0) {
  574.                 ShowMessage(MB_ICONERROR, "Application exiting with error!");
  575.         }
  576.         /* call the usual (renamed) tcl exit command */
  577.         sprintf(buffer, "tcl_exit %d", value);
  578.         Tcl_Eval(interp, buffer);
  580.         /*NOTREACHED*/
  581.         return TCL_OK;
  582. }
  584. static char initScript[]=
  585. "proc init {} {n
  586.     global tcl_library tcl_platform tcl_version tcl_patchLevel env errorInfon
  587.     global tcl_pkgPathn
  588.     rename init {}n
  589.     set errors {}n
  590.     proc tcl_envTraceProc {lo n1 n2 op} {n
  591. global envn
  592. set x $env($n2)n
  593. set env($lo) $xn
  594. set env([string toupper $lo]) $xn
  595.     }n
  596.     foreach p [array names env] {n
  597. set u [string toupper $p]n
  598. if {$u != $p} {n
  599.     switch -- $u {n
  600. COMSPEC -n
  601. PATH {n
  602.     if {![info exists env($u)]} {n
  603. set env($u) $env($p)n
  604.     }n
  605.     trace variable env($p) w [list tcl_envTraceProc $p]n
  606.     trace variable env($u) w [list tcl_envTraceProc $p]n
  607. }n
  608.     }n
  609. }n
  610.     }n
  611.     if {![info exists env(COMSPEC)]} {n
  612. if {$tcl_platform(os) == {Windows NT}} {n
  613.     set env(COMSPEC) cmd.exen
  614. } else {n
  615.     set env(COMSPEC) command.comn
  616. }n
  617.     } n
  618. }n
  619. initn";
  621. int platformInit(Tcl_Interp* interp)
  622. {
  623.         /* tcl.CreateCommand("puts", WinPutsCmd, (ClientData)0); */
  624.         Tcl_CreateCommand(interp, "getusername", WinGetUserName,
  625.                           (ClientData)0, (Tcl_CmdDeleteProc*)0);
  626.         Tcl_CreateCommand(interp, "gethostname", WinGetHostName,
  627.                           (ClientData)0, (Tcl_CmdDeleteProc*)0);
  628.         Tcl_CreateCommand(interp, "putregistry", WinPutRegistry,
  629.                           (ClientData)0, (Tcl_CmdDeleteProc*)0);
  630.         Tcl_CreateCommand(interp, "getregistry", WinGetRegistry,
  631.                           (ClientData)0, (Tcl_CmdDeleteProc*)0);
  632. Tcl_Eval(interp, initScript);
  633. if (TCL_OK==Tcl_Eval(interp, "rename exit tcl_exit")) {
  634.                 Tcl_CreateCommand(interp, "exit", WinExit,
  635.                                   (ClientData)0, (Tcl_CmdDeleteProc*)0);
  636. } else {
  637. fprintf(stderr, "rename of exit proc failed!");
  638. }
  639.         
  640. #if 0
  641.         /*
  642.          * Initialize the console only if we are running as an interactive
  643.          * application.
  644.          */
  645. {
  646. char* interactive;
  647.         if ((interactive=Tcl_GetVar(interp, "tcl_interactive",
  648.     TCL_GLOBAL_ONLY))
  649.     && !strcmp(interactive, "1")) {
  650.                 /*
  651.                  * Create the console channels and install them as the standard
  652.                  * channels.  All I/O will be discarded until TkConsoleInit is
  653.                  * called to attach the console to a text widget.
  654.                  */            
  655.                 TkConsoleCreate();
  656.                 if (TkConsoleInit(interp) == TCL_ERROR) {
  657.                         fprintf(stderr, "error calling TkConsoleInitn");
  658.                 }
  659.         }
  660. }
  661. #endif
  662.         return TCL_OK;
  663. }