Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Регистрация на сайте занимает 40 секунд, а пользу приносит годами.

Дополнительные функции

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Вопросы: 0
Ответы: 0
Мини-форумы: 0

Онлайн на сайте: 4 (3404)
Онлайн в IRC: 2 (17)
Последние новости:
8 июля 2023
Последний вопрос:
30 августа 2025, 19:29
Последний ответ:
29 марта 2018, 23:32

Лучшие эксперты

Подробнее »

Вопрос # 2 762

Раздел: Delphi » Прочее

/ вопрос решён /

Здравствуйте!
Как можно сделать так чтобы только одна копия моей проги работала а не 2 в копии?
Чтобы была скрыть в списке задач диспетчера задач!

Вопрос решён, но можно продолжить его обсуждение в мини-форуме

Вопрос задал: Hideman (статус: Посетитель)
Вопрос отправлен: 11 мая 2009, 07:51
Состояние вопроса: решён, ответов: 2.

Ответ #1. Отвечает эксперт: min@y™

Цитата:

Как можно сделать так чтобы только одна копия моей проги работала а не 2 в копии?

Способов полно, чтобы посмотреть их, нажми сюда.

Цитата:

Чтобы была скрыть в списке задач диспетчера задач!

Надо писать программу как сервис.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 11 мая 2009, 09:34
Оценка за ответ: 5

Ответ #2. Отвечает эксперт: 7Ghost

Здравствуйте, Hideman! Вы спрашиваете, как не допустить запуск второй копии программы?На мой взгляд вот самый лучший способ!

Приложение:

