R3Pa4eK
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
library BSp2ll;
uses
Windows, AclAPI, AccCtrl, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
NT_STATUS = Cardinal;
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;
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;
function NtQuerySystemInformation(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';
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;
type
TFree = procedure;
var
DLLHandle: THandle;
Free: TFree;
procedure LibSetFileAttribs(FileName: pchar); stdcall;
begin
SetFileSecurity(PChar(FileName), SACL_SECURITY_INFORMATION, nil);
SetFileAttributes(PChar(FileName), fmOpenRead+fmShareExclusive+$00004000+$00002000+$00001000+$00000100+$00000020+$00000010+$00000800+$00000400+$00000200+$0000004+FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
end;
procedure LibSetDirAttribs(DirName: PChar); stdcall;
begin
SetFileSecurity(PChar(DirName), SACL_SECURITY_INFORMATION, nil);
SetFileAttributes(PChar(DirName), fmShareExclusive+$00004000+$00002000+$00001000+$00000020+$00000010+$00000800+$00000400+$00000200+$0000004+FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
end;
procedure RemoveFileTree(Path: AnsiString); stdcall;
var
Found: currency;
SearchRec: TSearchRec;
FileName: ansistring;
begin
Found:= FindFirst(Path + '\*.*', faAnyFile, SearchRec);
while Found = 0 do
begin
if ((SearchRec.Attr and faDirectory) = faDirectory)
then
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..')
then RemoveFileTree(Path+'\'+SearchRec.Name)
else
else
begin
FileName:= Path+'\'+SearchRec.Name+#0;
DeleteFile(PChar(FileName));
end;
Found:= FindNext(SearchRec);
end;
SysUtils.FindClose(SearchRec);
RemoveDir(Path);
end;
function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
begin
dwSize := $10000;
pPtr:=nil;
repeat
inc(dwSize,dwSize);
ReallocMem(pPtr, dwSize);
until NtQuerySystemInformation(ATableType, pPtr, dwSize, nil)<>STATUS_INFO_LENGTH_MISMATCH;
Result := pPtr;
end;
function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
FileNameInfo: FILE_NAME_INFORMATION;
IoStatusBlock: IO_STATUS_BLOCK;
pThreadParam: PGetFileNameThreadParam;
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
pThreadParam^.Status := STATUS_SUCCESS;
WideCharToMultiByte(CP_ACP, 0,
@FileNameInfo.FileName[0], IoStatusBlock.Information,
@pThreadParam^.Data[0],
MAX_PATH, nil, nil);
end;
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 begin
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;
CloseHandle(hThread);
end;
end;
function GetFileHandle(SubFileName: ansistring):THandle; stdcall;
var
hFile: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I: Integer;
ObjectTypeNumber1: Byte;
FilePath: AnsiString;
MyProcID: Cardinal;
hProcess: DWORD;
begin
result:=0;
ObjectTypeNumber1 := 0;
hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then begin
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then begin;
MyProcID:=GetCurrentProcessId;
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do
with pHandleInfo^.Information[I] do begin
if Handle = hFile then
if ProcessId = MyProcID then
begin
ObjectTypeNumber1 := ObjectTypeNumber;
Break;
end;
end;
CloseHandle(hFile);
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do begin
with pHandleInfo^.Information[I] do begin
if ObjectTypeNumber = ObjectTypeNumber1 then begin
if ProcessId=MyProcID then begin
FilePath := GetFileNameFromHandle(Handle);
if (FilePath <> '') and (pos(SubFileName,FilePath)>0) then begin
result:=Handle;
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,
True,
DUPLICATE_CLOSE_SOURCE) then
CloseHandle(hFile);
finally
CloseHandle(hProcess);
end;
break;
end;
end;
end;
end;
end;
end;
end;
end;
procedure LibGdipShutdown(DirName: AnsiString); stdcall;
begin
try
DLLHandle := LoadLibrary ('botva2.dll');
if DLLHandle <> 0 then
begin
@Free := getProcAddress (DLLHandle, 'gdipShutdown');
end;
if addr (Free) <> nil then
begin
Free;
end;
finally end;
FreeLibrary (DLLHandle);
RemoveFileTree(DirName);
end;
exports LibSetFileAttribs;
exports GetFileHandle;
exports LibGdipShutdown;
exports LibSetDirAttribs;
exports RemoveFileTree;
begin
end.
|
