Вопросы и решения

[ProFrager]

dvd4el, я бы написал как-то так:

function FileSize2(FileName: PAnsiChar): Int64; assembler;
var FileSizeHigh:cardinal;
asm
  push 0
  push FILE_ATTRIBUTE_NORMAL
  push OPEN_ALWAYS
  push 0
  push 0
  push GENERIC_READ
  push eax
  call CreateFile
  push eax
  lea  ecx, FileSizeHigh
  push ecx
  push eax
  call GetFileSize
  mov esi, eax
  call CloseHandle
  mov eax, esi
  mov edx, [FileSizeHigh]
end;

Добавлено через 6 минут
или так, но делфя ужасный код генерит

function FileSize2(FileName: PAnsiChar): Int64;
var FileSizeHigh,FHandle: cardinal;
begin
  FHandle:= CreateFile(PChar(FileName), GENERIC_READ, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  result:= GetFileSize(FHandle, @FileSizeHigh) + int64(FileSizeHigh) shl 32;
  CloseHandle(FHandle);
end;

 

[Avangard]

Ne0N, Спасибо большое) Я твой должник

Ne0N
Появилась проблема. Если функцию использовать в программе, то все нормально. Если же её засунуть в dll, а потом вызвать в инно, появляется ошибка по невозможности чтения какого-то адреса. Использую первый вариант (asm);

 

[ProFrager]

dvd4el, в приведенной функции тип вызова указан как assembler. Для типа stdcall как-то так надо писать (не проверял):

function FileSize2(FileName: PAnsiChar): Int64; stdcall;
var FileSizeHigh:cardinal;
asm
  push 0
  push FILE_ATTRIBUTE_NORMAL
  push OPEN_ALWAYS
  push 0
  push 0
  push GENERIC_READ
  lea 
  push FileName
  call CreateFile
  push eax
  lea  ecx, FileSizeHigh
  push ecx
  push eax
  call GetFileSize
  mov esi, eax
  call CloseHandle
  mov eax, esi
  mov edx, [FileSizeHigh]
end;

P.S. не правь посты, лучше напиши новое сообщение, оно автоматом прикрепится к предыдущему, но зато оно видно будет во вкладке "Новые сообщения"

 

[Avangard]

Ne0N, спасибо, с этим разобрался)

Еще один вопрос. Хочу разблокировать файл, занятый другим процессом. Использую тот код, который ты мне когда-то кидал:

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;
 
  function NtQueryInformationFile(FileHandle: THandle;
    IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
    Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
    stdcall;

implementation

function NtQuerySystemInformation; external 'ntdll.dll' name 'NtQuerySystemInformation';
function NtQueryInformationFile; external 'ntdll.dll' name 'NtQueryInformationFile';

const
  STATUS_SUCCESS = NT_STATUS($00000000);
  STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
  FileNameInformation = 9;
  SystemHandleInformation = 16;

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 GetFileHandleAndClear(SubFileName: String): THandle;
var
  hFile: THandle;
  pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
  I: Integer;
  ObjectTypeNumber1: Byte;
  FilePath: String;
  MyProcID:Cardinal;
  hProcess: THandle;
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);
                result:= Handle;
hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information[I].ProcessId);
                  try
                    DuplicateHandle(hProcess,
                        pHandleInfo^.Information[I].Handle,
                        GetCurrentProcess,
                        @hFile,
                        0,
                        True,
                        DUPLICATE_CLOSE_SOURCE);

                        CloseHandle(hFile);
                finally
                    CloseHandle(hProcess);
                end;
             break;
            end;
          end;
        end;
      end;
    end;
  end;
end;

но он почему то не работает. Не хочет он разблокировать тот файл, который я указал( Что не так?

 

[ProFrager]

dvd4el, интересно, а что за другой процесс?) Нашел твой подобный вопрос на форуме руборда, а там про ботву был разговор. Так что хендлы искать надо с своем процессе, а не чужом. И всякие функции открытия процесса и создания дубликатов хендлов не нужны. Код, который я тебе кидал как раз и ищет хендл нужного файла в текущем процессе.

 

[Avangard]

Ne0N
Узнал я хэндл нужного мне файла, а что делать дальше? Как его разблокировать?

 

[LexBell]

dvd4el,
CreateFile + GetFileSize + CloseHandle

Так, наверное. Нет?

 

[Avangard]

Gnom, скорее все, что нет. Вот так пробовал:

Спойлер

