unit taskprogmain;

// test program for Tasks and Windows Unit

// Copyright by Angus Robertson, Magenta Systems Ltd, England
// delphi@magsys.co.uk, https://www.magsys.co.uk/delphi/
// Baseline 29 Aug 2003
// 16 August 2024 updated for modern compilers
// many library functions and types now have Mag prefix
// simplify much of it.


// beware some applications themselves run other applications so can not easily
// stopped, specifically notepad.exe on modern versions of Windows


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, MagTaskWins, ExtCtrls, Spin,
  OverbyteIcsUtils;    // only for IcsBuiltWithEx caption

type
  TMainForm = class(TForm)
    OpenApp: TOpenDialog;
    AutoTimer: TTimer;
    PanelButtons: TPanel;
    Label3: TLabel;
    AppFile: TComboBox;
    doRun: TButton;
    doCheck: TButton;
    doStop: TButton;
    doStopSpec: TButton;
    CloseOpt: TComboBox;
    doSelect: TButton;
    Label4: TLabel;
    doRefresh: TButton;
    doAutoStart: TButton;
    doClose: TButton;
    doStopAuto: TButton;
    RefreshSecs: TSpinEdit;
    PanelLists: TPanel;
    ListWin: TListView;
    ListProc: TListView;
    LabelDelphi: TLabel;
    Log: TMemo;
    procedure doRefreshClick(Sender: TObject);
    procedure doCloseClick(Sender: TObject);
    procedure doSelectClick(Sender: TObject);
    procedure doRunClick(Sender: TObject);
    procedure doStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure doStopSpecClick(Sender: TObject);
    procedure ListProcDblClick(Sender: TObject);
    procedure doCheckClick(Sender: TObject);
    procedure AutoTimerTimer(Sender: TObject);
    procedure doAutoStartClick(Sender: TObject);
    procedure doStopAutoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure IntCloseProg  (PID: DWORD; PHandle: THandle; WHandle: THandle; Option: integer) ;
    procedure AddLog(S: String);
  end;

var
  MainForm: TMainForm;
  WinList: TMagWindowList ;     // could be local to procs
  ProcList: TMagProcessList ;
  ProcessInfo: TProcessInformation ;     // IDs for currently opened application, needed to close it

implementation

{$R *.DFM}

procedure sysDelay (aMs: longword);
var
    TickCount: longword;
begin
    TickCount := GetTickCount ;
    while ((GetTickCount - TickCount) < aMs) do
    begin
         Application.ProcessMessages;
         Sleep(0);
    end ;
end;

procedure TMainForm.AddLog(S: String);
begin
    Log.Lines.Add(S);
end;

procedure TMainForm.doRefreshClick(Sender: TObject);
var
    item, item2: integer ;
    temp: string ;
begin

// get windows and process lists
    doRefresh.Enabled := False;
    try
        WinList := TMagWindowList.Create (self) ;
        ProcList := TMagProcessList.Create (self) ;

// display windows list

        ListWin.Items.BeginUpdate;
        ListWin.Items.Clear;
        for item := 0 to WinList.Count - 1 do
        begin
            with WinList.Windows [item] do
            begin
                with ListWin.Items.Add do
                begin
                    Caption := WinCaption ;
                    SubItems.Add (WinClass) ;
                    SubItems.Add (IntToStr (WinHandle)) ;
                    SubItems.Add (IntToStr (ProcessId)) ;
                    SubItems.Add (IntToStr (ThreadId)) ;
                    if IsVisible then
                        temp := 'Visible'
                    else
                        temp := 'Hidden' ;
                    if IsEnabled then
                        temp :=  temp + ' Enabled'
                    else
                        temp := temp + ' Disabled' ;
                    if IsIconic then
                        temp := temp + ' Minimised'
                    else
                        temp := temp + ' Showing' ;
                    SubItems.Add (temp) ;

                // find EXE from process list
                    for item2 := 0 to ProcList.Count - 1 do
                    begin
                        if ProcList.Process [item2].ProcessId = ProcessId then
                        begin
                            SubItems.Add (ProcList.Process [item2].ExeFile) ;
                            break ;
                        end ;
                    end ;
                end ;
            end ;
        end ;
        ListWin.Items.EndUpdate;

// display process list
        ListProc.Items.BeginUpdate;
        ListProc.Items.Clear;
        if ProcList.Count = 0 then
        begin
            if Win32Platform = VER_PLATFORM_WIN32_NT then
                                AddLog('PSAPI.DLL Missing') ;
            exit ;
        end ;
        for item := 0 to ProcList.Count - 1 do
        begin
            with ProcList.Process [item] do
            begin
                with ListProc.Items.Add do
                begin
                    Caption := ExeFile ;
                    SubItems.Add (IntToStr (ProcessId)) ;
                    SubItems.Add (IntToStr (DefaultHeapId)) ;
                    SubItems.Add (IntToStr (ModuleId)) ;
                    SubItems.Add (IntToStr (CountThreads)) ;
                    SubItems.Add (IntToStr (PriClassBase)) ;
                end ;
            end ;
        end ;
        ListProc.Items.EndUpdate;
    finally
        ProcList.Destroy ;
        WinList.Destroy ;
        doRefresh.Enabled := True;
    end ;
end;

procedure TMainForm.doCloseClick(Sender: TObject);
begin
    Application.Terminate ;
end;

procedure TMainForm.doSelectClick(Sender: TObject);
begin
    OpenApp.Filename := AppFile.Text ;
    if OpenApp.Execute then
    begin
        AppFile.Text := OpenApp.Filename ;
    end ;
end;

procedure TMainForm.doRunClick(Sender: TObject);
var
    progname: string ;
begin
    progname := AppFile.Text ;
    AddLog('') ;
    if MagGetExePID (progname) <> 0 then
        AddLog('Program Already Running')
    else
    begin
        ProcessInfo.dwProcessId := 0 ;
        ProcessInfo := MagStartExe (progname, ExtractFileDir (progname), SW_SHOWNORMAL) ;
        if ProcessInfo.dwProcessId <> 0 then
        begin
            AddLog(progname +', Proc ID=' + IntToStr (ProcessInfo.dwProcessId) +', Thread ID=' + IntToStr (ProcessInfo.dwThreadId) +
                   ', Handle Proc=' + IntToStr (ProcessInfo.hProcess) + ', Handle Thread=' + IntToStr (ProcessInfo.hThread) );
            AddLog('Launched Program OK') ;
        end
        else
            AddLog('Failed to Launch Program') ;
    end ;
end;

procedure TMainForm.IntCloseProg (PID: DWORD; PHandle: THandle; WHandle: THandle; Option: integer) ;
begin
    if NOT MagCheckPID (PID) then   // Aug 2024 simple API
    begin
        AddLog('MagCheckPID, Program Stopped, PID=' + IntToStr(PID)) ;
        Exit;
    end;
    if WHandle = 0 then
    begin
        WHandle := MagGetPIDWin (PID) ;
        if WHandle = 0 then
        begin
            AddLog('MagGetPIDWin, Can Not Find Window Handle from PID') ;
         //   Exit;
        end;
    end;
    AddLog('Stopping program, PID=' + IntToStr(PID) + ', PHandle=' + IntToStr(PHandle) + ', WHandle=' + IntToStr(WHandle));

    case Option of
        0 : begin
                if WHandle = 0 then Exit;
                AddLog('PostMessage WM_Close') ;
                PostMessage (WHandle, WM_CLOSE, 0, 0) ;    // THIS IS USED IN DUN MAN
        end;
        1 : begin
                if WHandle = 0 then Exit;
                AddLog('PostMessage WM_EndSession') ;
                PostMessage (WHandle, WM_ENDSESSION, 0, 0) ;
         end;
        2 : begin
                if WHandle = 0 then Exit;
                AddLog('Query/PostMessage WM_EndSession') ;
                 if SendMessage (WHandle, WM_QUERYENDSESSION, 0, 0) = 0 then
                             PostMessage (WHandle, WM_ENDSESSION, 0, 0) ;
        end ;
        3 : begin
                if WHandle = 0 then Exit;
                AddLog('PostMessage WM_SysCommand Close') ;
                PostMessage (WHandle, WM_SYSCOMMAND, SC_CLOSE, 0) ;
        end;
        4 : begin       // close message to all windows
                AddLog('WM_Close to Each Windows by PID') ;
                if MagCloseExeEx (PID, WM_CLOSE) then
                    AddLog('Sent at Leasr WM_Close Message')
                else
                    AddLog('No Windows Found') ;
        end ;
        5 : begin
                AddLog('WM_EndSession to Each Windows by PID') ;
                if MagCloseExeEx (PID, WM_ENDSESSION) then
                        AddLog('Sent at Leasr WM_EndSession Message')
                    else
                        AddLog('No Windows Found') ;
        end ;
        6 : begin
                if WHandle = 0 then Exit;
                AddLog('Post Message WM_Quit') ;
                PostMessage (WHandle, WM_QUIT, 0, 0) ;
        end;
        7 : begin
                if PHandle = 0 then Exit;
                AddLog('MagTermPHandle, Terminating Process by Handle') ;
                MagTermPHandle (PHandle, 99) ;   // 99 = exit code
        end;
        8 : begin
                AddLog('MagTermPID, Terminating Process by PID') ;
                MagTermPID (PID, 99) ;   // 99 = exit code
        end;
        9 : begin
                AddLog('MagCloseExe, Terminating Process by PID') ;
                MagCloseExe (PID) ;      // proper WM_CLOSE
        end;
    end ;
