Работа с чужими процессами

PID and SID процесса

2017-11-07T01:18:37+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

end;

PTokenUser = ^TTokenUser;

TTokenUser = record

User: array[0..0] of TSIDAndAttributes;

end;

procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;

external advapi32 name 'ConvertSidToStringSidA';

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetCurrentUserSID: String;

var

TokenHandle: THandle;

TokenInformationClass: TTokenInformationClass;

TokenInformation: PTokenUser;

ReturnLength: DWORD;

StringSid: LPSTR;

begin

Result := '';

if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then

try

TokenInformationClass := TokenUser;

GetTokenInformation(TokenHandle, TokenInformationClass, nil, 0, ReturnLength);

if GetLastError = ERROR_INSUFFICIENT_BUFFER then

begin

TokenInformation := GetMemory(ReturnLength);

if TokenInformation <> nil then

try

if GetTokenInformation(TokenHandle, TokenInformationClass,

TokenInformation, ReturnLength, ReturnLength) then

begin

ConvertSidToStringSid(TokenInformation^.User[0].Sid, StringSid);

Result := StringSid;

end;

finally

FreeMemory(TokenInformation);

end;

finally

CloseHandle(TokenHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetCurrentUserSID);

end;

end.

Подробнее...

Unit с полезными функциями для работы с процессами

2017-11-07T02:11:51+07:00

Пример использования:

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

I: Integer;

PC: WORD;

begin

ListBox1.Clear;

ProcArr := TLpModuleInfoArray(ProcUtilz.GetAllProcessesInfo);

PC := 0;

for i := Low(ProcArr) to High(ProcArr) do

begin

ListBox1.Items.Add('Process Name: '+ProcArr[i].ModuleName+' : Proccess ID '+IntToStr(ProcArr[i].ModulePID)+' :

Image Size: '+IntToStr( ProcArr[i].ModuleInfo.SizeOfImage));

Inc(PC);

end;

ListBox1.Items.Add('Total process count: '+IntToStr(PC));

end;

procedure TForm1.Button2Click(Sender: TObject);

var

EC: Integer;

begin

EC := ProcUtilz.TerminateTask(ProcArr[ListBox1.ItemIndex].ModulePID);

if EC=0 then

MessageDlg('Task terminated successfully!',mtInformation,[mbOK],0)

else

MessageDlg('Unable to terminate task! GetLastError() returned: '+IntToStr(EC),mtWarning,[mbOK],0);

Button1Click(Sender);

end;

Подробнее...

Взаимодействие с чужими окнами

2017-11-07T00:40:45+07:00

Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!

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

Подробнее...

Внедрение библиотеки через CreateRemoteThread

2017-11-07T01:20:23+07:00

А также исполнение своего кода в удаленном процессе через CreateRemote

Code:

////////////////////////////////////////////////////////////////////////////////

// ****************************************************************************

// * Project : Inject/Eject Library Demo

// * Unit Name : HookDLL

// * Purpose : Демонстрационный пример внедрения библиотеки через CreateRemoteThread

// * Author : Александр (Rouse_) Багель

// * Version : 1.00

// ****************************************************************************

Library HookDLL;

{©Drkb v.3}

uses

Windows,

Messages,

SysUtils;

procedure DLLEntryPoint(dwReason: DWORD);

begin

case dwReason of

DLL_PROCESS_ATTACH:

begin

MessageBox(0, 'DLL_PROCESS_ATTACH', 'DLL_PROCESS_ATTACH', MB_OK);

ExitThread(0);

end;

begin

DLLProc := @DLLEntryPoint;

DLLEntryPoint(DLL_PROCESS_ATTACH);

end.

Подробнее...

Как вывести результат работы консоли в Memo?

2017-11-02T21:27:39+07:00

Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.

Подробнее...

Как завершить задачу в Windows (а заодно получить PID задачи)?

2017-11-02T21:30:14+07:00

Ниже приведён unit, который позволяет убить задачу в Windows NT.

Code:

function Kill_By_Pid(pid : longint) : integer;

где pid, это число, представляющее pid задачи

function EnumProcessWithPid(list : TStrings) : integer;

где список, это объект TStrings, который будет содержать имя задачи и pid в полях Object.

( list.Items[i] для имени, integer(list.Object[i]) для PID)

Подробнее...

Как изменить заголовок чужого окна?

2017-11-06T17:08:31+07:00

Code:

SetWindowText(FindWindow(nil,'Текущий заголовок'), 'Желаемый');

Автор trainer

Как исправить (пропатчить) процесс?

2017-11-07T00:57:39+07:00

Code:

{....}

var

WindowName: Integer;

ProcessId: Integer;

ThreadId: Integer;

buf: PChar;

HandleWindow: Integer;

Write: Cardinal;

{....}

const

WindowTitle = 'a program name';

Address = $A662D6;

PokeValue = $4A;

NumberOfBytes = 2;

{....}

procedure TForm1.Button1Click(Sender: TObject);

begin

WindowName := FindWindow(nil, WindowTitle);

if WindowName = 0 then

begin

MessageDlg('Program not running.', mtWarning, [mbOK], 0);

end;

ThreadId := GetWindowThreadProcessId(WindowName, @ProcessId);

HandleWindow := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId);

GetMem(buf, 1);

buf^ := Chr(PokeValue);

WriteProcessMemory(HandleWindow, ptr(Address), buf, NumberOfBytes, Write);

FreeMem(buf);

CloseHandle(HandleWindow);

end;

Как можно из своей программы закрыть чужую?

2017-11-02T21:14:06+07:00

Code:

PostThreadMessage(AnotherProg_MainThreadID,WM_CLOSE,0,0);

