Опытный
Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005
Репутация: 18
Всего: 29
|
Цитата(Nickel @ 1.6.2006, 09:54  ) | | Ещё немного поправил в предыдущем посте |
Дык не работает же  | Цитата(Nickel @ 1.6.2006, 09:54 ) | | Случайно не подскажите, по-моему под 2000 OB_TYPE_FILE = 23? |
Вот тебе код библиотеки которая ищет процесс заблокировавший доступ к файлу: | Код |
library findlock;
{$R 'resources.res' 'resources.rc'}
uses
Windows,
Messages,
SysUtils,
CommCtrl;
resourcestring
TXT_CAPTION = 'Поиск процессов.';
TXT_CANCEL = 'Отмена';
TXT_STATUS1 = 'Ошибка копирования данных.' + #13#10 +
'Файл заблокирован другим процессом.' + #13#10 +
'Копируемый файл: ';
TXT_STATUS2 = #13#10 + 'Производиться поск процесса заблокировавшего файл.';
const
BTN_APPLY_ID = 100;
BTN_CANCEL_ID = 105;
EDIT_ID = 110;
WM_THREAD_END = WM_USER + 1234;
WM_IS_THREAD_STOP = WM_USER + 1235;
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;
PRootThread = ^TRootThread;
TRootThread = packed record
FileName: array [0..MAX_PATH - 1] of Char;
Progress: THandle;
MainWnd: THandle;
Stop: Boolean;
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;
var
NtQuerySystemInformation: function(ASystemInformationClass: DWORD;
ASystemInformation: Pointer; ASystemInformationLength: DWORD;
AReturnLength: PDWORD): NT_STATUS; stdcall;
NtQueryInformationFile: function(FileHandle: THandle;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
stdcall;
NtQueryObject: function(ObjectHandle: THandle;
ObjectInformationClass: DWORD; ObjectInformation: Pointer;
ObjectInformationLength: ULONG;
ReturnLength: PDWORD): NT_STATUS; stdcall;
function GetLongPathNameA(lpszShortPath, lpszLongPath: PChar;
cchBuffer: DWORD): DWORD; stdcall; external kernel32;
var
MainWindow : TWndClassEx;
Handle,
hFontNormal,
btnOk,
Label1,
Progress,
Icon,
hRootThread : HWND;
Msg : TMsg;
Left,
Top,
Width,
Height : Integer;
bLibLoaded,
bStop : BOOL;
hLib : THandle;
RootThreadData: TRootThread;
RootResult : Boolean;
function RootThread(lpParameters: Pointer): DWORD; stdcall;
function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
ntStatus: NT_STATUS;
begin
Result := nil;
dwSize := WORD(-1);
GetMem(pPtr, dwSize);
ntStatus := NtQuerySystemInformation(ATableType, pPtr, dwSize, nil);
while ntStatus = STATUS_INFO_LENGTH_MISMATCH do
begin
dwSize := dwSize * 2;
ReallocMem(pPtr, dwSize);
ntStatus := NtQuerySystemInformation(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;
ThreadData: TRootThread;
LongFileName: String;
begin
ThreadData := PRootThread(lpParameters)^;
CharUpper(@ThreadData.FileName[0]);
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
begin
PostMessage(ThreadData.MainWnd, WM_THREAD_END, 1, 0);
CloseHandle(hFile);
ExitThread(1);
end;
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;
Result := 1;
try
SystemInformation := GetInfoTable(SystemProcessesAndThreadsInformation);
if SystemInformation <> nil then
try
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then
try
SendMessage(ThreadData.Progress, PBM_SETPOS, 0, 0);
SendMessage(Progress, PBM_SETRANGE, 0,
MAKELPARAM(0, pHandleInfo^.NumberOfHandles));
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 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 SendMessage(ThreadData.MainWnd, WM_IS_THREAD_STOP, 0, 0) = 1 then
begin
Result := 2;
Exit;
end;
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(LongFileName, MAX_PATH);
GetLongPathNameA(PChar(FileDirectory + FilePath), @LongFileName[1], MAX_PATH);
LongFileName := AnsiUpperCase(LongFileName);
if String(ThreadData.FileName) = PChar(LongFileName) then
begin
SetWindowPos(ThreadData.MainWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE);
MessageBox(0, PChar('Обнаружен процесс заблокировавший доступ к файлу: ' +
ProcessName + sLineBreak +
'Завершите данный процесс и начните установку заново.'),
'Поиск завершен', MB_OK or MB_ICONINFORMATION);
Result := 0;
Exit;
end;
end;
finally
CloseHandle(hFile);
end;
finally
CloseHandle(hProcess);
end;
end;
SendMessage(ThreadData.Progress, PBM_SETPOS,
pHandleInfo^.NumberOfHandles - DWORD(I), 0);
end;
finally
FreeMem(pHandleInfo);
end;
finally
FreeMem(SystemInformation);
end;
SetWindowPos(ThreadData.MainWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE);
MessageBox(0, PChar('Процесс заблокировавший доступ к файлу не обнаружен.')
, 'Поиск завершен', MB_OK or MB_ICONINFORMATION);
Result := 4;
finally
PostMessage(ThreadData.MainWnd, WM_THREAD_END, Result, 0);
ExitThread(Result);
end;
end;
function CreateFindThread(FileName: PChar): Boolean;
var
ThreadID: DWORD;
begin
bStop := False;
Move(FileName^, RootThreadData.FileName, Length(FileName));
RootThreadData.Progress := Progress;
RootThreadData.Stop := bStop;
RootThreadData.MainWnd := Handle;
hRootThread := CreateThread(nil, 0, @RootThread, @RootThreadData, 0, ThreadID);
Result := hRootThread <> 0;
end;
procedure CenterMainForm;
var
ScrWidth, ScrHeight: Cardinal;
begin
ScrWidth := GetSystemMetrics(SM_CXSCREEN);
ScrHeight := GetSystemMetrics(SM_CYSCREEN);
Left := (Integer(ScrWidth) - Width) div 2;
Top := (Integer(ScrHeight) - Height) div 2;
end;
function WindowProc(Wnd: HWND; Msg: Integer;
WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
Result := 0;
case Msg of
WM_IS_THREAD_STOP:
Result := Integer(RootThreadData.Stop);
WM_THREAD_END:
begin
RootResult := WParam in [0, 2, 4];
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
WM_COMMAND:
begin
case LoWord(WParam) of
BTN_CANCEL_ID: // Нажатие на кнопку "Отмена"
begin
RootThreadData.Stop := True;
Result := 0;
end;
end;
end;
else
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;
end;
function InitNTDLL: Boolean;
begin
Result := False;
bLibLoaded := False;
hLib := GetModuleHandle('ntdll.dll');
if hLib <= HINSTANCE_ERROR then
begin
hLib := LoadLibrary('ntdll.dll');
if hLib <= HINSTANCE_ERROR then Exit;
bLibLoaded := True;
end;
try
@NtQuerySystemInformation := GetProcAddress(hLib, 'NtQuerySystemInformation');
if not Assigned(NtQuerySystemInformation) then Abort;
@NtQueryInformationFile := GetProcAddress(hLib, 'NtQueryInformationFile');
if not Assigned(NtQueryInformationFile) then Abort;
@NtQueryObject := GetProcAddress(hLib, 'NtQueryObject');
if not Assigned(NtQueryObject) then Abort;
Result := True;
except
NtQuerySystemInformation := nil;
NtQueryInformationFile := nil;
NtQueryObject := nil;
if bLibLoaded then
FreeLibrary(hLib);
end;
end;
function ShowLockedProceses(Parent: THandle; FileName: PChar): Boolean; stdcall;
var
TextWidth: TSize;
DC: HDC;
LongFileName: String;
begin
SetLength(LongFileName, MAX_PATH);
GetLongPathNameA(FileName, @LongFileName[1], MAX_PATH);
Result := False;
RootResult := False;
if InitNTDLL then
try
// Инициализируем оконный класс
with MainWindow do
begin
cbSize := SizeOf(MainWindow);
style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_BTNFACE + 1;
lpszMenuName := nil;
lpszClassName := 'FindLockedProcess';
end;
MainWindow.hInstance := HInstance;
// Регистрируем оконный класс
if RegisterClassEx(MainWindow) = 0 then Exit;
// Подготавливаем координаты для центрирования формы
Width := 360;
DC := GetDC(Parent);
try
GetTextExtentPoint32(DC, PChar('Копируемый файл: ' +FileName),
Length(FileName) + 17, TextWidth);
finally
ReleaseDC(Parent, DC);
end;
if TextWidth.cx > Width then
Width := TextWidth.cx + 20;
Height := 172;
CenterMainForm;
// Создаем форму
Handle := CreateWindowEx(WS_EX_CONTROLPARENT, 'FindLockedProcess',
PChar(TXT_CAPTION), WS_OVERLAPPED or WS_SYSMENU,
Left, Top, Width, Height, 0, 0, HInstance, nil);
// Создаем кнопку "Отмена"
btnOk := CreateWindow('BUTTON', PChar(TXT_CANCEL),
BS_PUSHBUTTON or WS_CHILD or WS_VISIBLE,
(Width - 75) div 2, 107, 75, 25, Handle, BTN_CANCEL_ID, hInstance, nil);
// Создаем Label
Label1 := CreateWindow('STATIC', PChar(TXT_STATUS1 + FileName + TXT_STATUS2),
WS_VISIBLE or WS_CHILD, 52, 13, Width - 20, 56, Handle, 0, hInstance, nil);
Icon := CreateWindow('STATIC', 'ERROR',
SS_ICON or WS_VISIBLE or WS_CHILD, 12, 20, 32, 32, Handle, 0, hInstance, nil);
// Создаем нужный шрифт
hFontNormal := CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
// назначаем этот шрифт всем оконным элементам
if hFontNormal <> 0 then
SendMessage(Handle, WM_SETFONT, hFontNormal, 0);
begin
SendMessage(btnOk, WM_SETFONT, hFontNormal, 0);
SendMessage(Label1, WM_SETFONT, hFontNormal, 0);
end;
// Создаем ProgressBar
InitCommonControls;
Progress := CreateWindowEx(0, 'msctls_progress32', '', WS_CHILD or WS_VISIBLE,
10, 80, Width - 30, 17, Handle, 0, HInstance, nil);
// Показываем окно
ShowWindow(Handle, SW_SHOW);
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE);
if not CreateFindThread(FileName) then Exit;
// Начинаем крутить цикл выборки сообщений
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
if Msg.message = WM_CLOSE then Exit;
end;
finally
UnregisterClass('FindLockedProcess', HInstance);
if bLibLoaded then
FreeLibrary(hLib);
Result := RootResult;
end;
end;
exports
ShowLockedProceses;
begin
end.
|
|
Как очистить файл который используется ? 
Дата 28.5.2006, 17:54 (
Загрузка ...
Случайно не подскажите, по-моему под 2000 OB_TYPE_FILE = 23? 
