Вверх ↑
Этот топик читают: Гость
Ответов: 45
Рейтинг: 0
#1: 2021-05-01 18:16:11 ЛС | профиль | цитата
И так. Можно как то реализовать замораживания процесса на 10 секунд.
Может есть какое-то решение, ну или компонент для этого ?
карма: 0
всё что мешает нам жить это человеческий фактор который не имеющий границы ..
0
vip
#1.1контекстная реклама от партнеров
Ответов: 167
Рейтинг: 7
#2: 2021-05-02 22:42:45 ЛС | профиль | цитата
В пакете Delphi наврятли есть такой элемент... Но вы можете скачать эту и запускать её с параметрами из под хи. Документация прилагается. Элемент, который нужен для запуска на скрине ниже
Снимок экрана_2021-05-02_22-17-47.png
карма: 0
c, c++, lua
0
Ответов: 1341
Рейтинг: 31
#3: 2021-05-03 03:23:34 ЛС | профиль | цитата
Можно, для примера использование IC:

Add(MainForm,2953706,161,84)
{
}
Add(InlineCode,3935702,238,126)
{
@Color=16777130
WorkPoints=#7:doPause|8:doResume|
DataPoints=#9:ProcessId|
Code=#15:unit HiAsmUnit;|0:|9:interface|0:|29:uses Windows,kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10: private|0:|9: public|26: ProcessId: THI_Event;|52: procedure doPause(var _Data:TData; Index:word);|53: procedure doResume(var _Data:TData; Index:word);|5: end;|0:|0:|14:implementation|0:|5:const|22: NTDLL = 'ntdll.dll';|33: PROCESS_SUSPEND_RESUME = $0800;|26: SE_DEBUG_PRIVILEGE = 20;|1: |74:function NtSuspendProcess(pid: THandle): HRESULT; stdcall; external NTDLL;|73:function NtResumeProcess(pid: THandle): HRESULT; stdcall; external NTDLL;|80:function RtlAdjustPrivilege(Privilege: ULONG; Enable: BOOL; CurrentThread: BOOL;|58: out OldPrivilege: BOOL): ULONG; stdcall; external NTDLL;|1: |46:procedure Pause(Flag: Boolean; PID: Cardinal);|3:var|20: hProcess: THandle;|5:begin|62: hProcess := OpenProcess(PROCESS_SUSPEND_RESUME, False, PID);|5: try|16: if Flag then|32: NtSuspendProcess(hProcess)|8: else|32: NtResumeProcess(hProcess);|9: finally|26: CloseHandle(hProcess);|6: end;|4:end;|0:|30:procedure THiAsmClass.doPause;|5:begin|43:Pause(True, ReadInteger(_Data, ProcessId));|4:end;|0:|31:procedure THiAsmClass.doResume;|5:begin|44:Pause(False, ReadInteger(_Data, ProcessId));|4:end;|0:|4:end.|
link(ProcessID,12368957:Text,[])
}
Add(Edit,12368957,238,77)
{
Left=15
Top=10
}
Add(Button,7318487,161,126)
{
Left=20
Top=50
link(onClick,3935702:doPause,[])
}
Add(Button,7535854,161,161)
{
Left=85
Top=50
link(onClick,3935702:doResume,[(215,167)(215,139)])
}

Редактировалось 1 раз(а), последний 2021-05-03 03:24:02
карма: 2

0
Ответов: 2059
Рейтинг: 131
#4: 2021-05-21 00:43:53 ЛС | профиль | цитата
Возобновить процесс:

Function ResumeProcess(ProcessID: DWORD): Boolean;
var
Snapshot,cThr: DWORD;
ThrHandle: THandle;
Thread:TThreadEntry32;
begin
Result := False;
cThr := GetCurrentThreadId;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if Snapshot <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(Snapshot, Thread) then
repeat
if (Thread.th32ThreadID <> cThr) and (Thread.th32OwnerProcessID = ProcessID) then
begin
ThrHandle := OpenThread(THREAD_ALL_ACCESS, false, Thread.th32ThreadID);
if ThrHandle = 0 then Exit;
ResumeThread(ThrHandle);
CloseHandle(ThrHandle);
end;
until not Thread32Next(Snapshot, Thread);
Result := CloseHandle(Snapshot);
end;
end;

Приостановить процесс:

function SuspendProcess(PID:DWORD):Boolean;
var
hSnap: THandle;
THR32: THREADENTRY32;
hOpen: THandle;
begin
Result := FALSE;
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if hSnap <> INVALID_HANDLE_VALUE then
begin
THR32.dwSize := SizeOf(THR32);
Thread32First(hSnap, THR32);
repeat
if THR32.th32OwnerProcessID = PID then
begin
hOpen := OpenThread($0002, FALSE, THR32.th32ThreadID);
if hOpen <> INVALID_HANDLE_VALUE then
begin
Result := TRUE;
SuspendThread(hOpen);
CloseHandle(hOpen);
end;
end;
until Thread32Next(hSnap, THR32) = FALSE;
CloseHandle(hSnap);
end;
end;

Редактировалось 3 раз(а), последний 2021-05-21 01:46:57
карма: 6

0
4
Сообщение
...
Прикрепленные файлы
(файлы не залиты)