PostMessage(AnotherProg_MainWindow,WM_CLOSE,0,0);

Как можно определить Handle окна,над которым находится мышка?

2017-11-02T21:14:46+07:00

WindowFromPoint

ChildWindowFromPoint

Автор ответа: rhf

Как найти окно по неполному названию?

2017-11-02T21:17:20+07:00

Code:

function TForm1.Find(s: string): hWnd;

var Wnd: hWnd;

buff: array[0..127] of Char;

begin

Find := 0;

Wnd := GetWindow(Handle, gw_HWndFirst);

while Wnd <> 0 do

begin

if (Wnd <> Application.Handle) and

IsWindowVisible(Wnd) and

(GetWindow(Wnd, gw_Owner) = 0) and

(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then

begin

GetWindowText(Wnd, buff, sizeof(buff));

if pos(s, StrPas(buff)) > 0 then

begin

Find := Wnd;

Break;

end;

Wnd := GetWindow(Wnd, gw_hWndNext);

end;

Подробнее...

Как передать строку другому приложению

2017-11-07T02:15:07+07:00

получатель:

Code:

procedure ReceiveMessage (var Msg: TMessage);

message WM_COPYDATA;

...

procedure TFormReceive.ReceiveMessage;

var

pcd: PCopyDataStruct;

begin

pcd := PCopyDataStruct(Msg.LParam);

Caption := PChar(pcd.lpData);

end;

Подробнее...

Как перехватывать события, посланные другим приложениям?

2017-11-06T16:49:34+07:00

Для отслеживания каких-то событий во всей Windows нужно установить ловушку (hook).

Например, такая ловушка может отслеживать все события, связанные с мышью, где бы ни находился курсор. Можно отслеживать и события клавиатуры.

Для ловушки нужна функция, которая, после установки ловушки при помощи SetWindowsHookEx, будет вызываться при каждом нужном событии.

Эта функция получает всю информацию о событии. UnhookWindowsHookEx уничтожает ловушку.

Подробнее...

Как по PID процесса узнать CMDLINE?, то есть командную строку

2017-11-07T02:02:44+07:00

Code:

function GetProcessCmdLine(PID:DWORD):string;

{©Drkb v.3}

var

h:THandle;

pbi:TProcessBacicInformation;

ret:NTSTATUS;

r:Cardinal;

ws:WideString;

begin

result:='';

if pid=0 then exit;

h:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, pid);

if h=0 then exit;

try

ret:=NtQueryInformationProcess(h,ProcessBasicInformation,@pbi,sizeof(pbi),@r);

if ret=STATUS_SUCCESS then

if ReadProcessMemory(h,pbi.PebBaseAddress.ProcessParameters.CommandLine.Buffer,PWideChar(ws),

pbi.PebBaseAddress.ProcessParameters.CommandLine.Length,r) then

result:=string(ws);

finally

closehandle(h)

end

end;

Как получить домен и имя пользователя (UserName) процесса?

2017-11-07T01:01:22+07:00

Code:

uses

TlHelp32;

type

PTOKEN_USER = ^TOKEN_USER;

_TOKEN_USER = record

User: TSidAndAttributes;

end;

TOKEN_USER = _TOKEN_USER;

function GetUserAndDomainFromPID(ProcessId: DWORD;

var User, Domain: string): Boolean;

var

hToken: THandle;

cbBuf: Cardinal;

ptiUser: PTOKEN_USER;

snu: SID_NAME_USE;

ProcessHandle: THandle;

UserSize, DomainSize: DWORD;

bSuccess: Boolean;

begin

Result := False;

ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);

if ProcessHandle <> 0 then

begin

// EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);

if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then

begin

bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);

ptiUser := nil;

while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do

begin

ReallocMem(ptiUser, cbBuf);

bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);

end;

CloseHandle(hToken);

if not bSuccess then

begin

Exit;

end;

UserSize := 0;

DomainSize := 0;

LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);

if (UserSize <> 0) and (DomainSize <> 0) then

begin

SetLength(User, UserSize);

SetLength(Domain, DomainSize);

if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,

PChar(Domain), DomainSize, snu) then

begin

Result := True;

User := StrPas(PChar(User));

Domain := StrPas(PChar(Domain));

end;

if bSuccess then

begin

FreeMem(ptiUser);

end;

CloseHandle(ProcessHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

hProcSnap: THandle;

pe32: TProcessEntry32;

Domain, User: string;

s: string;

begin

hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);

if hProcSnap = INVALID_HANDLE_VALUE then Exit;

pe32.dwSize := SizeOf(ProcessEntry32);

if Process32First(hProcSnap, pe32) = True then

while Process32Next(hProcSnap, pe32) = True do

begin

if GetUserAndDomainFromPID(pe32.th32ProcessID, User, Domain) then

begin

s := Format('%s User: %s ; Domain: %s',[StrPas(pe32.szExeFile), User, Domain]);

Listbox1.Items.Add(s);

end else

Listbox1.Items.Add(StrPas(pe32.szExeFile));

end;

CloseHandle(hProcSnap);

end;

Как получить список процессов в Win9x

2017-11-07T01:05:00+07:00

Эта функция возвращает результат: запущено ли приложение, переданное ей в качестве параметра. Функция просматривает список всех процессов и делает вывод.

Подробнее...

Как убить задачу, зная только имя .exe?

2017-11-02T21:30:59+07:00

Code:

{Эта небольшая функция закрывает приложения, соответствующие заданному имени .exe.

Пример: KillTask('notepad.exe');

KillTask('iexplore.exe'); }

uses

Tlhelp32, Windows, SysUtils;

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;

