Загадочный CmdBox

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Загадочный CmdBox

Сообщение Alex2013 » 22.03.2023 02:15:37

Задача: найти что-то вроде эмулятора терминала ( запускаю консольный ffmpeg для сборки фильмов из m3u8 плейлистов и хочется сделать это красивее чем просто перенаправление консольного вывода в мемо )
Изображение
1 Поиски
Вроде что-то пожее есть в Indy (увы не нашел ) дальше нашёл что-то вроде emulVT но там с портированием под лазарус все сложно . Наконец добрался до CmdBox он есть в двух вариантах первый в пакете cmdLine (есть в сетевом меджере пактов в Лазарусе) второй из репозитория doublecmd (особой разницы не заметил) .
2 Работа
Пример работает, однако, просто "вставить контрол в форму" не получается ( что не то с шрифтами ) но подключить форму примера целиком все-же получилось Но увы оказалось что нет простейшей реакции на возврат каретки. ( без перевода строки )

Вопрос: что еще подобного есть в Сети и как бороться с со странностями вывода ( разумеется, можно просто "выпотрошить пример" оставив только нужное . Но как это уродливо ! :idea: ) ?

Зы
Еще вопрос: как надежно прибить процесс запущенный через CreateProcess ? ( "захваченная" консоль закрывается без проблем, но процес с "убитым хембелом" все равно висит в памяти )

Добавлено спустя 18 часов 34 минуты 53 секунды:

Вообщем " Искали в наперстках — и здравых умах; Гонялись с надеждой и вилкой; "(С)Л. Кэрол
Продолжение истории..

Вариант первый "Убить дракона по имени "
Код: Выделить всё
function KillTask(ExeFileName:String):integer;
  const Process_Terminate=$0001;
  var ContinueLoop:BOOL;
      FSnapShotHandle:THandle;
      FProcessEntry32:TProcessEntry32;
begin
result:=0;
FSnapShotHandle:=CreateToolHelp32SnapShot(TH32CS_SnapProcess,0);
FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);
continueLoop:=Process32First(FSnapShotHandle,FProcessEntry32);
while integer(continueloop)<>0 do
  begin
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))= UpperCase(ExeFileName))
    or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
     Result:=Integer(TerminateProcess(OpenProcess(Process_TERMINATE,bool(0),
      FProcessEntry32.th32ProcessID),0));
     ContinueLoop:=Process32Next(FSnapShotHandle,FProcessEntry32);
     end;
     CloseHandle(FSnapShotHandle);
     end;

Идея хороша но по идее может быть несколько конверсий одновременно и вообще это винда ( до кроссплатформенность еще добраться нужно ) и гарантии что там не будет еще одного процесса с именем "ffmpeg.exe" нет никаких .

Так что применяем "план Б ".
Большая "бензопила" KillProcessTree рубит дерево процессов под корень
(Решение неидеально ( По идее могут быть и "беспризорные процессы" ) но в моем случае (CMD /c + ffmpeg ) работает )

//Используйте следующую функцию, передав PI.dwProcessIdее ( Pi: TProcessInformation )из вашего кода в
//качестве параметра PID.

Код: Выделить всё
function KillProcessTree(const PID: Cardinal): boolean;
var hProc, hSnap,
    hChildProc  : THandle;
    pe          : TProcessEntry32;
    bCont       : BOOL;
begin
    Result := true;
    FillChar(pe, SizeOf(pe), #0);
    pe.dwSize := SizeOf(pe);

    hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

    if (hSnap <> INVALID_HANDLE_VALUE) then
    begin
        if (Process32First(hSnap, pe)) then
        begin
            hProc := OpenProcess(PROCESS_ALL_ACCESS, false, PID);

            if (hProc <> 0) then
            begin
                Result := Result and TerminateProcess(hProc, 1);
                WaitForSingleObject(hProc, INFINITE);
                CloseHandle(hProc);
            end;

            bCont := true;
            while bCont do
            begin
                if (pe.th32ParentProcessID = PID) then
                begin
                    KillProcessTree(pe.th32ProcessID);

                    hChildProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, pe.th32ProcessID);

                    if (hChildProc <> 0) then
                    begin
                        Result := Result and TerminateProcess(hChildProc, 1);
                        WaitForSingleObject(hChildProc, INFINITE);
                        CloseHandle(hChildProc);
                    end;
                end;
                bCont := Process32Next(hSnap, pe);
            end;
        end;

        CloseHandle(hSnap);
    end;
