pulistなどResourceKitに入っているプロセス一覧の取得などと、だいたい同じことができます。またkillコマンドはtclxにもあります。この拡張はプロセス一覧の取得と強制終了という最低限の部分だけをシンプルに実装したものです。 必要があれば拡張するかなあ・・・。→ したProcess.dll v1.0
ps kill ?pid?
%package require Process %ps {0 {[System Process]}} {8 System} {156 SMSS.EXE} {180 CSRSS.EXE} ... %kill 1988
Process.c
/* Process.c * This program is placed in Public Domain. */ #include <windows.h> #include <Tlhelp32.h> #include <tcl.h> int PsCmd (ClientData data, Tcl_Interp *interp, int argc, char *argv[]) { HANDLE hSnapshot; PROCESSENTRY32 pe32; BOOL result; Tcl_Obj *plist = NULL; hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, NULL); if (hSnapshot == -1) { return TCL_ERROR; } pe32.dwSize = sizeof (PROCESSENTRY32); result = Process32First(hSnapshot, &pe32); plist = Tcl_NewListObj(0, NULL); while (result) { Tcl_Obj *pdata = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, pdata, Tcl_NewIntObj(pe32.th32ProcessID)); /* PID */ Tcl_ListObjAppendElement(interp, pdata, Tcl_NewStringObj(pe32.szExeFile,-1)); /* ExeName */ // Tcl_ListObjAppendElement(interp, pdata, Tcl_NewIntObj(pe32.th32ParentProcessID)); /* Parent PID */ // Tcl_ListObjAppendElement(interp, pdata, Tcl_NewIntObj(pe32.pcPriClassBase)); /* Priority */ Tcl_ListObjAppendElement(interp, plist, pdata); result = Process32Next(hSnapshot, &pe32); } CloseHandle(hSnapshot); Tcl_SetObjResult(interp, plist); return TCL_OK; } int KillCmd (ClientData data, Tcl_Interp *interp, int argc, char *argv[]) { int i; if (argc<=1) return TCL_OK; for (i=1; i<argc; i++){ int pid; HANDLE hProcess; DWORD exitcode; if (Tcl_GetIntFromObj(interp, argv[i], &pid) != TCL_OK) { return TCL_ERROR; } hProcess = OpenProcess(PROCESS_ALL_ACCESS, FALSE, pid); if (hProcess == NULL) continue; GetExitCodeProcess(hProcess, &exitcode); TerminateProcess(hProcess, exitcode); CloseHandle(hProcess); } return TCL_OK; } DLLEXPORT int Process_Init (Tcl_Interp *interp) { #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8", 0) == NULL) { return TCL_ERROR; } #endif Tcl_CreateObjCommand(interp, "ps", PsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "kill", KillCmd, NULL, NULL); if (Tcl_PkgProvide(interp, "Process", "0.1") != TCL_OK) { return TCL_ERROR; } return TCL_OK; }
http://reddog.s35.xrea.com/software/process.zip