end ;


procedure TMainForm.doStopClick(Sender: TObject);
var
    count, mode: integer ;
begin
    if ProcessInfo.dwProcessId = 0 then
       Exit;
    Mode := 4;  // start with close to all windows
    count := 0;
    while true do
    begin
        if NOT MagCheckPID (ProcessInfo.dwProcessId) then   // Aug 2024 simple API
        begin
            AddLog('MagCheckPID, Program Not Running') ;
            ProcessInfo.dwProcessId := 0;
            exit ;
        end ;
        IntCloseProg (ProcessInfo.dwProcessId, 0, 0, Mode);
        AddLog('Waiting for Program to Stop') ;
        inc (count) ;
        if count = 10 then mode := 6 ;  // 500 ms  Quit message
        if count = 15 then mode := 8 ;  // 750 ms  Terminate process
        if count > 30 then
        begin
            AddLog('May Have Failed to Close Program') ;
            exit ;
        end ;
        sysDelay (50) ;  // 50ms delay
    end ;
end;

procedure TMainForm.doStopSpecClick(Sender: TObject);
begin
    if ProcessInfo.dwProcessId = 0 then
       Exit;
    if NOT MagCheckPID (ProcessInfo.dwProcessId) then   // Aug 2024 simple API
    begin
        AddLog('MagCheckIDs, Program Not Running') ;
        ProcessInfo.dwProcessId := 0;
        exit ;
    end ;
    AddLog('Closing Program, PID=' + IntToStr (ProcessInfo.dwProcessId));
    IntCloseProg (ProcessInfo.dwProcessId, ProcessInfo.hProcess, 0, CloseOpt.ItemIndex) ;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    CloseOpt.ItemIndex := 0 ;
    LabelDelphi.caption :=  IcsBuiltWithEx;
end;

procedure TMainForm.ListProcDblClick(Sender: TObject);
var
    item: integer ;
begin
    if ListProc.SelCount = 0 then
    begin
        AddLog('Must Select a Process First') ;
        beep ;
        exit ;
    end ;
    item := ListProc.Selected.Index ;
    AddLog('Program Description: ' + MagGetExeDesc (ListProc.Items [item].Caption)) ;
end;

procedure TMainForm.doCheckClick(Sender: TObject);
begin
    if ProcessInfo.dwProcessId = 0 then
       Exit;
    if MagCheckPID (ProcessInfo.dwProcessId) then   // Aug 2024 simple API
        AddLog('MagCheckIDs, Program Still Running')
    else begin
        AddLog('MagCheckIDs, Program Stopped') ;
        ProcessInfo.dwProcessId := 0;
    end;
end;

procedure TMainForm.AutoTimerTimer(Sender: TObject);
begin
    doRefreshClick (self) ;
end;

procedure TMainForm.doAutoStartClick(Sender: TObject);
begin
    if RefreshSecs.Value = 0 then exit ;
    AutoTimer.Interval := RefreshSecs.Value * 1000 ;
    doStopAuto.Enabled := true ;
    doAutoStart.Enabled := false ;
    doRefresh.Enabled := false ;
    doRefreshClick (self) ;
    AutoTimer.Enabled := true ;
end;

procedure TMainForm.doStopAutoClick(Sender: TObject);
begin
    doStopAuto.Enabled := false ;
    doAutoStart.Enabled := true ;
    doRefresh.Enabled := true ;
    AutoTimer.Enabled := false ;
end;

end.