function GetFileHandle(SubFileName: AnsiString; hDubl: Boolean): THandle; cdecl;
var
hFile: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I: Integer;
ObjectTypeNumber1: Byte;
FilePath: String;
MyProcID: Cardinal;
hProcess: THandle;
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 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 do begin
if ObjectTypeNumber = ObjectTypeNumber1 then begin
if ProcessId=MyProcID then begin
FilePath := GetFileNameFromHandle(Handle);
if (FilePath <> '') and (pos(SubFileName,FilePath)>0) then begin
if hDubl then begin
hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information.ProcessId);
if DuplicateHandle(hProcess, pHandleInfo^.Information.Handle, GetCurrentProcess,
@hFile,
0,
True,
DUPLICATE_CLOSE_SOURCE) then CloseHandle(hFile);
end;
result:=Handle;
break;
end;
end;
end;
end;
end;
end;
end;
CloseHandle(hProcess);
end;

не получается (

 

[LexBell]

dvd4el,

Тебя кто учил писать по линеечке? Не понять ничего-же

 

[Avangard]

Gnom

Это форум так текст генерит. Так понятнее:

function GetFileHandle(SubFileName: AnsiString; hDubl: Boolean): THandle; cdecl;
var
  hFile: THandle;
  pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
  I: Integer;
  ObjectTypeNumber1: Byte;
  FilePath: String;
  MyProcID: Cardinal;
  hProcess: THandle;
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
                if hDubl then begin
                hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information[I].ProcessId);
                if DuplicateHandle(hProcess, pHandleInfo^.Information[I].Handle, GetCurrentProcess,
                                       @hFile,
                                       0,
                                       True,
                                       DUPLICATE_CLOSE_SOURCE) then CloseHandle(hFile);
                end;
                result:=Handle;
                break;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  CloseHandle(hProcess);
end;

 

[ProFrager]

dvd4el, так будет правильнее:

...
                if hDubl then begin
                  hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, ProcessId);
                  if DuplicateHandle(hProcess, Handle, GetCurrentProcess, @hFile, 0, True, DUPLICATE_CLOSE_SOURCE) then result:=hFile;
                end else
                  result:=Handle;
                break;
...

Эта функция просто получает хэндл файла, а использовать ее следует как-то так:

...
hh:=GetFileHandle('C:\paq.png');
CloseHandle (hh);
...

 

[Avangard]

Ne0N, Когда я пытаюсь удалить этот файл, система пишет, что мол он занят другой, неизвестной программой, unlocker говорит, что не найдено никакого блокирующего дескриптора и запросто удаляет файл. Теперь не пишет, что файл занят именно Setup\Uninstall. Что делать в таком случае?

function GetFileHandle(SubFileName: AnsiString; hDubl: Boolean): THandle; cdecl;
var
  hFile: THandle;
  pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
  I: Integer;
  ObjectTypeNumber1: Byte;
  FilePath: String;
  MyProcID: Cardinal;
  hProcess: THandle;
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
                if hDubl then begin
                  hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, ProcessId);
                  if DuplicateHandle(hProcess, Handle, GetCurrentProcess, @hFile, 0, True, DUPLICATE_CLOSE_SOURCE) then begin CloseHandle(hProcess); CloseHandle(hFile); result:= hFile; end;
                end else
                  result:=Handle;
                break;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

function UnlockFile(FileName: AnsiString): HWND; cdecl;
var hFile: THandle;
begin
  hFile:= GetFileHandle(FileName, true);
  CloseHandle(hFile);
end;

и еще, если в функции UnlockFile ввести полный путь (в FileName), то ничего он не находит, а если ввести просто файл, что то возвращает.

 

[ProFrager]

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

Добавлено через 17 минут
З.Ы. учись пользоваться делфийским дебагером - он решает проблемы гораздо проще и быстрее, чем постинг вопросов на форумах.

 

[Avangard]

Ne0N, Я вот только одного не могу понять, почему unlocker удаляет файл, при этом говорит, что не найдено никаких блокирующих дескрипторов, а система не может. Как же тогда unlocker удаляет файл?

З.Ы. учись пользоваться делфийским дебагером - он решает проблемы гораздо проще и быстрее, чем постинг вопросов на форумах.

Будем учится)

 

[Krinkels]

Я вот только одного не могу понять, почему unlocker удаляет файл, при этом говорит, что не найдено никаких блокирующих дескрипторов, а система не может. Как же тогда unlocker удаляет файл?

А ты хочешь написать свой аналог unlocker'а?

 

[Avangard]

Krinkels, нет.

 

[GVS276]

Ребят такой вопрос, как можно сменить/изменить цвет формы по Handle?

 

[David.D.Rocco]

VinTagE,

Спойлер

 var r: trect; dc: hdc;
...
  dc:=getdc(handle);
    windows.getclientrect(handle, r);
    windows.fillrect(dc, r, CreateSolidBrush(clred));
  ReleaseDC(handle, dc);
..

 

[GVS276]

David.D.Rocco, Спасибо!

Кто знает есть такая функция CallBackAddr в delphi?

 

[LexBell]

dc:=getdc(handle);

var
  ps: TPaintStruct;
............................
      dc:= Beginpaint(handle, ps);

так не более правильно будет? Все равно в WM_PAINT обрабатывать....