Как узнать все открытые дескрипторы файлов?

2017-11-07T01:13:11+07:00

Code:

////////////////////////////////////////////////////////////////////////////////

// ****************************************************************************

// * Unit Name : Unit15

// * Purpose : Перечисление всех открытых файлов в системе

// * (до которых получилось достучаться)

// * Author : Александр (Rouse_) Багель

// * Version : 1.00

// ****************************************************************************

{©Drkb v.3}

unit Unit15;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls;

type

TForm15 = class(TForm)

Button1: TButton;

Memo1: TMemo;

ProgressBar1: TProgressBar;

procedure Button1Click(Sender: TObject);

public

procedure ShowLockedProcess(FileName: String);

end;

var

Form15: TForm15;

implementation

{$R *.dfm}

type

NT_STATUS = Cardinal;

TFileDirectoryInformation = packed record

NextEntryOffset: ULONG;

FileIndex: ULONG;

CreationTime: LARGE_INTEGER;

LastAccessTime: LARGE_INTEGER;

LastWriteTime: LARGE_INTEGER;

ChangeTime: LARGE_INTEGER;

EndOfFile: LARGE_INTEGER;

AllocationSize: LARGE_INTEGER;

FileAttributes: ULONG;

FileNameLength: ULONG;

FileName: array[0..0] of WideChar;

end;

FILE_DIRECTORY_INFORMATION = TFileDirectoryInformation;

PFileDirectoryInformation = ^TFileDirectoryInformation;

PFILE_DIRECTORY_INFORMATION = PFileDirectoryInformation;

PSYSTEM_THREADS = ^SYSTEM_THREADS;

SYSTEM_THREADS = packed record

KernelTime: LARGE_INTEGER;

UserTime: LARGE_INTEGER;

CreateTime: LARGE_INTEGER;

WaitTime: ULONG;

StartAddress: Pointer;

UniqueProcess: DWORD;

UniqueThread: DWORD;

Priority: Integer;

BasePriority: Integer;

ContextSwitchCount: ULONG;

State: Longint;

WaitReason: Longint;

end;

PSYSTEM_PROCESS_INFORMATION = ^SYSTEM_PROCESS_INFORMATION;

SYSTEM_PROCESS_INFORMATION = packed record

NextOffset: ULONG;

ThreadCount: ULONG;

Reserved1: array [0..5] of ULONG;

CreateTime: FILETIME;

UserTime: FILETIME;

KernelTime: FILETIME;

ModuleNameLength: WORD;

ModuleNameMaxLength: WORD;

ModuleName: PWideChar;

BasePriority: ULONG;

ProcessID: ULONG;

InheritedFromUniqueProcessID: ULONG;

HandleCount: ULONG;

Reserved2 : array[0..1] of ULONG;

PeakVirtualSize : ULONG;

VirtualSize : ULONG;

PageFaultCount : ULONG;

PeakWorkingSetSize : ULONG;

WorkingSetSize : ULONG;

QuotaPeakPagedPoolUsage : ULONG;

QuotaPagedPoolUsage : ULONG;

QuotaPeakNonPagedPoolUsage : ULONG;

QuotaNonPagedPoolUsage : ULONG;

PageFileUsage : ULONG;

PeakPageFileUsage : ULONG;

PrivatePageCount : ULONG;

ReadOperationCount : LARGE_INTEGER;

WriteOperationCount : LARGE_INTEGER;

OtherOperationCount : LARGE_INTEGER;

ReadTransferCount : LARGE_INTEGER;

WriteTransferCount : LARGE_INTEGER;

OtherTransferCount : LARGE_INTEGER;

ThreadInfo: array [0..0] of SYSTEM_THREADS;

end;

PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;

SYSTEM_HANDLE_INFORMATION = packed record

ProcessId: DWORD;

ObjectTypeNumber: Byte;

Flags: Byte;

Handle: Word;

pObject: Pointer;

GrantedAccess: DWORD;

end;

PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;

SYSTEM_HANDLE_INFORMATION_EX = packed record

NumberOfHandles: dword;

Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;

end;

PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;

FILE_NAME_INFORMATION = packed record

FileNameLength: ULONG;

FileName: array [0..MAX_PATH - 1] of WideChar;

end;

PUNICODE_STRING = ^TUNICODE_STRING;

TUNICODE_STRING = packed record

Length : WORD;

MaximumLength : WORD;

Buffer : array [0..MAX_PATH - 1] of WideChar;

end;

POBJECT_NAME_INFORMATION = ^TOBJECT_NAME_INFORMATION;

TOBJECT_NAME_INFORMATION = packed record

Name : TUNICODE_STRING;

end;

PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;

IO_STATUS_BLOCK = packed record

Status: NT_STATUS;

Information: DWORD;

end;

PGetFileNameThreadParam = ^TGetFileNameThreadParam;

TGetFileNameThreadParam = packed record

hFile: THandle;

Data: array [0..MAX_PATH - 1] of Char;

Status: NT_STATUS;

end;

const

STATUS_SUCCESS = NT_STATUS($00000000);

STATUS_INVALID_INFO_CLASS = NT_STATUS($C0000003);

STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);

STATUS_INVALID_DEVICE_REQUEST = NT_STATUS($C0000010);

ObjectNameInformation = 1;

FileDirectoryInformation = 1;

FileNameInformation = 9;

SystemProcessesAndThreadsInformation = 5;

SystemHandleInformation = 16;

