Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (до версии 2009) - часть 6

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

R3Pa4eK



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

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';
 
implementation
 
 
 
 
 
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 GetFileHandle(SubFileName:string):THandle;
var
  hFile: THandle;
  pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
  I: Integer;
  ObjectTypeNumber1: Byte;
  FilePath: String;
  MyProcID:Cardinal;
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;
                break;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

Всего записей: 963 | Зарегистр. 15-01-2011 | Отправлено: 19:01 15-10-2011
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (до версии 2009) - часть 6


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru