VPF::Как очистить файл который используется ?

MastaSlash

Дата 28.5.2006, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 26.5.2006

Репутация: нет
Всего: нет

Подскажите, как очистить файл который используется каким-то приложением ???? (зная путь к нему).

Snowy

Дата 28.5.2006, 17:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Очистить - никак.
Можно заменить на другой.
http://forum.vingrad.ru/index.php?act=Sear...05&skipped=

Mechanic

Дата 28.5.2006, 18:14 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 228
Регистрация: 5.5.2006
Где: Kharkov, Ukraine

Репутация: 1
Всего: 7

Открыть для записи, очистить, закрыть.
Только при открытии использовать флажки fmSharexxx.

И не факт, что получится. Может получиться, только если файл открыт без fmShareDenyWrite или fmShareExclusive.

Например, если нажимать F3 на файле в 2х популярных ранее оболочках Volkov Commander и Norton Commander (5.0), то можно увидеть, что первый при открытии файла разрешает в него запись, но второй - нет.

--------------------

Tell me the extensions of the files You backup and I'll tell You who You are.. ©Mch

Nickel

Дата 28.5.2006, 18:45 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 7.2.2006

Репутация: 2
Всего: 4

http://forum.vingrad.ru/index.php?showtopi...st&p=706816
Тока делай DuplicateHandle без флага DUPLICATE_CLOSE_SOURCE, и через полученный хендл работай с файлом как хочешь.

BinaryEvil

Дата 28.5.2006, 19:44 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 98
Регистрация: 4.3.2006

Репутация: -1
Всего: 2

убей использующее файл приложение

Rouse_

Дата 29.5.2006, 21:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

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

Цитата

CreateFile

...

dwShareMode
[in] Sharing mode of the object. You cannot request a sharing mode that conflicts with the access mode specified in a previous open request whose handle is still open.
If this parameter is zero and CreateFile succeeds, the object cannot be shared and cannot be opened again until the handle is closed. For more information about sharing violations, see the Remarks section.

To enable other processes to share the object while your process has it open, use a combination of one or more of the following values to specify the type of access they can request when they open the object. These sharing options remain in effect until you close the handle to the object.

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

Nickel

Дата 30.5.2006, 10:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 7.2.2006

Репутация: 2
Всего: 4

Цитата(Rouse_ @ 29.5.2006, 21:48)

Несмотря на обилие предположений - никак...

Я всё-таки настаиваю рассмотреть моё предположение:

Код


type
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;

PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
end;

TObjectInformationClass = (OBJECT_BASIC_INFORMATION,
                            OBJECT_NAME_INFORMATION,
                            OBJECT_TYPE_INFORMATION,
                            OBJECT_ALL_INFORMATION,
                            OBJECT_DATA_INFORMATION);

const OB_TYPE_FILE             =  28;
      SystemHandleInformation  =    16;

function ZwQueryObject(ObjectHandle: THandle;
  ObjectInformationClass: TObjectInformationClass; ObjectInformation:Pointer;
  Length: ULONG; ReturnLength: PULONG): cardinal; stdcall;
  external 'ntdll.dll';

Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): cardinal;
                                  stdcall;external 'ntdll.dll';


function GetSystemHandleTable : Pointer;
var mSize : dword;
    mPtr  : pointer;
    St    : cardinal;
begin
  Result := nil;
  mSize := $4000;
  repeat
    mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if mPtr = nil then Exit;
    St := ZwQuerySystemInformation(SystemHandleInformation, mPtr, mSize, nil);
    if St = cardinal($C0000004) then
       begin
         VirtualFree(mPtr, 0, MEM_RELEASE);
         mSize := mSize * 2;
       end;
  until St <> cardinal($C0000004);
  if St = 0
    then Result := mPtr
    else VirtualFree(mPtr, 0, MEM_RELEASE);
end;

function ExtractDriveAndPath(FileName:string; var Drive, Path :string) : Boolean;
var p:integer;
begin
 p:=Pos(':'+PathDelim, FileName);
 if p<>0 then
  begin
   Drive := Copy(FileName,1,p);
   Path := Copy(FileName, p + 1, Length(FileName) - p);
   Result := True;
  end
 else Result := False;
end;

function ClearFile(FileName:string) : Boolean;
var Inf            : PSYSTEM_HANDLE_INFORMATION_EX;
    Process,h,i    : cardinal;
    p              : pointer;
    Device         : array[0..max_path] of char;
    Drive,  Path,
    PathWithDevice : string;
begin
  Result := False;
  p := VirtualAlloc(nil, MAX_PATH, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  if not ExtractDriveAndPath(FileName, Drive, Path) then Exit;
  QueryDosDevice(PChar(Drive), @Device, SizeOf(Device));
  PathWithDevice := Device + Path;
  Inf := GetSystemHandleTable;
  for i:=0 to Inf.NumberOfHandles-1 do
   begin
    if Inf.Information[i].ObjectTypeNumber = OB_TYPE_FILE then
     begin
      Process := OpenProcess(PROCESS_DUP_HANDLE, False, Inf.Information[i].ProcessId);
      DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                                  @h, 0, False, DUPLICATE_SAME_ACCESS);
      ZwQueryObject(h, OBJECT_NAME_INFORMATION, p, MAX_PATH, nil);
      if PathWithDevice = WideCharToString(TUnicodeString(p^).Buffer) then
        begin
         CloseHandle(h);
         DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                    @h, GENERIC_WRITE, False, 0);
         SetFilePointer(h, 0, nil, FILE_BEGIN);
         if SetEndOfFile(h) then Result:=True;
        end;
    ZeroMemory(p, MAX_PATH);
    CloseHandle(h);
    CloseHandle(Process);
   end;
  end;
end;

Но у этого кода есть один неисправимый недостаток - провисание на пайпах, можно конечно выделить ZwQueryObject в отдельный поток, но тогда этот поток нельзя будет завершить до уничтожения пайпа, на котором он повис (либо до завершения операции IO с этим пайпом, что не факт, что произойдёт).

Цитата(Rouse_ @ 29.5.2006, 21:48)

Кстати, на все вышеописанные советы есть простое решение:

Цитата(MastaSlash @ 28.5.2006, 17:54)

Подскажите, как очистить файл который используется каким-то приложением ???? (зная путь к нему).

Если я правильно понимаю MastaSlash'a, то приложение, которое открывает файл не самописное, и даже более того, неизветсно что это за приложение вообще. Конечно как вазиант можно перехватить CreateFile и делать с полученным хендлом что угодно.

Rouse_

Дата 30.5.2006, 12:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Цитата(Nickel @ 30.5.2006, 11:29

)

Я всё-таки настаиваю рассмотреть моё предположение:

Да пожалуйста...

Код


unit Unit15;

interface

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

type
  TForm15 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

type
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;

PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
end;

TObjectInformationClass = (OBJECT_BASIC_INFORMATION,
                            OBJECT_NAME_INFORMATION,
                            OBJECT_TYPE_INFORMATION,
                            OBJECT_ALL_INFORMATION,
                            OBJECT_DATA_INFORMATION);

const OB_TYPE_FILE             =  28;
      SystemHandleInformation  =    16;

function ZwQueryObject(ObjectHandle: THandle;
  ObjectInformationClass: TObjectInformationClass; ObjectInformation:Pointer;
  Length: ULONG; ReturnLength: PULONG): cardinal; stdcall;
  external 'ntdll.dll';

Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): cardinal;
                                  stdcall;external 'ntdll.dll';


var
  Form15: TForm15;

implementation

{$R *.dfm}

function GetSystemHandleTable : Pointer;
var mSize : dword;
    mPtr  : pointer;
    St    : cardinal;
begin
  Result := nil;
  mSize := $4000;
  repeat
    mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if mPtr = nil then Exit;
    St := ZwQuerySystemInformation(SystemHandleInformation, mPtr, mSize, nil);
    if St = cardinal($C0000004) then
       begin
         VirtualFree(mPtr, 0, MEM_RELEASE);
         mSize := mSize * 2;
       end;
  until St <> cardinal($C0000004);
  if St = 0
    then Result := mPtr
    else VirtualFree(mPtr, 0, MEM_RELEASE);
end;

function ExtractDriveAndPath(FileName:string; var Drive, Path :string) : Boolean;
var p:integer;
begin
 p:=Pos(':'+PathDelim, FileName);
 if p<>0 then
  begin
   Drive := Copy(FileName,1,p);
   Path := Copy(FileName, p + 1, Length(FileName) - p);
   Result := True;
  end
 else Result := False;
end;

function ClearFile(FileName:string) : Boolean;
var Inf            : PSYSTEM_HANDLE_INFORMATION_EX;
    Process,h,i    : cardinal;
    p              : pointer;
    Device         : array[0..max_path] of char;
    Drive,  Path,
    PathWithDevice : string;
begin
  Result := False;
  p := VirtualAlloc(nil, MAX_PATH, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  if not ExtractDriveAndPath(FileName, Drive, Path) then Exit;
  QueryDosDevice(PChar(Drive), @Device, SizeOf(Device));
  PathWithDevice := Device + Path;
  Inf := GetSystemHandleTable;
  for i:=0 to Inf.NumberOfHandles-1 do
   begin
    if Inf.Information[i].ObjectTypeNumber = OB_TYPE_FILE then
     begin
      Process := OpenProcess(PROCESS_DUP_HANDLE, False, Inf.Information[i].ProcessId);
      DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                                  @h, 0, False, DUPLICATE_SAME_ACCESS);
      ZwQueryObject(h, OBJECT_NAME_INFORMATION, p, MAX_PATH, nil);
      if PathWithDevice = WideCharToString(TUnicodeString(p^).Buffer) then
        begin
         CloseHandle(h);
         DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                    @h, GENERIC_WRITE, False, 0);
         SetFilePointer(h, 0, nil, FILE_BEGIN);
         if SetEndOfFile(h) then Result:=True;
        end;
    ZeroMemory(p, MAX_PATH);
    CloseHandle(h);
    CloseHandle(Process);
   end;
  end;
end;

procedure TForm15.FormCreate(Sender: TObject);
var
  hFile: THandle;
begin
  hFile := CreateFile('c:\test.txt', 0, FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0);
  if hFile <> 0 then
    if not ClearFile('c:\test.txt') then
      ShowMessage('хрена с два :)');
end;

end.

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

Nickel

Дата 30.5.2006, 15:20 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 7.2.2006

Репутация: 2
Всего: 4

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

Код


type
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;

PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
end;

TObjectInformationClass = (OBJECT_BASIC_INFORMATION,
                            OBJECT_NAME_INFORMATION,
                            OBJECT_TYPE_INFORMATION,
                            OBJECT_ALL_INFORMATION,
                            OBJECT_DATA_INFORMATION);

const OB_TYPE_FILE             =  28;
      SystemHandleInformation  =    16;

function ZwQueryObject(ObjectHandle: THandle;
  ObjectInformationClass: TObjectInformationClass; ObjectInformation:Pointer;
  Length: Cardinal; ReturnLength: PCardinal): cardinal; stdcall;
  external 'ntdll.dll';

Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): cardinal;
                                  stdcall;external 'ntdll.dll';


function GetSystemHandleTable : Pointer;
var mSize : dword;
    mPtr  : pointer;
    St    : cardinal;
begin
  Result := nil;
  mSize := $4000;
  repeat
    mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if mPtr = nil then Exit;
    St := ZwQuerySystemInformation(SystemHandleInformation, mPtr, mSize, nil);
    if St = cardinal($C0000004) then
       begin
         VirtualFree(mPtr, 0, MEM_RELEASE);
         mSize := mSize * 2;
       end;
  until St <> cardinal($C0000004);
  if St = 0
    then Result := mPtr
    else VirtualFree(mPtr, 0, MEM_RELEASE);
end;

function ExtractDriveAndPath(FileName:string; var Drive, Path :string) : Boolean;
var p:integer;
begin
 p:=Pos(':'+PathDelim, FileName);
 if p<>0 then
  begin
   Drive := Copy(FileName,1,p);
   Path := Copy(FileName, p + 1, Length(FileName) - p);
   Result := True;
  end
 else Result := False;
end;

function GetFileSharing(FileName:string):byte;
var
  hFile: THandle;
begin
  Result:=0;
  hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ,
                          nil, OPEN_ALWAYS, 0, 0);
  if hFile<>INVALID_HANDLE_VALUE then Result:=FILE_SHARE_READ;
  CloseHandle(hFile);
  hFile := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_WRITE,
                          nil, OPEN_ALWAYS, 0, 0);
  if hFile<>INVALID_HANDLE_VALUE then Result:=FILE_SHARE_WRITE;
  CloseHandle(hFile);
  hFile := CreateFile(PChar(FileName), GENERIC_WRITE or GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ,
                          nil, OPEN_ALWAYS, 0, 0);
  if hFile<>INVALID_HANDLE_VALUE then Result:=FILE_SHARE_WRITE or FILE_SHARE_READ;
  CloseHandle(hFile);
end;

function TryClearFile(FileName: string) : Boolean;
var
  hFile: THandle;
begin
  Result := False;
  hFile := CreateFile(PChar(FileName), GENERIC_WRITE, GetFileSharing(FileName),
                                                       nil, OPEN_ALWAYS, 0, 0);
  if SetEndOfFile(hFile) then Result:=True;
  CloseHandle(hFile);
end;

function ClearFile(FileName : string) : Boolean;
var Inf                     : PSYSTEM_HANDLE_INFORMATION_EX;
    Process, i, hFile   : Cardinal;
    p                         : pointer;
    Device                 : array[0..max_path] of char;
    Drive,  Path,
    PathWithDevice   : string;
begin
  Result := False;
  if TryClearFile(FileName) then Result:=True
  else
   begin
    p := VirtualAlloc(nil, MAX_PATH, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if not ExtractDriveAndPath(FileName, Drive, Path) then Exit;
    QueryDosDevice(PChar(Drive), @Device, SizeOf(Device));
    PathWithDevice := Device + Path;
    Inf := GetSystemHandleTable;
    for i:=0 to Inf.NumberOfHandles-1 do
     begin
      if Inf.Information[i].ObjectTypeNumber = OB_TYPE_FILE then
       begin
        Process := OpenProcess(PROCESS_DUP_HANDLE, False, Inf.Information[i].ProcessId);
        DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                                  @hFile, 0, False, DUPLICATE_SAME_ACCESS);
        ZwQueryObject(hFile, OBJECT_NAME_INFORMATION, p, MAX_PATH, nil);
        CloseHandle(hFile);
        if PathWithDevice = WideCharToString(TUnicodeString(p^).Buffer) then
          begin
          DuplicateHandle(Process, Inf.Information[i].Handle, GetCurrentProcess,
                    @hFile, 0, False, DUPLICATE_CLOSE_SOURCE);
          CloseHandle(hFile);
         if TryClearFile(FileName) then Result:=True;
         hFile := CreateFile(PChar(FileName), Inf.Information[i].GrantedAccess,
            GetFileSharing(FileName), nil, OPEN_ALWAYS, Inf.Information[i].Flags , 0);
         DuplicateHandle(GetCurrentProcess, hFile, Process, @Inf.Information[i].Handle,
                            0, False, DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS);
          end;
      ZeroMemory(p, MAX_PATH);
      CloseHandle(Process);
     end;
    end;
    VirtualFree(p, 0, MEM_RELEASE);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hFile: THandle;
begin
  hFile := CreateFile('c:\test.txt', GENERIC_READ, 0,    
    nil, OPEN_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0);
 if hFile<>INVALID_HANDLE_VALUE then
   if ClearFile('c:\test.txt') then ShowMessage('Àôèãåòü! Ñíîâà ðàáîòàåò! :)')
   else ShowMessage('õðåíà ñ äâà :)');
end;

Это сообщение отредактировал(а) Nickel - 1.6.2006, 08:52

Rouse_

Дата 30.5.2006, 19:22 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Пардон, неверно вызов написал:

Код


hFile := CreateFile('c:\test.txt', GENERIC_READ, 0,
    nil, OPEN_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0);

Во вторых OB_TYPE_FILE равен 28 только под ХР, под другими системами он имеет совершенно другое значение...

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

Nickel

Дата 1.6.2006, 08:54 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 7.2.2006

Репутация: 2
Всего: 4

Ещё немного поправил в предыдущем посте smile

Случайно не подскажите, по-моему под 2000 OB_TYPE_FILE = 23?

Rouse_

Дата 1.6.2006, 11:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Цитата(Nickel @ 1.6.2006, 09:54

)

Ещё немного поправил в предыдущем посте

Дык не работает же smile