function ZwQuerySystemInformation(ASystemInformationClass: DWORD;

ASystemInformation: Pointer; ASystemInformationLength: DWORD;

AReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

function NtQueryInformationFile(FileHandle: THandle;

IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;

Length: DWORD; FileInformationClass: DWORD): NT_STATUS;

stdcall; external 'ntdll.dll';

function NtQueryObject(ObjectHandle: THandle;

ObjectInformationClass: DWORD; ObjectInformation: Pointer;

ObjectInformationLength: ULONG;

ReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

function GetLongPathNameA(lpszShortPath, lpszLongPath: PChar;

cchBuffer: DWORD): DWORD; stdcall; external kernel32;

procedure TForm15.Button1Click(Sender: TObject);

begin

ShowLockedProcess('');

end;

procedure TForm15.ShowLockedProcess(FileName: String);

function GetInfoTable(ATableType: DWORD): Pointer;

var

dwSize: DWORD;

pPtr: Pointer;

ntStatus: NT_STATUS;

begin

Result := nil;

dwSize := WORD(-1);

GetMem(pPtr, dwSize);

ntStatus := ZwQuerySystemInformation(ATableType, pPtr, dwSize, nil);

while ntStatus = STATUS_INFO_LENGTH_MISMATCH do

begin

dwSize := dwSize * 2;

ReallocMem(pPtr, dwSize);

ntStatus := ZwQuerySystemInformation(ATableType, pPtr, dwSize, nil);

end;

if ntStatus = STATUS_SUCCESS then

Result := pPtr

else

FreeMem(pPtr);

end;

function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;

var

FileNameInfo: FILE_NAME_INFORMATION;

ObjectNameInfo: TOBJECT_NAME_INFORMATION;

IoStatusBlock: IO_STATUS_BLOCK;

pThreadParam: TGetFileNameThreadParam;

dwReturn: DWORD;

begin

ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));

pThreadParam := PGetFileNameThreadParam(lpParameters)^;

Result := NtQueryInformationFile(pThreadParam.hFile, @IoStatusBlock,

@FileNameInfo, MAX_PATH * 2, FileNameInformation);

if Result = STATUS_SUCCESS then

begin

Result := NtQueryObject(pThreadParam.hFile, ObjectNameInformation,

@ObjectNameInfo, MAX_PATH * 2, @dwReturn);

if Result = STATUS_SUCCESS then

begin

pThreadParam.Status := Result;

WideCharToMultiByte(CP_ACP, 0,

@ObjectNameInfo.Name.Buffer[ObjectNameInfo.Name.MaximumLength -

ObjectNameInfo.Name.Length],

ObjectNameInfo.Name.Length, @pThreadParam.Data[0],

MAX_PATH, nil, nil);

end

else

begin

pThreadParam.Status := STATUS_SUCCESS;

Result := STATUS_SUCCESS;

WideCharToMultiByte(CP_ACP, 0,

@FileNameInfo.FileName[0], IoStatusBlock.Information,

@pThreadParam.Data[0],

MAX_PATH, nil, nil);

end;

PGetFileNameThreadParam(lpParameters)^ := pThreadParam;

ExitThread(Result);

end;

function GetFileNameFromHandle(hFile: THandle): String;

var

lpExitCode: DWORD;

pThreadParam: TGetFileNameThreadParam;

hThread: THandle;

begin

Result := '';

ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));

pThreadParam.hFile := hFile;

hThread := CreateThread(nil, 0, @GetFileNameThread, @pThreadParam, 0, PDWORD(nil)^);

if hThread <> 0 then

try

case WaitForSingleObject(hThread, 100) of

WAIT_OBJECT_0:

begin

GetExitCodeThread(hThread, lpExitCode);

if lpExitCode = STATUS_SUCCESS then

Result := pThreadParam.Data;

end;

WAIT_TIMEOUT:

TerminateThread(hThread, 0);

end;

finally

CloseHandle(hThread);

end;

function SetDebugPriv: Boolean;

var

Token: THandle;

tkp: TTokenPrivileges;

begin

Result := false;

if OpenProcessToken(GetCurrentProcess,

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then

begin

if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'),

tkp.Privileges[0].Luid) then

begin

tkp.PrivilegeCount := 1;

tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

Result := AdjustTokenPrivileges(Token, False,

tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);

end;

type

DriveQueryData = record

DiskLabel: String;

DiskDosQuery: String;

DosQueryLen: Integer;

end;

var

hFile, hProcess: THandle;

pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;

I, Drive: Integer;

ObjectTypeNumber: Byte;

FileDirectory, FilePath, ProcessName: String;

SystemInformation, TempSI: PSYSTEM_PROCESS_INFORMATION;

DosDevices: array [0..25] of DriveQueryData;

LongFileName, TmpFileName: String;

begin

SetLength(LongFileName, MAX_PATH);

GetLongPathNameA(PChar(FileName), @LongFileName[1], MAX_PATH);

for Drive := 0 to 25 do

begin

DosDevices[Drive].DiskLabel := Chr(Drive + Ord('a')) + ':';

SetLength(DosDevices[Drive].DiskDosQuery, MAXCHAR);

ZeroMemory(@DosDevices[Drive].DiskDosQuery[1], MAXCHAR);

QueryDosDevice(PChar(DosDevices[Drive].DiskLabel),

@DosDevices[Drive].DiskDosQuery[1], MAXCHAR);

DosDevices[Drive].DosQueryLen := Length(PChar(DosDevices[Drive].DiskDosQuery));

SetLength(DosDevices[Drive].DiskDosQuery, DosDevices[Drive].DosQueryLen);

end;

ObjectTypeNumber := 0;

SetDebugPriv;

hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);

if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;

try

pHandleInfo := GetInfoTable(SystemHandleInformation);

if pHandleInfo = nil then RaiseLastOSError;

try

for I := 0 to pHandleInfo^.NumberOfHandles - 1 do

