XProfan

Def @CreateToolhelp32Snapshot(2) !"kernel32","CreateToolhelp32Snapshot"
Def @Process32First(2) !"kernel32","Process32First"
Def @Process32Next(2) !"kernel32","Process32Next"
Def @CloseHandle(1) !"kernel32","CloseHandle"
Def @TerminateProcess(2) !"kernel32","TerminateProcess"
Def @OpenProcess(3) !"kernel32","OpenProcess"
Def &TH32CS_SNAPPROCESS 2
Def &PROCESS_TERMINATE 1
Declare PROCESSENTRY#
Struct PROCESSENTRY32 =dwSize&,cntUsage&,th32ProcessID&,th32DefaultHeapID&,th32ModuleID&,cntThreads&,th32ParentProcessID&,pcPriClassBase&,dwFlags&,szExeFile$(260)

Proc actua

    parameters prozess$, delete%
    declare lenname&
    declare hSnapshot&, Result&, hProcess&, proz_anzahl&, term_ok&
    Dim PROCESSENTRY#, PROCESSENTRY32
    Long PROCESSENTRY#,0 =296
    clear proz_anzahl&, term_ok&
    lenname& = len(prozess$)
    prozess$ = Lower$(prozess$)
    hSnapshot& = CreateToolhelp32Snapshot(&TH32CS_SNAPPROCESS, 0)

    IfNot hSnapshot& = -1

        Result& = Process32First(hSnapshot&, PROCESSENTRY#)
        messagebox(str$(GetLastError()),"Err",48)
        messagebox(str$(Result&),str$(hSnapshot&),48)

        While Result&

            messagebox(Lower$(Right$(PROCESSENTRY#.szExeFile$,lenname&)),"",48)

            if Lower$(Right$(PROCESSENTRY#.szExeFile$,lenname&)) = prozess$

                if delete% = 1

                    hProcess& = @OpenProcess(&PROCESS_TERMINATE, 0, PROCESSENTRY#.th32ProcessID&)
                    sendmessage(hProcess&,$0010,0,0)
                    term_ok& = @TerminateProcess(hProcess&, 0)
                    @CloseHandle(hProcess&)
                    sleep 100

                endif

                proz_anzahl& = proz_anzahl& + (delete%<>1) + term_ok&

            endif

            Result& = Process32Next(hSnapshot&, PROCESSENTRY#)

        EndWhile

    endif

    @CloseHandle(hSnapshot&)
    Dispose PROCESSENTRY#
    return proz_anzahl&

Endproc

@WinEXEC("NotePad.exe",1)
Windowstyle 31
Windowtitle "Prozess überwachen!"

While 0=0

    Window 0,0-640,440
    Sleep 100
    actua "Notepad.exe",0

    IF @&(0)>0

        Drawtext 0,0,"Notepad noch aktiv: "+@str$(@&(0))+"                           "

    Else

        Drawtext 0,0,"Notepad gibts nicht mehr!"+@str$(@&(0))+"                           "

    Endif

wend

DEF CreateProcessA(10)    ! "Kernel32","CreateProcessA"
DEF GetExitCodeProcess(2) ! "Kernel32","GetExitCodeProcess"
DEF TerminateProcess(2)   ! "Kernel32","TerminateProcess"
DEF ZeroMemory(2)         ! "Kernel32","RtlZeroMemory"
DEF CloseHandle(1)        ! "Kernel32","CloseHandle"
Declare lpCommandLine#
Declare lpStartupInfo#
Declare lpProcessInformation#
Declare ExitCode#
Declare Prozess$

Proc CreateProcess

    Parameters CommandLine$
    Declare hProcess&
    Dim lpCommandLine#,Len(CommandLine$)+1
    Dim lpStartupInfo#,68
    ZeroMemory(lpStartupinfo#,68)
    Long lpStartupInfo#,0=68
    Long lpStartupInfo#,44=1 Flag, welche Anteile von Startupinfo berücksichtigt werden sollen
    Word lpStartupInfo#,48=1 SHOWParameter von WinExec
    Dim lpProcessInformation#,16
    ZeroMemory(lpProcessInformation#,16)
    String lpCommandLine#,0=CommandLine$
    CreateProcessA(0,lpCommandLine#,0,0,0,0,0,0,lpStartupInfo#,lpProcessInformation# )
    hProcess&=Long(lpProcessInformation#,0)
    Dispose lpCommandLine#
    Dispose lpStartupInfo#
    Dispose lpProcessInformation#
    Return hProcess&

EndProc

Proc ProcessStatus

    parameters prozid&
    declare status&
    GetExitCodeProcess(prozid&,Exitcode#)
    status& = long(Exitcode#,0)
    return status&

endproc

Declare hProcess&
LET PROZESS$=@LOADFILE$("Datei auswählen","*.EXE")
CASE PROZESS$="" : END
Dim exitcode#,4
createprocess PROZESS$
LET hProcess& = @&(0)
Windowstyle 31+512
WindowTitle "Prozess überwachen"
Window 0,0-640,440

while %MENUITEM<>-2

    Sleep 100
    ProcessStatus hProcess&
    print @&(0)
    print hex$(long(Exitcode#,0))

endwhile