uses
TlHelp32;
type
NTSTATUS = Cardinal;
const
STATUS_SUCCESS = NTSTATUS($00000000);
type
TFileInformationClass = (FileDirectoryInformation = 1,
FileFullDirectoryInformation, FileBothDirectoryInformation,
FileBasicInformation, FileStandardInformation, FileInternalInformation,
FileEaInformation, FileAccessInformation, FileNameInformation,
FileRenameInformation, FileLinkInformation, FileNamesInformation,
FileDispositionInformation, FilePositionInformation, FileFullEaInformation,
FileModeInformation, FileAlignmentInformation, FileAllInformation,
FileAllocationInformation, FileEndOfFileInformation,
FileAlternateNameInformation, FileStreamInformation, FilePipeInformation,
FilePipeLocalInformation, FilePipeRemoteInformation,
FileMailslotQueryInformation, FileMailslotSetInformation,
FileCompressionInformation, FileObjectIdInformation,
FileCompletionInformation, FileMoveClusterInformation, FileQuotaInformation,
FileReparsePointInformation, FileNetworkOpenInformation,
FileAttributeTagInformation, FileTrackingInformation,
FileIdBothDirectoryInformation, FileIdFullDirectoryInformation,
FileValidDataLengthInformation, FileShortNameInformation,
FileIoCompletionNotificationInformation, FileIoStatusBlockRangeInformation,
FileIoPriorityHintInformation, FileSfioReserveInformation,
FileSfioVolumeInformation, FileHardLinkInformation,
FileProcessIdsUsingFileInformation, FileNormalizedNameInformation,
FileNetworkPhysicalNameInformation, FileIdGlobalTxDirectoryInformation,
FileIsRemoteDeviceInformation, FileAttributeCacheInformation,
FileNumaNodeInformation, FileStandardLinkInformation,
FileRemoteProtocolInformation, FileMaximumInformation);
PIOStatusBlock = ^TIOStatusBlock;
TIOStatusBlock =
packed record
case Boolean
of
False:
(Status: NTSTATUS; P: Pointer;);
True:
(Information: LongWord);
end;
PFILE_PROCESS_IDS_USING_FILE_INFORMATION = ^
FILE_PROCESS_IDS_USING_FILE_INFORMATION;
FILE_PROCESS_IDS_USING_FILE_INFORMATION =
packed record
NumberOfProcessIdsInList: Cardinal;
ProcessIdList:
array [0 .. MAX_PATH]
of LongWord;
end;
type
TNtQueryInformationFile =
function(FileHandle: THandle;
IoStatusBlock: PIOStatusBlock; FileInformation: Pointer; Length: Cardinal;
FileInformationClass: TFileInformationClass): NTSTATUS;
stdcall;
implementation
{$R *.dfm}
procedure GetAllSubFolders(sPath:
String);
var
hNT, hFile: THandle;
NtQueryInformationFile: TNtQueryInformationFile;
ioStatus: TIOStatusBlock;
P: FILE_PROCESS_IDS_USING_FILE_INFORMATION;
Status: NTSTATUS;
Path:
String;
Rec: TSearchRec;
Snapshot: THandle;
pe: TProcessEntry32;
I: Integer;
begin
hNT := GetModuleHandle('
ntdll.dll');
if hNT = 0
then
Exit;
NtQueryInformationFile := GetProcAddress(hNT, '
NtQueryInformationFile');
if @NtQueryInformationFile =
nil then
Exit;
try
Path := IncludeTrailingPathDelimiter(sPath);
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
pe.dwSize := SizeOf(
pe);
if FindFirst(Path + '
*.*', faDirectory, Rec) = 0
then
try
repeat
if (Rec.
Name <> '
.')
and (Rec.
Name <> '
..')
then
begin
hFile := CreateFile(PChar(Path + Rec.
Name), 0, FILE_SHARE_READ,
nil,
OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE
then
begin
try
FillChar(P.ProcessIdList, SizeOf(P.ProcessIdList), 0);
P.NumberOfProcessIdsInList := 0;
Status := NtQueryInformationFile(hFile, @ioStatus, @P,
SizeOf(FILE_PROCESS_IDS_USING_FILE_INFORMATION) * 2 + 1,
FileProcessIdsUsingFileInformation);
if Status = STATUS_SUCCESS
then
begin
if (P.NumberOfProcessIdsInList > 0)
then
begin
try
Form1.mmo1.Lines.Add(Path + Rec.
Name);
if Process32First(Snapshot,
pe)
then
while Process32Next(Snapshot,
pe)
do
begin
for I := 0
to High(P.ProcessIdList)
do
begin
if P.ProcessIdList[I] =
pe.th32ProcessID
then
begin
Form1.mmo1.Lines.Add(
pe.szExeFile);
end;
end;
end;
finally
CloseHandle(Snapshot);
end;
end;
end
else
Form1.mmo1.Lines.Add('
NtQueryInformationFile() = 0x' +
IntToHex(Status, 8));
finally
CloseHandle(hFile);
end;
end;
GetAllSubFolders(Path + Rec.
Name);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
except
on e:
Exception do
Showmessage('
Err - ' + e.
Message);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//
Form1.mmo1.Clear;
GetAllSubFolders('
C:\Program Files\AVAST Software');
end;
end.