if pHandleInfo^.Information[I].Handle = hFile then

if pHandleInfo^.Information[I].ProcessId = GetCurrentProcessId then

begin

ObjectTypeNumber := pHandleInfo^.Information[I].ObjectTypeNumber;

Break;

end;

finally

FreeMem(pHandleInfo);

end;

finally

CloseHandle(hFile);

end;

SystemInformation := GetInfoTable(SystemProcessesAndThreadsInformation);

if SystemInformation <> nil then

try

pHandleInfo := GetInfoTable(SystemHandleInformation);

if pHandleInfo <> nil then

try

ProgressBar1.Position := 0;

ProgressBar1.Max := pHandleInfo^.NumberOfHandles;

for I := 0 to pHandleInfo^.NumberOfHandles - 1 do

begin

if pHandleInfo^.Information[I].ObjectTypeNumber = ObjectTypeNumber then

begin

hProcess := OpenProcess(PROCESS_DUP_HANDLE, True,

pHandleInfo^.Information[I].ProcessId);

if hProcess > 0 then

try

if DuplicateHandle(hProcess, pHandleInfo^.Information[I].Handle,

GetCurrentProcess, @hFile, 0, False, DUPLICATE_SAME_ACCESS) then

try

if Application.Terminated then Exit;

FilePath := GetFileNameFromHandle(hFile);

if FilePath <> '' then

begin

FileDirectory := '';

for Drive := 0 to 25 do

if DosDevices[Drive].DosQueryLen > 0 then

if Copy(FilePath, 1, DosDevices[Drive].DosQueryLen) =

DosDevices[Drive].DiskDosQuery then

begin

FileDirectory := DosDevices[Drive].DiskLabel;

Delete(FilePath, 1, DosDevices[Drive].DosQueryLen);

Break;

end;

if FileDirectory = '' then Continue;

TempSI := SystemInformation;

repeat

if TempSI^.ProcessID =

pHandleInfo^.Information[I].ProcessId then

begin

ProcessName := TempSI^.ModuleName;

Break;

end;

TempSI := Pointer(DWORD(TempSI) + TempSI^.NextOffset);

until TempSI^.NextOffset = 0;

SetLength(TmpFileName, MAX_PATH);

GetLongPathNameA(PChar(FileDirectory + FilePath), @TmpFileName[1], MAX_PATH);

Memo1.Lines.Add(ProcessName + ': ' + TmpFileName);

end;

finally

CloseHandle(hFile);

end;

finally

CloseHandle(hProcess);

end;

ProgressBar1.Position := ProgressBar1.Position + 1;

Application.ProcessMessages;

end;

finally

FreeMem(pHandleInfo);

end;

finally

FreeMem(SystemInformation);

end;

ShowMessage('All handles found.');

end;

end.

Как узнать путь к программе, если известно ее имя

2017-11-07T01:11:33+07:00

Code:

unit Unit1;

{©Drkb v.3(}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

TlHelp32;

function GetExeFilePath(ExeFileName: String): String;

var

hSnapshot, hSnapshot2: THandle;

Proc: TProcessEntry32;

m: TModuleEntry32;

begin

Result := '';

hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);

try

proc.dwSize := Sizeof(proc);

if Process32First(hSnapshot, proc) then

repeat

if AnsiSameText(proc.szExeFile, ExeFileName) then

begin

hSnapshot2 := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,

proc.th32ProcessID);

try

m.dwSize := SizeOf(TModuleEntry32);

if Module32First(hSnapshot2, m) then

begin

Result := m.szExePath;

Exit;

end;

finally

CloseHandle(hSnapshot2);

end;

until not Process32Next(hSnapshot, proc);

finally

CloseHandle(hSnapshot);

end;

Как эмулировать нажатия клавиш в другой программе?

2017-11-06T17:06:53+07:00

Этот модуль включает две процедуры, которые эмулируют популярные Visual Basic процедуры : Sendkeys and AppActivate. SendKeys берет PChar

как первый параметр и boolean как второй. Выглядит это так:

SendKeys('KeyString', Wait);

Подробнее...

Как, зная Handle окна программы, определить имя EXE?

2017-11-07T00:43:25+07:00

Code:

function ExeNameByHandle(aWinHandle:HWND):string;

{исправлено для ©Drkb v.3}

// Для начала определяешь какому процессу принадлежит окно:

var pProcID: ^DWORD;

begin

GetMem(pProcID, SizeOf(DWORD));

GetWindowThreadProcessId(aWinHandle, pProcID);

result:=GetExeNameByProcID(pProcID^);

FreeMem(pProcID);

end;

// а после этого используешь TProcessEntry32 примерно так:

function GetExeNameByProcID(ProcID: DWord): string;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

Result := '';

while (Integer(ContinueLoop) <> 0) and (Result = '') do

begin

if FProcessEntry32.th32ProcessID = ProcID then

Result := FProcessEntry32.szExeFile;

ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

end;

// Не забудь в uses добавить Tlhelp32

Передача текста любому окну, где стоит фокус

2017-11-07T01:17:18+07:00

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

{©Drkb v.3}

var

pgui: TGUIThreadinfo;

begin

pgui.cbSize := SizeOf(TGUIThreadinfo);

GetGUIThreadInfo(GetWindowThreadProcessId(GetForegroundWindow), pgui);

SendMessage(pgui.hwndFocus, WM_SETTEXT, Length(Edit1.Text), Integer(@Edit1.Text[1]));

end

Поиск в памяти процесса

2017-11-07T01:31:59+07:00

Code:

// Поиск значения типа DWORD в указанном процессе

// paul_shmakov@mail.ru

program search;

{$APPTYPE CONSOLE}

uses Windows, SysUtils;

var

ProcessID: DWord;

ProcessHandle: THandle;

Mbi: TMemoryBasicInformation;

Addr: DWord;

Value: DWord;

I: Cardinal;

Buf: PChar;

BytesRead: DWord;

begin

if ParamCount < 2 then

begin

WriteLn('Usage: search.exe processid value');

Exit;

end;

ProcessID := StrToInt(ParamStr(1));

WriteLn('Process id: ' + IntToStr(ProcessID));

Value := StrToInt(ParamStr(2));

WriteLn('Value to search: ' + IntToStr(Value));

// Открываем процесс

ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or

PROCESS_VM_OPERATION, false, ProcessID);

if ProcessHandle <> 0 then

try

Addr := 0;

// Перечисляем все регионы виртуальной памяти процесса

while VirtualQueryEx(ProcessHandle, Pointer(Addr), Mbi, SizeOf(Mbi)) <> 0 do

begin

// Uncomment чтобы увидеть список регионов, найденых в адресном пространстве

// WriteLn('region: ' + IntToHex(Integer(Mbi.BaseAddress), 8) +

// ' size: ' + IntToStr(Mbi.RegionSize));

// Если региону выделена память, и регион не является "сторожевым" (как вершина стека),

// то читаем этот регион

if (Mbi.State = MEM_COMMIT) and not ((Mbi.Protect and PAGE_GUARD) = PAGE_GUARD) then

begin

// Это демонстрационная программа, поэтому здесь выделяется буфер под весь регион.

// Регион может быть достаточно большим, поэтому лучше читать его блоками для экономии

// памяти. Но здесь для простоты алгоритма вся оптимизация похерена.

GetMem(Buf, Mbi.RegionSize);

try

// Читаем весь регион в выделенный буфер

if ReadProcessMemory(ProcessHandle, Mbi.BaseAddress, Buf,

Mbi.RegionSize, BytesRead) then

begin

// Ищем значение типа DWORD в буфере

for I := 0 to BytesRead - SizeOf(Value) do

begin

if PDWord(@Buf[I])^ = Value then

// Найдено, выводим

WriteLn('Value ' + IntToStr(Value) + ' found at ' +

IntToHex(Integer(Cardinal(Mbi.BaseAddress) + I), 8));

end;

end

else

WriteLn('Failed to read process memory ' + IntToStr(GetLastError));

finally

FreeMem(Buf);

end;

// Вычисляем адрес следуюшего региона

Addr := Addr + Mbi.RegionSize;

end;

finally

CloseHandle(ProcessHandle);

end

else

WriteLn('Failed to open process');

end.

Подробнее...

Поиск значения типа DWORD в указанном процессе

2017-11-07T01:06:41+07:00

Code:

// paul_shmakov@mail.ru

program search;

{©Drkb v.3}

{$APPTYPE CONSOLE}

uses Windows, SysUtils;

var

ProcessID: DWord;

ProcessHandle: THandle;

Mbi: TMemoryBasicInformation;

Addr: DWord;

Value: DWord;

I: Cardinal;

Buf: PChar;

BytesRead: DWord;

begin

if ParamCount < 2 then

begin

WriteLn('Usage: search.exe processid value');

Exit;

end;

ProcessID := StrToInt(ParamStr(1));

WriteLn('Process id: ' + IntToStr(ProcessID));

Value := StrToInt(ParamStr(2));

WriteLn('Value to search: ' + IntToStr(Value));

// Открываем процесс

ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or

PROCESS_VM_OPERATION, false, ProcessID);

if ProcessHandle <> 0 then

try

Addr := 0;

// Перечисляем все регионы виртуальной памяти процесса

while VirtualQueryEx(ProcessHandle, Pointer(Addr), Mbi, SizeOf(Mbi)) <> 0 do

begin

// Uncomment чтобы увидеть список регионов, найденых в адресном пространстве

// WriteLn('region: ' + IntToHex(Integer(Mbi.BaseAddress), 8) +

// ' size: ' + IntToStr(Mbi.RegionSize));

// Если региону выделена память, и регион не является "сторожевым" (как вершина стека),

// то читаем этот регион

if (Mbi.State = MEM_COMMIT) and not ((Mbi.Protect and PAGE_GUARD) = PAGE_GUARD) then

begin

// Это демонстрационная программа, поэтому здесь выделяется буфер под весь регион.

// Регион может быть достаточно большим, поэтому лучше читать его блоками для экономии

// памяти. Но здесь для простоты алгоритма вся оптимизация похерена.

GetMem(Buf, Mbi.RegionSize);

try

// Читаем весь регион в выделенный буфер

if ReadProcessMemory(ProcessHandle, Mbi.BaseAddress, Buf,

Mbi.RegionSize, BytesRead) then

begin

// Ищем значение типа DWORD в буфере

for I := 0 to BytesRead - SizeOf(Value) do

begin

if PDWord(@Buf[I])^ = Value then

// Найдено, выводим

WriteLn('Value ' + IntToStr(Value) + ' found at ' +

IntToHex(Integer(Cardinal(Mbi.BaseAddress) + I), 8));

end;

end

else

WriteLn('Failed to read process memory ' + IntToStr(GetLastError));

finally

FreeMem(Buf);

end;

// Вычисляем адрес следуюшего региона

Addr := Addr + Mbi.RegionSize;

end;

finally

CloseHandle(ProcessHandle);

end

else

WriteLn('Failed to open process');

end.

а вот программа, в которой ведем поиск для примера:

program someprog;

{$APPTYPE CONSOLE}

uses SysUtils;

var

SomeValue: Integer;