end;



Но разумеется все это просто так не заработало ...
Для этого нужен остро дефицитный модуль TlHelp32
В лазарусе он есть только версии для WinCe
B требует ужасно древнюю TOOLHELP.DLL ( и ныне не совместимую с нормальной виндой)
Но все-же нашел версию TlHelp32.pas которая обходится без нее.
Код: Выделить всё
{ *********************************************************************** }
{                                                                         }
{ Delphi Runtime Library                                                  }
{                                                                         }
{ Copyright (c) 1996-2001 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

{*******************************************************}
{       Tool Help Functions, Types, and Definitions     }
{*******************************************************}

unit TlHelp32;

{$MODE Delphi}

{$WEAKPACKAGEUNIT}

interface

uses Windows;

{$HPPEMIT '#include <tlhelp32.h>'}

const
{$EXTERNALSYM MAX_MODULE_NAME32}
  MAX_MODULE_NAME32 = 255;

(****** Shapshot function **********************************************)

{$EXTERNALSYM CreateToolhelp32Snapshot}
function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle;

type
  TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle stdcall;
//
// The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or
// TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current
// process.
//
// NOTE that all of the snapshots are global except for the heap and module
//  lists which are process specific. To enumerate the heap or module
//  state for all WIN32 processes call with TH32CS_SNAPALL and the
//  current process. Then for each process in the TH32CS_SNAPPROCESS
//  list that isn't the current process, do a call with just
//  TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE.
//
// dwFlags
//
const
{$EXTERNALSYM TH32CS_SNAPHEAPLIST}
  TH32CS_SNAPHEAPLIST = $00000001;
{$EXTERNALSYM TH32CS_SNAPPROCESS}
  TH32CS_SNAPPROCESS  = $00000002;
{$EXTERNALSYM TH32CS_SNAPTHREAD}
  TH32CS_SNAPTHREAD   = $00000004;
{$EXTERNALSYM TH32CS_SNAPMODULE}
  TH32CS_SNAPMODULE   = $00000008;
{$EXTERNALSYM TH32CS_SNAPALL}
  TH32CS_SNAPALL      = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or
    TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
{$EXTERNALSYM TH32CS_INHERIT}
  TH32CS_INHERIT      = $80000000;
//
// Use CloseHandle to destroy the snapshot
//

(****** heap walking ***************************************************)

type
{$EXTERNALSYM tagHEAPLIST32}
  tagHEAPLIST32 = record
    dwSize: DWORD;
    th32ProcessID: DWORD;  // owning process
    th32HeapID: DWORD;     // heap (in owning process's context!)
    dwFlags: DWORD;
  end;
{$EXTERNALSYM HEAPLIST32}
  HEAPLIST32 = tagHEAPLIST32;
{$EXTERNALSYM PHEAPLIST32}
  PHEAPLIST32 = ^tagHEAPLIST32;
{$EXTERNALSYM LPHEAPLIST32}
  LPHEAPLIST32 = ^tagHEAPLIST32;
  THeapList32 = tagHEAPLIST32;
//
// dwFlags
//
const
{$EXTERNALSYM HF32_DEFAULT}
  HF32_DEFAULT = 1;  // process's default heap
{$EXTERNALSYM HF32_SHARED}
  HF32_SHARED  = 2;  // is shared heap

{$EXTERNALSYM Heap32ListFirst}
function Heap32ListFirst(hSnapshot: THandle; var lphl: THeapList32): BOOL;
{$EXTERNALSYM Heap32ListNext}
function Heap32ListNext(hSnapshot: THandle; var lphl: THeapList32): BOOL;

type
  THeap32ListFirst = function (hSnapshot: THandle; var lphl: THeapList32): BOOL stdcall;
  THeap32ListNext = function (hSnapshot: THandle; var lphl: THeapList32): BOOL stdcall;

type
{$EXTERNALSYM tagHEAPENTRY32}
  tagHEAPENTRY32 = record
    dwSize: DWORD;
    hHandle: THandle;     // Handle of this heap block
    dwAddress: DWORD;     // Linear address of start of block
    dwBlockSize: DWORD;   // Size of block in bytes
    dwFlags: DWORD;
    dwLockCount: DWORD;
    dwResvd: DWORD;
    th32ProcessID: DWORD; // owning process
    th32HeapID: DWORD;    // heap block is in
  end;
{$EXTERNALSYM HEAPENTRY32}
  HEAPENTRY32 = tagHEAPENTRY32;
{$EXTERNALSYM PHEAPENTRY32}
  PHEAPENTRY32 = ^tagHEAPENTRY32;
{$EXTERNALSYM LPHEAPENTRY32}
  LPHEAPENTRY32 = ^tagHEAPENTRY32;
  THeapEntry32 = tagHEAPENTRY32;
//
// dwFlags
//
const
{$EXTERNALSYM LF32_FIXED}
  LF32_FIXED    = $00000001;
{$EXTERNALSYM LF32_FREE}
  LF32_FREE     = $00000002;
{$EXTERNALSYM LF32_MOVEABLE}
  LF32_MOVEABLE = $00000004;

{$EXTERNALSYM Heap32First}
function Heap32First(var lphe: THeapEntry32; th32ProcessID, th32HeapID: DWORD): BOOL;
{$EXTERNALSYM Heap32Next}
function Heap32Next(var lphe: THeapEntry32): BOOL;
{$EXTERNALSYM Toolhelp32ReadProcessMemory}
function Toolhelp32ReadProcessMemory(th32ProcessID: DWORD; lpBaseAddress: Pointer;
  var lpBuffer; cbRead: DWORD; var lpNumberOfBytesRead: DWORD): BOOL;

type
  THeap32First = function (var lphe: THeapEntry32; th32ProcessID,
    th32HeapID: DWORD): BOOL stdcall;
  THeap32Next = function (var lphe: THeapEntry32): BOOL stdcall;
  TToolhelp32ReadProcessMemory = function (th32ProcessID: DWORD;
    lpBaseAddress: Pointer; var lpBuffer; cbRead: DWORD;
    var lpNumberOfBytesRead: DWORD): BOOL stdcall;

(***** Process walking *************************************************)

type
{$EXTERNALSYM tagPROCESSENTRY32W}
  tagPROCESSENTRY32W = packed record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;       // this process
    th32DefaultHeapID: DWORD;
    th32ModuleID: DWORD;        // associated exe
    cntThreads: DWORD;
    th32ParentProcessID: DWORD; // this process's parent process
    pcPriClassBase: Longint;    // Base priority of process's threads
    dwFlags: DWORD;
    szExeFile: array[0..MAX_PATH - 1] of WChar;// Path
  end;
{$EXTERNALSYM PROCESSENTRY32W}
  PROCESSENTRY32W = tagPROCESSENTRY32W;
{$EXTERNALSYM PPROCESSENTRY32W}
  PPROCESSENTRY32W = ^tagPROCESSENTRY32W;
{$EXTERNALSYM LPPROCESSENTRY32W}
  LPPROCESSENTRY32W = ^tagPROCESSENTRY32W;
  TProcessEntry32W = tagPROCESSENTRY32W;

{$EXTERNALSYM Process32FirstW}
function Process32FirstW(hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL;
{$EXTERNALSYM Process32NextW}
function Process32NextW(hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL;

type
  TProcess32FirstW = function (hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL stdcall;
  TProcess32NextW = function (hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL stdcall;

{$EXTERNALSYM tagPROCESSENTRY32}
  tagPROCESSENTRY32 = packed record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;       // this process
    th32DefaultHeapID: DWORD;
    th32ModuleID: DWORD;        // associated exe
    cntThreads: DWORD;
    th32ParentProcessID: DWORD; // this process's parent process
    pcPriClassBase: Longint;    // Base priority of process's threads
    dwFlags: DWORD;
    szExeFile: array[0..MAX_PATH - 1] of Char;// Path
  end;
{$EXTERNALSYM PROCESSENTRY32}
  PROCESSENTRY32 = tagPROCESSENTRY32;
{$EXTERNALSYM PPROCESSENTRY32}
  PPROCESSENTRY32 = ^tagPROCESSENTRY32;
{$EXTERNALSYM LPPROCESSENTRY32}
  LPPROCESSENTRY32 = ^tagPROCESSENTRY32;
  TProcessEntry32 = tagPROCESSENTRY32;

{$EXTERNALSYM Process32First}
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
{$EXTERNALSYM Process32Next}
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;

type
  TProcess32First = function (hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;
  TProcess32Next = function (hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;

(***** Thread walking **************************************************)

type
{$EXTERNALSYM tagTHREADENTRY32}
  tagTHREADENTRY32 = record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ThreadID: DWORD;       // this thread
    th32OwnerProcessID: DWORD; // Process this thread is associated with
    tpBasePri: Longint;
    tpDeltaPri: Longint;
    dwFlags: DWORD;
  end;
{$EXTERNALSYM THREADENTRY32}
  THREADENTRY32 = tagTHREADENTRY32;
{$EXTERNALSYM PTHREADENTRY32}
  PTHREADENTRY32 = ^tagTHREADENTRY32;
{$EXTERNALSYM LPTHREADENTRY32}
  LPTHREADENTRY32 = ^tagTHREADENTRY32;
  TThreadEntry32 = tagTHREADENTRY32;

{$EXTERNALSYM Thread32First}
function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; stdcall;
{$EXTERNALSYM Thread32Next}
function Thread32Next(hSnapshot: THandle; var lpte: TThreadENtry32): BOOL; stdcall;

type
  TThread32First = function (hSnapshot: THandle; var lpte: TThreadEntry32): BOOL stdcall;
  TThread32Next = function (hSnapshot: THandle; var lpte: TThreadENtry32): BOOL stdcall;

(***** Module walking *************************************************)

type
{$EXTERNALSYM tagMODULEENTRY32}
  tagMODULEENTRY32 = record
    dwSize: DWORD;
    th32ModuleID: DWORD;  // This module
    th32ProcessID: DWORD; // owning process
    GlblcntUsage: DWORD;  // Global usage count on the module
    ProccntUsage: DWORD;  // Module usage count in th32ProcessID's context
    modBaseAddr: PBYTE;   // Base address of module in th32ProcessID's context
    modBaseSize: DWORD;   // Size in bytes of module starting at modBaseAddr
    hModule: HMODULE;     // The hModule of this module in th32ProcessID's context
    szModule: array[0..MAX_MODULE_NAME32] of Char;
    szExePath: array[0..MAX_PATH - 1] of Char;
  end;
{$EXTERNALSYM MODULEENTRY32}
  MODULEENTRY32 = tagMODULEENTRY32;
{$EXTERNALSYM PMODULEENTRY32}
  PMODULEENTRY32 = ^tagMODULEENTRY32;
{$EXTERNALSYM LPMODULEENTRY32}
  LPMODULEENTRY32 = ^tagMODULEENTRY32;
  TModuleEntry32 = tagMODULEENTRY32;

//
// NOTE CAREFULLY that the modBaseAddr and hModule fields are valid ONLY
// in th32ProcessID's process context.
//

{$EXTERNALSYM Module32First}
function Module32First(hSnapshot: THandle; var lpme: TModuleEntry32): BOOL;
{$EXTERNALSYM Module32Next}
function Module32Next(hSnapshot: THandle; var lpme: TModuleEntry32): BOOL;

type
  TModule32First = function (hSnapshot: THandle; var lpme: TModuleEntry32): BOOL stdcall;
  TModule32Next = function (hSnapshot: THandle; var lpme: TModuleEntry32): BOOL stdcall;

{$EXTERNALSYM tagMODULEENTRY32W}
  tagMODULEENTRY32W = record
    dwSize: DWORD;
    th32ModuleID: DWORD;  // This module
    th32ProcessID: DWORD; // owning process
    GlblcntUsage: DWORD;  // Global usage count on the module
    ProccntUsage: DWORD;  // Module usage count in th32ProcessID's context
    modBaseAddr: PBYTE;   // Base address of module in th32ProcessID's context
    modBaseSize: DWORD;   // Size in bytes of module starting at modBaseAddr
    hModule: HMODULE;     // The hModule of this module in th32ProcessID's context
    szModule: array[0..MAX_MODULE_NAME32] of WChar;
    szExePath: array[0..MAX_PATH - 1] of WChar;
  end;
{$EXTERNALSYM MODULEENTRY32}
  MODULEENTRY32W = tagMODULEENTRY32W;
{$EXTERNALSYM PMODULEENTRY32}
  PMODULEENTRY32W = ^tagMODULEENTRY32W;
{$EXTERNALSYM LPMODULEENTRY32}
  LPMODULEENTRY32W = ^tagMODULEENTRY32W;
  TModuleEntry32W = tagMODULEENTRY32W;

//
// NOTE CAREFULLY that the modBaseAddr and hModule fields are valid ONLY
// in th32ProcessID's process context.
//

{$EXTERNALSYM Module32FirstW}
function Module32FirstW(hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL;
{$EXTERNALSYM Module32NextW}
function Module32NextW(hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL;

type
  TModule32FirstW = function (hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL stdcall;
  TModule32NextW = function (hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL stdcall;

implementation

const
  kernel32 = 'kernel32.dll';

var
  KernelHandle: THandle;
  _CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot;
  _Heap32ListFirst: THeap32ListFirst;
  _Heap32ListNext: THeap32ListNext;
  _Heap32First: THeap32First;
  _Heap32Next: THeap32Next;
  _Toolhelp32ReadProcessMemory: TToolhelp32ReadProcessMemory;
  _Process32First: TProcess32First;
  _Process32Next: TProcess32Next;
  _Process32FirstW: TProcess32FirstW;
  _Process32NextW: TProcess32NextW;
  _Thread32First: TThread32First;
  _Thread32Next: TThread32Next;
  _Module32First: TModule32First;
  _Module32Next: TModule32Next;
  _Module32FirstW: TModule32FirstW;
  _Module32NextW: TModule32NextW;

function InitToolHelp: Boolean;
begin
  if KernelHandle = 0 then
  begin
    KernelHandle := GetModuleHandle(kernel32);
    if KernelHandle <> 0 then
    begin
      @_CreateToolhelp32Snapshot := GetProcAddress(KernelHandle, 'CreateToolhelp32Snapshot');
      @_Heap32ListFirst := GetProcAddress(KernelHandle, 'Heap32ListFirst');
      @_Heap32ListNext := GetProcAddress(KernelHandle, 'Heap32ListNext');
      @_Heap32First := GetProcAddress(KernelHandle, 'Heap32First');
      @_Heap32Next := GetProcAddress(KernelHandle, 'Heap32Next');
      @_Toolhelp32ReadProcessMemory := GetProcAddress(KernelHandle, 'Toolhelp32ReadProcessMemory');
      @_Process32First := GetProcAddress(KernelHandle, 'Process32First');
      @_Process32Next := GetProcAddress(KernelHandle, 'Process32Next');
      @_Process32FirstW := GetProcAddress(KernelHandle, 'Process32FirstW');
      @_Process32NextW := GetProcAddress(KernelHandle, 'Process32NextW');
      @_Thread32First := GetProcAddress(KernelHandle, 'Thread32First');
      @_Thread32Next := GetProcAddress(KernelHandle, 'Thread32Next');
      @_Module32First := GetProcAddress(KernelHandle, 'Module32First');
      @_Module32Next := GetProcAddress(KernelHandle, 'Module32Next');
      @_Module32FirstW := GetProcAddress(KernelHandle, 'Module32FirstW');
      @_Module32NextW := GetProcAddress(KernelHandle, 'Module32NextW');
    end;
  end;
  Result := (KernelHandle <> 0) and Assigned(_CreateToolhelp32Snapshot);
end;

function CreateToolhelp32Snapshot;
begin
  if InitToolHelp then
    Result := _CreateToolhelp32Snapshot(dwFlags, th32ProcessID)
  else Result := 0;
end;

function Heap32ListFirst;
begin
  if InitToolHelp then
    Result := _Heap32ListFirst(hSnapshot, lphl)
  else Result := False;
end;

function Heap32ListNext;
begin
  if InitToolHelp then
    Result := _Heap32ListNext(hSnapshot, lphl)
  else Result := False;
end;

function Heap32First;
begin
  if InitToolHelp then
    Result := _Heap32First(lphe, th32ProcessID, th32HeapID)
  else Result := False;
end;

function Heap32Next;
begin
  if InitToolHelp then
    Result := _Heap32Next(lphe)
  else Result := False;
end;

function Toolhelp32ReadProcessMemory;
begin
  if InitToolHelp then
    Result := _Toolhelp32ReadProcessMemory(th32ProcessID, lpBaseAddress,
      lpBuffer, cbRead, lpNumberOfBytesRead)
  else Result := False;
end;

function Process32First;
begin
  if InitToolHelp then
    Result := _Process32First(hSnapshot, lppe)
  else Result := False;
end;

function Process32Next;
begin
  if InitToolHelp then
    Result := _Process32Next(hSnapshot, lppe)
  else Result := False;
end;

function Process32FirstW;
begin
  if InitToolHelp then
    Result := _Process32FirstW(hSnapshot, lppe)
  else Result := False;
end;

function Process32NextW;
begin
  if InitToolHelp then
    Result := _Process32NextW(hSnapshot, lppe)
  else Result := False;
end;

function Thread32First;
begin
  if InitToolHelp then
    Result := _Thread32First(hSnapshot, lpte)
  else Result := False;
end;

function Thread32Next;
begin
  if InitToolHelp then
    Result := _Thread32Next(hSnapshot, lpte)
  else Result := False;
end;

function Module32First;
begin
  if InitToolHelp then
    Result := _Module32First(hSnapshot, lpme)
  else Result := False;
end;

function Module32Next;
begin
  if InitToolHelp then
    Result := _Module32Next(hSnapshot, lpme)
  else Result := False;
end;

function Module32FirstW;
begin
  if InitToolHelp then
    Result := _Module32FirstW(hSnapshot, lpme)
  else Result := False;
end;

function Module32NextW;
begin
  if InitToolHelp then
    Result := _Module32NextW(hSnapshot, lpme)
  else Result := False;
end;

end.



Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44

Re: Загадочный CmdBox

Сообщение delphius » 24.03.2023 01:47:57

Поработав 10 минут с другом из OpenAI, получил рабочий кроссплатформенный код (проверял только на win x64)
Код: Выделить всё
program killprocess;
{$IFDEF MSWINDOWS}
uses
  Windows, SysUtils, TlHelp32;
{$ENDIF}

{$IFDEF UNIX}
uses
  BaseUnix;
{$ENDIF}

function KillProcessesByName(const ProcessName: string): boolean;
var
  ProcessID: DWORD; // используем DWORD в Windows и LongInt в Unix
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := False;

  {$IFDEF MSWINDOWS}
  // Windows implementation
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    if (UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ProcessName)) then
    begin
      ProcessID := OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID);
      TerminateProcess(ProcessID, 0);
      CloseHandle(ProcessID);
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
  {$ENDIF}

  {$IFDEF UNIX}
  // Unix implementation
  var ProcDir: TDir;
  var ProcFile: TSearchRec;
  var ProcPid: LongInt;
  var PidFile: TextFile;
  ProcDir := fpopendir('/proc');
  if ProcDir <> nil then
  begin
    while True do
    begin
      if fpReaddir(ProcDir, @ProcFile) <> 0 then Break;
      if ProcFile.Name = '.' then Continue;
      if ProcFile.Name = '..' then Continue;
      if not TryStrToInt(ProcFile.Name, ProcPid) then Continue;
      if not FileExists('/proc/' + ProcFile.Name + '/comm') then Continue;
      AssignFile(PidFile, '/proc/' + ProcFile.Name + '/comm');
      Reset(PidFile);
      var CmdLine: string;
      ReadLn(PidFile, CmdLine);
      CloseFile(PidFile);
      if ExtractFileName(CmdLine) = ProcessName then
      begin
        ProcessID := DWORD(ProcPid);
        fpkill(ProcessID, SIGTERM);
        Result := True;
      end;
    end;
    fpclosedir(ProcDir);
  end;
  {$ENDIF}
end;

begin
  if KillProcessesByName('browser.exe') then writeln('kill done.')
end.


Этот же друг написал такую версию tlhelp32.pas
Код: Выделить всё
unit tlhelp32;

interface

uses
  Windows;

const
  MAX_MODULE_NAME32 = 255;
  TH32CS_SNAPHEAPLIST = $00000001;
  TH32CS_SNAPPROCESS = $00000002;
  TH32CS_SNAPTHREAD = $00000004;
  TH32CS_SNAPMODULE = $00000008;
  TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
  TH32CS_INHERIT = $80000000;
  PROCESSENTRY32_SIZE = 568; // размер структуры TProcessEntry32 в байтах

type
  PProcessEntry32 = ^TProcessEntry32;
  TProcessEntry32 = record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;          // pid процесса
    th32DefaultHeapID: ULONG_PTR;
    th32ModuleID: DWORD;           // не используется
    cntThreads: DWORD;             // количество потоков в процессе
    th32ParentProcessID: DWORD;    // pid родительского процесса
    pcPriClassBase: Longint;       // не используется
    dwFlags: DWORD;
    szExeFile: array[0..MAX_MODULE_NAME32] of Char; // полный путь и имя исполняемого файла
  end;

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; stdcall;
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall;
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall;

implementation

const
  kernel32 = 'kernel32.dll';

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; stdcall; external kernel32 name 'CreateToolhelp32Snapshot';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall; external kernel32 name 'Process32First';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall; external kernel32 name 'Process32Next';

end.
delphius
постоялец
 
Сообщения: 122
Зарегистрирован: 18.03.2020 13:40:11

Re: Загадочный CmdBox

Сообщение Alex2013 » 25.03.2023 14:43:42

delphius писал(а):Этот же друг написал такую версию tlhelp32.pas

Ух ты ! "Краткость сестра таланта !" :wink:
.. {$IFDEF UNIX}..
Вау ! Спасибо пригодится .
Зы

А отловить нормальное завершение ffmpeg оказалось очень просто .
В конце работы он пишет что-то вроде этого
Код: Выделить всё
video:1044514kB audio:59990kB subtitle:0kB other streams:0kB global headers:0kB muxing overhead: 0.495326%

так что банальный парсинг вывода "все починил". (Тем более что вывод все равно нужно парсить для получения данных для полосы прогресса )
Alex2013
долгожитель
 
Сообщения: 2922
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 7

Рейтинг@Mail.ru