Windows

Code:

PostThreadMessage(AnotherProg_MainThreadID,WM_CLOSE,0,0);

PostMessage(AnotherProg_MainWindow,WM_CLOSE,0,0);

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;

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;

     end;

     if bSuccess then

     begin

       FreeMem(ptiUser);

     end;

   end;

   CloseHandle(ProcessHandle);

end;

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;

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;

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;

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;

   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;

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;

   end;

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;

       end;

       ProgressBar1.Position := ProgressBar1.Position + 1;

       Application.ProcessMessages;

     end;

   finally

     FreeMem(pHandleInfo);

   end;

finally

   FreeMem(SystemInformation);

end;

ShowMessage('All handles found.');

end;

end.