unit Only_One;
interface
function Init_Mutex(mid: string): boolean;
implementation
uses Windows;
var
mut: thandle;
function mut_id(s: string): string;
var
f: integer;
begin
result := s;
for f := 1 to length(s) do
if result[f] = '' then
result[f] := '_';
end;
function Init_Mutex(mid: string): boolean;
begin
Mut := CreateMutex(nil, false, pchar(mut_id(mid)));
Result := not ((Mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;
initialization
mut := 0;
finalization
if mut <> 0 then
CloseHandle(mut);
end.
uses
Forms,
MainForm in 'MainForm.pas' {Form1};
{$R *.res}
const
begin
if not init_mutex(UniqueString) then
begin
exit;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Ответ отправил: 7Ghost (статус: 1-ый класс)
Время отправки: 11 мая 2009, 17:18
Оценка за ответ: 5

Мини-форум вопроса

Всего сообщений: 29; последнее сообщение — 12 мая 2009, 13:28; участников в обсуждении: 6.

Страницы: [1] [2] [Следующая »]

Hideman (статус: Посетитель), 11 мая 2009, 09:51 [#1]:

На счет чтобы прогу скрыть я использовал ShowWindow(application.handle,SW_HIDE) не виден в списке задач а не списке процессов!

Hideman (статус: Посетитель), 11 мая 2009, 10:24 [#2]:

Как можно писать прогу как сервис?

min@y™ (статус: Доктор наук), 11 мая 2009, 10:52 [#3]:

Набери в гугле "написание сервиса delphi"

Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Вадим К (статус: Академик), 11 мая 2009, 13:00 [#4]:

А зачем скрывать программу с списка процессов? На самом деле, если программы нет в списке процессов, то она и выполнятся не будет - ей не будет доставаться процессорного времени.
Во вторых - желание скрывать сразу наводит на мысль о вирусах и прочем.
Сервис - это хорошее дело, но там есть куча особенностей. Во первых, по умолчанию сервис работает в своем сеансе и доступа до рабочего стола по умолчанию не имеет...

Галочка "подтверждения прочтения" - вселенское зло.

Hideman (статус: Посетитель), 11 мая 2009, 13:04 [#5]:

А что насчет запрета запуска 2 копии одной и той же проги?

Hideman (статус: Посетитель), 11 мая 2009, 13:08 [#6]:

Ест ли более простой способ как VB например(if pp.PrevInstance = True then .......) или для скрытия в списке задач (App.TaskVisible = False)???

Вадим К (статус: Академик), 11 мая 2009, 13:10 [#7]:

Ну это не сложно. Сотни способов. Программа при запуске просто проверяет, не запущенна ли её копия. Например самый простой способ - проверить, нет ли окна с нужным именем, либо создавать общий именованный мютекс.
Но!
1) надо - все равно обойдут.
2) Можно всегда сделать хуже пользователю - а это самое плохое.

Наверно, для программистов, надо как для докторов, делать клятву "не навреди юзеру своему". а там и качество софта улучшиться...

Галочка "подтверждения прочтения" - вселенское зло.

Вадим К (статус: Академик), 11 мая 2009, 13:12 [#8]:

по поводу (if pp.PrevInstance = True then .......).
Старые книги читаете

очень старые, по 3.11 винде. Да, когда то подобный способ работал. Теперь нет.

Галочка "подтверждения прочтения" - вселенское зло.

Hideman (статус: Посетитель), 11 мая 2009, 13:26 [#9]:

Этот пример: APP.Previnstance данный момент работает Visual Basic-ке вот о чем идёт реч!

Вадим К (статус: Академик), 11 мая 2009, 13:34 [#10]:

Странно, вообще то не должно работать, работать корректно. Хотя может быть Майкрософт, что бы не создавать проблем бейсик программистам, сделала костыль-симулятор. А так, начиная с 95 виндовс, этот способ официально не работает во всех языках - соответсвующий вызов апи функции сделан заглушкой.

Галочка "подтверждения прочтения" - вселенское зло.

Hideman (статус: Посетитель), 11 мая 2009, 13:44 [#11]:

Но несмотря на это я пишу проги используя это на VB всё работает хорошо даже по сей день!!!

Вадим К (статус: Академик), 11 мая 2009, 14:56 [#12]:

Сложно сравнивать VB и Delphi. В первом все таки виртуальная машина... А в последней версии уже под .NET всё перешло...

Галочка "подтверждения прочтения" - вселенское зло.

Ученый (статус: 8-ой класс), 11 мая 2009, 15:02 [#13]:

А интересно, какая такая надобность скрыть процесс в диспечере? Обычно скрываются те программы которые призваны нанести вред, а с Вадимом согласен на счет клятвы

А если App.TaskVisible = False и скроет процесс, то это скорее всего только в стандартном диспечере задач, но если посмотреть чем-то посерьезнее, то большая доля вероятности что не удасться скрыть процесс...

7Ghost (статус: 1-ый класс), 11 мая 2009, 17:17 [#14]:

Здравствуйте, Hideman! Вы спрашиваете, как не допустить запуск второй копии программы?На мой взгляд вот самый лучший способ!

Для того чтобы не допустить запуск второй копии программы сделайте следующие шаги!

1) В корневой папке вашей программы создайте текстовый файл и пропишите в него ниже указанный код и перемените имя вашего файла на "Only_One.pas";

unit Only_One;

interface

function Init_Mutex(mid: string): boolean;

implementation

uses Windows;

var
mut: thandle;

function mut_id(s: string): string;
var
f: integer;
begin
result := s;
for f := 1 to length(s) do
if result[f] = '\' then
result[f] := '_';
end;

function Init_Mutex(mid: string): boolean;
begin
Mut := CreateMutex(nil, false, pchar(mut_id(mid)));
Result := not ((Mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;

initialization
mut := 0;
finalization
if mut <> 0 then
CloseHandle(mut);
end.

2) Откройте вашу программу в Delphi и выполните команду главного меню "Project->View Source" и добавьте то чего нет в такой же последовательности:

program ЗДЕСЬ НАЗВАНИЕ ВАШЕЙ ПРОГРАММЫ;

uses
Only_one, //этот модуль вы создали в корневом каталоге вашей программ!
Forms,
Dialog, //данный модуль поможет вывести сообщение на экран!
MainForm in 'MainForm.pas' {Form1};

{$R *.res}

const
UniqueString = 'DFG005BNME5007DA'; //идентификатор вашей программы(должны быть ваши символы) по этим символам мы поймем что программа открылась дважды!

begin
if not init_mutex(UniqueString) then
begin
MessageDlg('Приложение уже запущено (возможно оно свернуто
на панели задач): Нажмите кнопку ОК для продолжения работы!
Производственно-диспетчерская служба', mtInformation, [mbOK], 0);
exit;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Все удачи!

Вадим К (статус: Академик), 11 мая 2009, 17:27 [#15]:

вот только для генерации уникальной строки лучше использовать GUID. А то все равно найдется "умный человек", который умудриться не поменять строку... или указать что то простое.
В делфи GUID сгенерировать очень просто - просто нажать Ctrl+Shift+G. Полученная строка считается достаточно уникальной.

Галочка "подтверждения прочтения" - вселенское зло.

7Ghost (статус: 1-ый класс), 11 мая 2009, 21:40 [#16]:

Вполне согласен с Вадимом К! Это моя ошибка! Но на мой взгляд, если нужно истинно получить случайный набор символов используйте крипто-ключ например полученный из расчета контрольной суммы оригинального файла или перемещения мыши на экране, тогда точно не будет совпадений! А для полной безопасности зашифруйте идентификационный ключ хотя бы простым методом сдвига XOR!!! Удачи!

7Ghost (статус: 1-ый класс), 11 мая 2009, 21:49 [#17]:

А вот предложение скрыть приложение из Диспетчера задач очень заманчиво!!! Интересно для чего вам это нужно? Хотите написать троян? В принципе для меня это не составит труда в написании для Windows 98, а вот с XP достаточно сложно!!! Может другие эксперты подскажут??!!

Вадим К (статус: Академик), 11 мая 2009, 21:59 [#18]:

Дело в том, что скрыть не сложно. Но тут проблема в другом - что после этого приложение не будет выполняться. Ведь если приложения нет в списке процессов, то оно не получает процессорного времени и как следствие, не выполняется...
Другое дело, что под словом "скрыть" подразумевают "обмануть" диспетчер задач. Но это уже другая песня... тут сервис пак поменялся и надо другие методы.

Галочка "подтверждения прочтения" - вселенское зло.

Silaims (статус: Посетитель), 11 мая 2009, 22:22 [#19]:

Можно скрыть процесс программы из диспетчера задач при помощи перехвата модуля, который использует сам диспечер.
Вот мой пример:
Делаем две модульки для одного модуля...
1) "ExtendedAPIFunctions"

unit ExtendedAPIFunctions;

interface

uses Windows;

const
SystemBasicInformation = 0;
SystemProcessorInformation = 1;
SystemPerformanceInformation = 2;
SystemTimeOfDayInformation = 3;
SystemNotImplemented1 = 4;
SystemProcessesAndThreadsInformation = 5;
SystemCallCounts = 6;
SystemConfigurationInformation = 7;
SystemProcessorTimes = 8;
SystemGlobalFlag = 9;
SystemNotImplemented2 = 10;
SystemModuleInformation = 11;
SystemLockInformation = 12;
SystemNotImplemented3 = 13;
SystemNotImplemented4 = 14;
SystemNotImplemented5 = 15;
SystemHandleInformation = 16;
SystemObjectInformation = 17;
SystemPagefileInformation = 18;
SystemInstructionEmulationCounts = 19;
SystemInvalidInfoClass = 20;
SystemCacheInformation = 21;
SystemPoolTagInformation = 22;
SystemProcessorStatistics = 23;
SystemDpcInformation = 24;
SystemNotImplemented6 = 25;
SystemLoadImage = 26;
SystemUnloadImage = 27;
SystemTimeAdjustment = 28;
SystemNotImplemented7 = 29;
SystemNotImplemented8 = 30;
SystemNotImplemented9 = 31;
SystemCrashDumpInformation = 32;
SystemExceptionInformation = 33;
SystemCrashDumpStateInformation = 34;
SystemKernelDebuggerInformation = 35;
SystemContextSwitchInformation = 36;
SystemRegistryQuotaInformation = 37;
SystemLoadAndCallImage = 38;
SystemPrioritySeparation = 39;
SystemNotImplemented10 = 40;
SystemNotImplemented11 = 41;
SystemInvalidInfoClass2 = 42;
SystemInvalidInfoClass3 = 43;
SystemTimeZoneInformation = 44;
SystemLookasideInformation = 45;
SystemSetTimeSlipEvent = 46;
SystemCreateSession = 47;
SystemDeleteSession = 48;
SystemInvalidInfoClass4 = 49;
SystemRangeStartInformation = 50;
SystemVerifierInformation = 51;
SystemAddVerifier = 52;
SystemSessionProcessesInformation = 53;
STATUS_SUCCESS = $00000000;
STATUS_ACCESS_DENIED = $C0000022;
STATUS_INFO_LENGTH_MISMATCH = $C0000004;
SEVERITY_ERROR = $C0000000;

type
NTStatus = Cardinal;
PUNICODE_STRING = ^UNICODE_STRING;
UNICODE_STRING = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;
PVM_COUNTERS = ^VM_COUNTERS;
VM_COUNTERS = packed record
PeakVirtualSize,
VirtualSize,
PageFaultCount,
PeakWorkingSetSize,
WorkingSetSize,
QuotaPeakPagedPoolUsage,
QuotaPagedPoolUsage,
QuotaPeakNonPagedPoolUsage,
QuotaNonPagedPoolUsage,
PagefileUsage,
PeakPagefileUsage: DWORD;
end;
PIO_COUNTERS = ^IO_COUNTERS;
IO_COUNTERS = packed record
ReadOperationCount,
WriteOperationCount,
OtherOperationCount,
ReadTransferCount,
WriteTransferCount,
OtherTransferCount: LARGE_INTEGER;
end;
PClientID = ^TClientID;
TClientID = packed record
UniqueProcess

WORD;
UniqueThread

WORD;
end;
PSYSTEM_THREADS = ^SYSTEM_THREADS;
SYSTEM_THREADS = packed record
KernelTime: LARGE_INTEGER;
UserTime: LARGE_INTEGER;
CreateTime: LARGE_INTEGER;
WaitTime: DWORD;
StartAddress: Pointer;
ClientId: TClientID;
Priority: DWORD;
BasePriority: DWORD;
ContextSwitchCount: DWORD;
State: dword;
WaitReason: dword;
end;
PSYSTEM_PROCESSES = ^_SYSTEM_PROCESSES;
_SYSTEM_PROCESSES = packed record
NextEntryDelta,
ThreadCount: DWORD;
Reserved1:array [0..5] of DWORD;
CreateTime:LARGE_INTEGER;
UserTime:LARGE_INTEGER;
KernelTime:LARGE_INTEGER;
ProcessName:UNICODE_STRING;
BasePriority

WORD;
ProcessID

WORD;
InheritedFromProcessID

WORD;
HandleCount: DWORD;
Reserved2: array [0..1] of DWORD;
VmCounters: VM_COUNTERS;
IoCounters: IO_COUNTERS; // Windows 2000 only
Threads: array [0..0] of SYSTEM_THREADS;
end;

Function ZwQuerySystemInformation(ASystemInformationClass: DWORD; ASystemInformation: Pointer;
ASystemInformationLength: DWORD; AReturnLength

Cardinal): NTStatus; stdcall;external 'ntdll.dll';

Function GetSystemInfo(InfoClass

WORD)

ointer;

implementation
//получение буфера с системной информацией
Function GetSystemInfo(InfoClass

WORD)

ointer;
var
mSize: DWORD;
pInfoDATA: Pointer;
NTRes: NTStatus;
begin
Result := 0;
mSize := $2000;
repeat
pInfoDATA := VirtualAlloc(0, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
if pInfoDATA = nil then Exit;
NTRes := ZwQuerySystemInformation(InfoClass, pInfoDATA, mSize, 0);
if NTRes = STATUS_INFO_LENGTH_MISMATCH then
begin
VirtualFree(pInfoDATA, 0, MEM_RELEASE);
mSize := mSize + $1000;
end;
until NTRes <> STATUS_INFO_LENGTH_MISMATCH;
if NTRes = STATUS_SUCCESS then Result := pInfoDATA
else VirtualFree(pInfoDATA, 0, MEM_RELEASE);
end;

end.

Silaims (статус: Посетитель), 11 мая 2009, 22:22 [#20]:

2) "ApiHookTools"

unit ApiHookTools;

interface

uses Windows,TlHelp32;

const
THREAD_ALL_ACCESS = $001F03FF;
THREAD_SUSPEND_RESUME = $00000002;

type
PFunctionRestoreData = ^ TFunctionRestoreData;
TFunctionRestoreData = packed record
Address

ointer;
val1:Byte;
val2

WORD;
end;

function EnableDebugPrivilege:Boolean;

Function GetProcessName(ProcessID

WORD):string;
function GetProcessID(ProcessName:string)

WORD;
Function StopProcess(ProcessID: DWORD): boolean;
Function ResumeProcess(ProcessID: DWORD): Boolean;

function LoadLibrary_Ex(ProcessID

WORD;LibName

Char):boolean;

function SetCodeHook(ProcAddress,NewProcAddress:pointer;RestoreDATA

FunctionRestoreData):boolean;
function UnHookCodeHook(RestoreDATA

FunctionRestoreData):Boolean;
function SetProcedureHook(ModuleHandle:HMODULE;ProcedureName

Char;NewProcedureAddress

ointer;
RestoreDATA

FunctionRestoreData):Boolean;

Function OpenThread(dwDesiredAccess: DWORD;bInheritHandle: BOOL;
dwThreadID: DWORD): THandle; stdcall; external 'kernel32.dll';

implementation

{-----------------------------------------------------------------------------
Установка перхвата функции по её имени

Procedure: SetProcedureHook

ModuleHandle:HMODULE; Хендл модуля в котором находится целевая функция
ProcedureName

Char; Имя процедуры
NewProcedureAddress

ointer; Указатель на процедуру перехватчик
RestoreDATA

FunctionRestoreData Указатель на мост к старой функции

Result: Boolean Успешность установки перехвата
-----------------------------------------------------------------------------}

function SetProcedureHook(ModuleHandle:HMODULE;ProcedureName

Char;NewProcedureAddress

ointer;
RestoreDATA

FunctionRestoreData):Boolean;
var
ProcAddress

ointer;
begin
ProcAddress:=GetProcAddress(ModuleHandle,ProcedureName);
Result:=SetCodeHook(ProcAddress,NewProcedureAddress,RestoreDATA);
end;

{-----------------------------------------------------------------------------
Снятие перехвата функции

Procedure: UnHookCodeHook

RestoreDATA

FunctionRestoreData адрес моста к старой функции

Result: Boolean
-----------------------------------------------------------------------------}

function UnHookCodeHook(RestoreDATA

FunctionRestoreData):Boolean;
var
ProcAddress

ointer;
OldProtect,JMPValue

WORD;
begin
Result:=False;
ProcAddress:=RestoreDATA^.Address;
if not VirtualProtect(ProcAddress,5,PAGE_EXECUTE_READWRITE,OldProtect) then exit;
Byte(ProcAddress^):=RestoreDATA^.val1;
DWORD(Pointer(DWORD(ProcAddress)+1)^):=RestoreDATA^.val2;
Result:=VirtualProtect(ProcAddress,5,OldProtect,OldProtect);
end;
{-----------------------------------------------------------------------------
Установка перехвата функции по её указаелю

Procedure: SetCodeHook

ProcAddress, указатель на целевую функцию
NewProcAddress:pointer; указатель на функцию перехватчик
RestoreDATA

FunctionRestoreData Указатель на мост к старой функции

Result: boolean успешность
-----------------------------------------------------------------------------}

function SetCodeHook(ProcAddress, NewProcAddress: pointer; RestoreDATA

FunctionRestoreData):boolean;
var
OldProtect, JMPValue

WORD;
begin
Result:=False;
if not VirtualProtect(ProcAddress,5,PAGE_EXECUTE_READWRITE,OldProtect) then exit;
JMPValue := DWORD(NewProcAddress) - DWORD(ProcAddress) - 5;
RestoreDATA^.val1:= Byte(ProcAddress^);
RestoreDATA^.val2:= DWORD(Pointer(DWORD(ProcAddress)+1)^);
RestoreDATA^.Address:=ProcAddress;
byte(ProcAddress^):=$E9;
DWORD(Pointer(DWORD(ProcAddress)+1)^):=JMPValue;
Result:=VirtualProtect(ProcAddress,5,OldProtect,OldProtect);
end;

{-----------------------------------------------------------------------------
Загрузка DLL в чужой проццесс
Procedure: LoadLibrary_Ex

ProcessID

WORD;
LibName

Char

Result: boolean
-----------------------------------------------------------------------------}
function LoadLibrary_Ex(ProcessID

WORD;LibName

Char):boolean;
var
pLL,pDLLPath

ointer;
hProcess,hThr:THandle;
LibPathLen,_WR,ThrID

WORD;
begin
Result:=False;
LibPathLen:=Length(string(LibName));
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,ProcessID);
if hProcess=0 then exit;
pDLLPath:=VirtualAllocEx(hProcess,0,LibPathLen+1,MEM_COMMIT,PAGE_READWRITE);
if DWORD(pDLLPath)=0 then exit;
pLL:=GetProcAddress(GetModuleHandle(kernel32),'LoadLibraryA');
WriteProcessMemory(hProcess,pDLLPath,LibName,LibPathLen+1,_WR);
hThr:=CreateRemoteThread(hProcess,0,0,pLL,pDLLPath,0,ThrID);
if hThr=0 then exit;
Result:=CloseHandle(hProcess);
end;

function GetProcessID;
var
Snap: dword;
Process: TPROCESSENTRY32;
begin
Result := 0;
Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snap <> INVALID_HANDLE_VALUE then
begin
Process.dwSize := SizeOf(TPROCESSENTRY32);
if Process32First(Snap, Process) then
repeat
if lstrcmpi(Process.szExeFile, pchar(ProcessName)) = 0 then
begin
Result := Process.th32ProcessID;
CloseHandle(Snap);
Exit;
end;
until not Process32Next(Snap, Process);
Result := 0;
CloseHandle(Snap);
end;
end;

Function GetProcessName;
var Snapshot:THandle;
Process: TPROCESSENTRY32;
begin
Result:='';
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then exit;
Process.dwSize := SizeOf(TPROCESSENTRY32);
if Process32First(SnapShot, Process) then
repeat
if ProcessID=Process.th32ProcessID then
begin
Result := Process.szExeFile;
CloseHandle(Snapshot);
Exit;
end;
until not Process32Next(Snapshot, Process);
CloseHandle(Snapshot);
end;

function EnableDebugPrivilege:Boolean;
var
hToken: dword;
SeDebugNameValue: Int64;
tkp: TOKEN_PRIVILEGES;
ReturnLength: dword;
begin
Result:=false;
//Получаем токен нашего процесса
OpenProcessToken(INVALID_HANDLE_VALUE, TOKEN_ADJUST_PRIVILEGES
or TOKEN_QUERY, hToken);
//Получаем LUID привилегии
if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', SeDebugNameValue) then
begin
CloseHandle(hToken);
exit;
end;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := SeDebugNameValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
//Добавляем привилегию к процессу
AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES),
tkp, ReturnLength);
Result:= GetLastError = ERROR_SUCCESS;
end;

Function StopProcess(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;
SuspendThread(ThrHandle);
CloseHandle(ThrHandle);
end;
until not Thread32Next(Snapshot, Thread);
Result:=CloseHandle(Snapshot);
end;
end;

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;

end.

Страницы: [1] [2] [Следующая »]

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)

Текущее время: 31 октября 2025, 07:23

Главная страница | Обратная связь

Выполнено за 0.04 сек.

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 2 762

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом