Diff of Tclでプロセス管理

The added line is THIS COLOR.
The deleted line is THIS COLOR.
Go to Tclでプロセス管理.
Deleting diff of Tclでプロセス管理
*** Tclでプロセス一覧を取得&プロセスの強制終了をするための拡張(Windows) [#idd17730]
pulistなどResourceKitに入っているプロセス一覧の取得などと、だいたい同じことができます。またkillコマンドはtclxにもあります。この拡張はプロセス一覧の取得と強制終了という最低限の部分だけをシンプルに実装したものです。
必要があれば拡張するかなあ・・・。→[[Process.dll]]
必要があれば拡張するかなあ・・・。→ した[[Process.dll]] v1.0

*** command list [#lb43f965]
 ps
 kill ?pid? 

***Example [#u479722c]
 %package require Process
 %ps
 {0 {[System Process]}} {8 System} {156 SMSS.EXE} {180 CSRSS.EXE} ...
 %kill 1988

*** Source [#e4bd28a8]
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;
 }

*** Binary [#l7751f2f]
http://reddog.s35.xrea.com/software/process.zip
----
[[CategoryTclTk]]