begin

SomeValue := 12345;

WriteLn('One variable of this program has a value ' + IntToStr(SomeValue));

WriteLn('Press any key to exit');

ReadLn;

end.

Автор Rouse_

Получение SID пользователя, под которым запущен процесс

2017-11-07T01:14:08+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

end;

PTokenUser = ^TTokenUser;

TTokenUser = record

User: array[0..0] of TSIDAndAttributes;

end;

procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;

external advapi32 name 'ConvertSidToStringSidA';

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetCurrentUserSID: String;

var

TokenHandle: THandle;

TokenInformationClass: TTokenInformationClass;

TokenInformation: PTokenUser;

ReturnLength: DWORD;

StringSid: LPSTR;

begin

Result := '';

if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then

try

TokenInformationClass := TokenUser;

GetTokenInformation(TokenHandle, TokenInformationClass, nil, 0, ReturnLength);

if GetLastError = ERROR_INSUFFICIENT_BUFFER then

begin

TokenInformation := GetMemory(ReturnLength);

if TokenInformation <> nil then

try

if GetTokenInformation(TokenHandle, TokenInformationClass,

TokenInformation, ReturnLength, ReturnLength) then

begin

ConvertSidToStringSid(TokenInformation^.User[0].Sid, StringSid);

Result := StringSid;

end;

finally

FreeMemory(TokenInformation);

end;

finally

CloseHandle(TokenHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetCurrentUserSID);

end;

end.

Получение имени модуля по хендлу окна

2017-11-07T01:32:48+07:00

Code:

function GetModuleFileNameExW(hProcess:THandle; hModule:HMODULE; lpFilename:PWideChar; nSize:DWORD):DWORD; stdcall; external 'PSAPI.DLL';

function WindowGetEXE(wnd:HWND):string;

var

wt:array[0..MAX_PATH-1] of WChar;

r:integer;

prc:THandle;

prcID:cardinal;

begin

result:='';

if GetWindowThreadProcessID(wnd,prcID)<>0 then

begin

prc:=OpenProcess(PROCESS_ALL_ACCESS,false,prcID);

if prc<>0 then

try

r:=GetModuleFileNameExW(prc,GetWindowLong(wnd,GWL_HINSTANCE),wt,MAX_PATH*2);

if r=0 then r:=GetModuleFileNameExW(prc,0,wt,MAX_PATH*2);

if r<>0 then result:=wt;

finally

CloseHandle(prc)

end

end;

function SetProcessDebugPrivelege:boolean;

var

hToken:THandle;

tp:TTokenPrivileges;

rl:cardinal;

begin

result:=false;

if not OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES,hToken) then exit;

try

if not LookupPrivilegeValue(nil,'SeDebugPrivilege', tp.Privileges[0].Luid) then exit;

tp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;

tp.PrivilegeCount:=1;

result:=AdjustTokenPrivileges(hToken,false,tp,0,nil,rl) and (GetLastError=0)

finally

CloseHandle(hToken);

end

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SetProcessDebugPrivelege;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(WindowGetExe(hWnd))

end;

PS только для NT4 и выше. Для Win9x юзать GetWindowModuleFileName.

Получить текст окна, где этого не может WM_GETTEXT

2017-11-07T01:08:42+07:00

Она может брать текст, где этого не может делать GetWindowText(), вот собственно и все!

Должна работать на всех win, но небыло возможности проверить.... =)

Так что кому надо... Отдельное спасибо .alex'у

Подробнее...

Послать Alt + буква другому приложению

2017-11-07T01:03:21+07:00

Как мне программно нажать ALT + буква(VK_...) в другом приложении. Хендл я нашел, деляю так

SendMessage(Handle_, WM_KEYDOWN, VK_MENU,0);

SendMessage(Handle_, WM_KEYDOWN, VK_F1,0);

SendMessage(Handle_, WM_KEYUP, VK_F1,0);

но у меня не получается, что не так?

Попробуй так

Code:

SendMessage(Handle,WM_KEYDOWN,Byte(C),$20000001);

Пример EnumWindows

2017-11-07T00:45:48+07:00

Создайте форму и разместите на ней два компонента ListBox.

Скопируйте код, показанный ниже.

Запустите SysEdit.

Запустите форму Delphi. Первый ListBox должен содержать список всех запущенных приложений. Дважды щелкните на SysEdit и нижний ListBox покажет дочернее MDI-окно программы SysEdit.

Paul Powers (Borland)

Подробнее...

Пример процедуры убивающей таймеры по заголовку окна в чужих приложениях написанных на Delphi

2017-11-07T01:10:21+07:00

Code:

var

Hinst : THandle;

WndArr : array of THandle;

Wnd : THandle;

......

Procedure KillDelphiWndTimers(const AppCaption:string);

var i : integer;

function GetTimerWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;

const

sClName ='TPUtilWindow';

var

s : String;

begin

Result := True;

SetLength(s,Length(sClName)+1);

GetClassName(Handle, PChar(s),Length(s));

SetLength(s,Length(sClName)); // E?aeo caieoeaaou neaie #0 :)

if (GetWindowLong(Handle, GWL_HINSTANCE) = Hinst ) and (s=sClName)

then

begin

SetLength(WndArr,High(WndArr)+2);

WndArr[High(WndArr)]:=Handle;

end;

begin

Wnd:=FindWindow(nil,Pchar(AppCaption));

if Wnd=0 then Exit;

hinst:=GetWindowLong(Wnd, GWL_HINSTANCE);

EnumWindows(@GetTimerWindows,0);

for i:=0 to High(WndArr) do KillTimer(WndArr[i],1);

end;

Проверить приложение на зависание?

2017-11-07T00:52:22+07:00

Приложение может проверить, если окно отвечает на сообщения путем отправки сообщения WM_NULL с функцией SendMessageTimeout

Подробнее...

Список окон + определение приложения, создавшего эти окна

2017-11-07T01:30:53+07:00

Code:

////////////////////////////////////////////////////////////////////////////////

// Автор: Александр (Rouse_) Багель

// Данный код приведен лишь для демонстрации

// А простой вариант поиска Handle Ричедита выглядит так

// var

// Handle : HWND;

// begin

// Handle:= FindWindowEx(FindWindow(Название формы например 'Form1',nil), 0, Название элемента например 'Button1', nil), 0, true);

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls;

type

TMainForm = class(TForm)

TreeView1: TTreeView;

procedure FormCreate(Sender: TObject);

procedure Sys_Windows_Tree(Node: TTreeNode; Handle: HWND);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

////////////////////////////////////////////////////////////////////////////////

// Стартовая функция, запускаем рекуссию используя хэндл рабочего стола

procedure TMainForm.FormCreate(Sender: TObject);

var

StartHandle : THandle;

begin

//Если требуется найти только данные по одному приложению

//замени 2 строки в функциях их закоментированными аналогами

StartHandle := GetDeskTopWindow;

//StartHandle := 67324;//FindWindow(PChar(Caption), nil); //На примере Винампа

Sys_Windows_Tree(nil, StartHandle);

end;

////////////////////////////////////////////////////////////////////////////////

// Рекурсивная функция, строит дерево всех открытых окон, кнопок, едитов и т.д.

// В качестве входных данных получает узел дерева и Хэндл окна

procedure TMainForm.Sys_Windows_Tree(Node: TTreeNode; Handle: HWND);

const

MAX = 128;

var

TmpArray : array[0..MAX - 1] of Char;

Result : String;

szFileName : array[0..255] of Char;

iSize : Integer;

PID: Cardinal;

begin

//Запускаем цикл пока не закончатся окна

while Handle <> 0 do

begin

//Получаем имя класса окна

GetClassName(Handle, @TmpArray, MAX);

Result := String(TmpArray);

//Получаем текст (Его Caption) окна

GetWindowText(Handle, @TmpArray, MAX);

// Получаем имя модуля

if GetwindowModuleFilename(Handle, szFileName, SizeOf(szFileName)) = 0 then

ZeroMemory(@szFileName[0], 256);

GetWindowThreadProcessId(Handle, PID);

Result := Result + ' [' + String(szFileName) + '] (' + String(TmpArray) +

'): Handle = '+ IntToStr(Handle) + ', PID = ' + IntToStr(PID);

//В следующей процедуре, в скобках, добавляем результат

//в дерево, получаем хэндл дочернего окна и с результатами

//выполнения этих двух функций выполняем процедуру Sys_Windows_Tree

Sys_Windows_Tree(TreeView1.Items.AddChild(Node, Result),

GetWindow(Handle, GW_CHILD));

//Получаем хэндл следующего (не дочернего) окна

Handle := GetNextWindow(Handle, GW_HWNDNEXT);

//Handle := 0;

end;

end.

Требуется нажать в другом приложении пару кнопок?

2017-11-07T00:07:28+07:00

Требуется нажать в "другом" приложении пару кнопок (button). (кнопки не имеют hotkeys). Ищу окно так (Дельфи):

Code:

if FindWindow(nil, 'Advanced Dialer')<> 0 then

ShowMessage('OK');

Подробнее...

Убиваем активное приложение

2017-11-06T16:38:35+07:00

Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.

Code:

procedure KillProgram(Classname : string; WindowTitle : string);

const

PROCESS_TERMINATE = $0001;

var

ProcessHandle : THandle;

ProcessID: Integer;

TheWindow : HWND;

begin

TheWindow := FindWindow(Classname, WindowTitle);

GetWindowThreadProcessID(TheWindow, @ProcessID);

ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);

TerminateProcess(ProcessHandle,4);

end;

Подробнее...

Установка/снятие Debug привелегии у текущего процесса

2017-11-07T02:14:20+07:00

Пример использования:

Code:

// После этого можно смотреть информация о таких системных модулях как:

//winlogon.exe и servises.exe и д.р.

EnableDebugPrivilege(True); // вкрючить

EnableDebugPrivilege(False); // выключить

Подробнее...

Функция передачи строк (а заодно и числа) между программами через SendMessage:

2017-11-07T02:06:17+07:00

Code:

Function SendString(TargetWnd, SourceWnd: THandle; N: Integer; Const S: String): Integer;

Var

CD: TCopyDataStruct;

Begin

CD.dwData := N;

CD.cbData := Length(S);

If CD.cbData = 0 Then

CD.lpData := NIL

Else CD.lpData := @S[1];

Result := SendMessage(TargetWnd, WM_COPYDATA, SourceWnd, Integer(@CD));

End;

...

Procedure WMCopyData(Var Msg: TWMCopyData); Message WM_COPYDATA;

...

Procedure TForm1.WMCopyData(var Msg: TWMCopyData);

Var

{ Строка }

S: String;

{ Число }

N: Integer;

Begin

If (Msg.CopyDataStruct^).lpData = NIL Then S := '';

SetLength(S,Msg.CopyDataStruct^.cbData);

S := String((Msg.CopyDataStruct^).lpData);

N := (Msg.CopyDataStruct^).dwData;

End;

Автор: Rrader

Читаем заголовок exe файла

2017-11-07T00:06:15+07:00

Вам потребуется OpenDialog для открытия ехе-файлов и Memo для показа информации о файле.

Подробнее...