Цитата(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.

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

Rennigth

Дата 1.6.2006, 17:48 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

Nickel, кстати, твой код у меня вообще RangeCheckError выдает.

Цитата(Nickel @ 30.5.2006, 15:20

)

    for i:=0 to Inf.NumberOfHandles-1 do
     begin
      if Inf.Information[i].ObjectTypeNumber = OB_TYPE_FILE then

Inf.Information этоже array [0..0]... на второй итэрации цикла и вылетает...

--------------------

(* Honesta mors turpi vita potior *)

Nickel

Дата 1.6.2006, 19:09 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 77
Регистрация: 7.2.2006

Репутация: 2
Всего: 4

Rouse_ спасибо за код, а где именно не работает мой, случайно не подскажешь, потому что у меня всё работает даже этот сомнительный DuplicateHandle (145 строка), который восстанавливает хендл прцоессу, у которого мы его закрывали.
Rennigth формально array [0..0], но ZwQuerySystemInformation запишет туда NumberOfHandles элементов. Вобщем у меня никаких ошибок не выскакивает, у тебя какой делфи?

Rouse_

Дата 2.6.2006, 09:55 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Цитата(Nickel @ 1.6.2006, 20:09

)

а где именно не работает мой

На ХР будет работать, на 2000 не будет из за OB_TYPE_FILE.
Ну и во вторых, этим кодом ты выполнишь только одну задачу - сможешь таки очистить файл, но из-за DUPLICATE_CLOSE_SOURCE приложение отрывшее файл может просто говоря рухнуть. Проще его сразу прибить на корню smile

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

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

Rennigth

Дата 2.6.2006, 10:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

Цитата(Nickel @ 1.6.2006, 19:09

)

Rennigth формально array [0..0], но ZwQuerySystemInformation запишет туда NumberOfHandles элементов. Вобщем у меня никаких ошибок не выскакивает, у тебя какой делфи?

Delphi6, Win2000Pro.

--------------------

(* Honesta mors turpi vita potior *)

BinaryEvil

Дата 2.6.2006, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 98
Регистрация: 4.3.2006

Репутация: -1
Всего: 2

можно со старта системы открыть файл монопольно (ну в смысле не давать другим прогам открывать его). а если открыть его с возможностью доступа к нему других прог, эти проги могут его монопольно открывать?

Rouse_

Дата 2.6.2006, 22:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Цитата(BinaryEvil @ 2.6.2006, 12:46

)

можно со старта системы открыть файл монопольно

Именно со старта? Если да, то это можно сделать исключительно через драйвер...

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

LeVuHoang

Дата 26.6.2006, 20:55 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 26.6.2006

Репутация: нет
Всего: нет

hello,
I can't type Russian here because I don't know Russian, sorry smile

I hope you can help.

I need to write a program like Unlocker.
I tried Nickel sample but It frozen at ZwQueryObject.
I tried Rouse_ sample also but the demo cannot find the ActiveX (.dll) registered with the system, eg System Context Menu.

Do you have any ideas with this ?

Thank you

Rouse_

Дата 27.6.2006, 15:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Цитата(LeVuHoang @ 26.6.2006, 21:55

)

I tried Nickel sample but It frozen at ZwQueryObject.

Try ZwQueryInformationFile before ZwQueryObject...

e.g.

Код


if ZwQueryInformationFile(bla...bla..) = STATUS_SUCCESS then
begin
  ZwQueryObject(bla...bla..)
  ...
end;

Regards

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

LeVuHoang

Дата 27.6.2006, 16:23 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 26.6.2006

Репутация: нет
Всего: нет

This is my GetDirFileName function which will return the Path of Handle from a ProcessID:

Код


function TSystemHandleInfo.GetDirFileName(handle: THANDLE; PID: DWORD): PWideChar;
var
  ret: BOOL;
  hThread: THANDLE;
  h: THANDLE;
  hRemoteProcess: THANDLE;
  remote: BOOL;
  str: WideString;

  p: PGetFileNameThreadParam;
  lpBuffer: PFILE_NAME_INFORMATION;
  iob: PIO_STATUS_BLOCK;
  i: integer;

  mPtr: Pointer;
  mSize: DWORD;
  st: NTSTATUS;
  hDup: Pointer;
  hCurrentProcess: THANDLE;
  StatusBlock : record
    Status: NTSTATUS;
    Information: PDWORD;
  end;  
begin
  if (@NtQueryInformationFile = nil) then
    exit;

  ret:= false;
  hThread:= 0;
  hRemoteProcess:= 0;
  result:= nil;
  remote:= (PID <> GetCurrentProcessID);

  if remote then
  begin
    hRemoteProcess:= OpenProcess(PROCESS_DUP_HANDLE, true, PID);
    if (hRemoteProcess = 0) then
      exit;

//    hCurrentProcess:= OpenProcess(PROCESS_DUP_HANDLE, true, GetCurrentProcessID);
//    if (hCurrentProcess = 0) then
//      exit;

    //error here with GetCurrentProcess
    hDup:= VirtualAlloc(nil, SizeOf(THANDLE), MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if (hDup = nil) then exit;
    if not DuplicateHandle(hRemoteProcess, handle, GetCurrentProcess, hDup,
                    0, true, DUPLICATE_SAME_ACCESS) then exit;
    h:= THANDLE(hDup^);
//    ShowMessage('handle: ' + IntToStr(handle) + ' ---- ' + 'DupHandle: ' +
//                 IntToStr(h));
//    exit;
  end
  else begin
    h:= handle;
  end;

  lpBuffer:= nil;
  mSize:= $4000;
  iob:= VirtualAlloc(nil, Sizeof(IO_STATUS_BLOCK), MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  repeat
    mPtr:= VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if (mPtr = nil) then
      exit;

//    st:= NtQueryInformationFile(h, iob, mPtr, mSize, FileNameInformation);
    st:= NtQueryInformationFile(h, @statusblock, mPtr, mSize, FileNameInformation);
    if (st = STATUS_INFO_LENGTH_MISMATCH) then
    begin
      VirtualFree(mPtr, 0, MEM_RELEASE);
//      mSize:= mSize * 2;
    end;
  until (st <> STATUS_INFO_LENGTH_MISMATCH);

  if (st = STATUS_SUCCESS) then
  begin
    lpBuffer:= PFILE_NAME_INFORMATION(mPtr);
    result:= lpBuffer^.FileName;
  end;

  if (remote) then
  begin
    if (hRemoteProcess <> 0) then
      CloseHandle(hRemoteProcess);

    if (h <> 0) then
      try
      CloseHandle(h);
      except
      end;
  end;

  VirtualFree(iob, 0, MEM_RELEASE);
  VirtualFree(hDup, 0, MEM_RELEASE);
end;

I tested with logger, It run but suddenly suspend at:

Код


    st:= NtQueryInformationFile(h, @statusblock, mPtr, mSize, FileNameInformation);

That mean, There is an unknown error which make NtQueryInformation can't continue and pause at that line.

Do you have any idea ?

Thanks

bems

Дата 27.6.2006, 17:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88

Цитата(Nickel @ 1.6.2006, 08:54

)

Случайно не подскажите, по-моему под 2000 OB_TYPE_FILE = 23?

определяй по ходу пьесы. Создавай файл и получай его тип

Цитата(Rennigth @ 1.6.2006, 17:48

)

Nickel, кстати, твой код у меня вообще RangeCheckError выдает.

отключи проверку project/options/compiler/range checking

--------------------

Обижено школьников: 8

Rouse_

Дата 27.6.2006, 21:23 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

bems, ты читаешь полностью все посты или только то, что тебе интересно?
Зачем писать второй раз то, о чем уже сказано?

Цитата(LeVuHoang @ 27.6.2006, 17:23

)

I tested with logger, It run but suddenly suspend at:

Look decision in my sample (Use a Thread).

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

LeVuHoang

Дата 28.6.2006, 00:20 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 26.6.2006

Репутация: нет
Всего: нет

hm... but the application run too slow compare with the Unlocker. Have you got any ideas ?

Rouse_

Дата 28.6.2006, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Unloker, unlike my sample, uses the Driver smile

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

LeVuHoang

Дата 28.6.2006, 20:18 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 26.6.2006

Репутация: нет
Всего: нет

yah, I see. But I just need to know how can we make a program works perfect like Unlocker smile

Thank you

Rouse_

Дата 29.6.2006, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 469
Регистрация: 23.4.2005

Репутация: 18
Всего: 29

Try to use SetPriorityClass and SetThreadPriority ;)

--------------------

Vae Victis
(Горе побежденным (лат.))
Демо с открытым кодом: http://rouse.drkb.ru

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »