Tclでプロセス管理

メニュー

• Tcl/Tk
• Photoshop Plugin
• Gimp Plugin
• Vim

recent(15)

Tclでプロセス一覧を取得&プロセスの強制終了をするための拡張(Windows)†

pulistなどResourceKitに入っているプロセス一覧の取得などと、だいたい同じことができます。またkillコマンドはtclxにもあります。この拡張はプロセス一覧の取得と強制終了という最低限の部分だけをシンプルに実装したものです。 必要があれば拡張するかなあ・・・。→ したProcess.dll v1.0

command list†

ps
kill ?pid? 

Example†

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

Source†

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†

http://reddog.s35.xrea.com/software/process.zip

CategoryTclTk