es passiert mir schon mal des öfteren, dass sich ein Programm, das ich
gerade mit PB schreibe und im Debugger starte, nicht mehr reagiert oder
sich selbstständig macht. Dann heisst es: Taskmanager aufrufen und
mühsam mein Programm in der langen Liste der laufenden Tasks finden,
um es dann abzuschiessen.
Mit nachfolgendem Code wird's ein wenig einfacher. Hier werden nur die
Prozesse aufgelistet, deren Name mit 'PureBasic' anfangen. Somit können
wildgewordene PB-Programme nun schneller in's digitale Jenseits
geschickt werden.
Nix dolles, aber vielleicht für den einen oder anderen nützlich.
Wichtig: Der Code benötigt die Process-Lib aus dem PBOSL-Paket.
Code: Alles auswählen
; KillPBDebug
;
; This code needs the Process-Library
; from PBOSL (http://pbosl.purearea.net/)
Enumeration
#frmMain
#Processes
#cmdKillProcess
#myTimer
EndEnumeration
Procedure UpdateProcessList()
EndTimer(#myTimer)
SelectedItem = GetGadgetState(#Processes)
ClearGadgetItemList(#Processes)
ProcessCount = ExamineProcesses()
For lCounter = 1 To ProcessCount
NextProcess()
sProcessName.s = GetProcessName()
If FindString(sProcessName, "PureBasic", 1)
If sProcessName <> "PureBasic.exe"
AddGadgetItem(#Processes, -1, sProcessName)
EndIf
EndIf
Next ; lCounter
If SelectedItem > - 1
If SelectedItem > CountGadgetItems(#Processes)
SelectedItem = CountGadgetItems(#Processes)
EndIf
SetGadgetState(#Processes, SelectedItem)
EndIf
StartTimer(#myTimer, 1000, @UpdateProcessList())
EndProcedure
If OpenWindow(#frmMain, 0, 0, 150, 185, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "KillPbDebug")
If CreateGadgetList(WindowID(#frmMain))
ListViewGadget(#Processes, 5, 5, 140, 150)
ButtonGadget(#cmdKillProcess, 5, 160, 140, 20, "&Kill process")
UpdateProcessList()
StartTimer(#myTimer, 1000, @UpdateProcessList())
Repeat
WaitWindowEvent = WaitWindowEvent()
EventGadgetID = EventGadgetID()
Select WaitWindowEvent
Case #PB_Event_Gadget
Select EventGadgetID
Case #cmdKillProcess
PID=GetProcessPID(GetGadgetText(#Processes))
If PID : KillPID(PID,0) : EndIf
EndSelect
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf
EndIf
