Получаем всю информацию о файле.

Автор: Brian Pedersen

Совместимость: Delphi 3.x (или выше)

Данный объект может быть использован для получения исчерпывающей информации о любом файле. Так же включена функция выполнения файла Execute().

Использование: создайте объект с именем файла или путём

unit FileInfo;

interface
{ ---------------------------------------------------------------------------- }

uses
  forms, shellapi, windows, sysutils;

type
  EFileInfo = exception;
  TLangInfoBuffer = array [1..4] of SmallInt;
  TFileInfo = class
    private
      f : TSearchRec;
      fVerBlk : TVSFixedFileInfo;
      fFileName : string;
      function GetFileVersion( AFileName : string ) : boolean;
    public
      constructor Create( AFileName : string ); // Создаём объект
      destructor  Destroy; override;
      function    Execute : integer;            // Открывает файл в программе, связанной с ним
      function    VersionString : string;       // Версия файла. Строка пустая, если строка не найдена
      function    OS : string;                  // Операционная система
      function    Path : string;                // Путь файла
      function    FileName : string;            // Имя файла
      function    Name : string;                // Имя файла без расширения
      function    DosFileName : string;         // Имя файла в DOS
      function    FileExt : string;             // Расширение файла
      function    FileType : string;            // Тип файла
      function    FileSize : longint;           // Размер файла
      function    isDebugBuild : boolean;       // True если флаг отладки (debug build) установлен
      function    isPreRelease : boolean;       // True если флаг prerelease установлен
      function    isPrivateBuild : boolean;     // True если флаг private установлен
      function    isSpecialBuild : boolean;     // True если флаг special build установлен
      function    isDirectory : boolean;        // True если файл является директорией
      function    isHidden : boolean;           // True если файл является скрытым (hidden)
      function    isSystemFile : boolean;       // True если файл является системным
      function    isVolumeId : boolean;         // True если файл является меткой тома
      function    isArchive : boolean;          // True если файл является архивом
      function    CreationTime : TDateTime;     // Время создания файла
      function    LastAccessed : TDateTime;     // Время последнего доступа к файлу
      function    LastWritten : TDateTime;      // Время последней записи в файл
  end;

{ ---------------------------------------------------------------------------- }
  implementation
{ ---------------------------------------------------------------------------- }

constructor TFileInfo.Create( AFileName : string );
var
  ret : integer;
begin
  inherited Create;
  fFileName := AFileName;
  ret := FindFirst( AFileName, faReadOnly + faHidden+ faSysFile + faVolumeID +
                    faDirectory + faArchive + faAnyFile, f );
  if ret <> 0 then
    SysUtils.RaiseLastWin32Error;
end;

{ ---------------------------------------------------------------------------- }
destructor TFileInfo.Destroy;
begin
  FindClose( f );
end;

{ ---------------------------------------------------------------------------- }
function  TFileInfo.GetFileVersion( AFileName : string ) : boolean;
var
  InfoSize,puLen : DWord;
  Pt,InfoPtr : Pointer;
begin
  InfoSize := GetFileVersionInfoSize( PChar(AFileName), puLen );
  fillchar( fVerBlk, sizeof(TVSFixedFileInfo), 0);
  if InfoSize > 0 then
  begin
    GetMem(Pt,InfoSize);
    GetFileVersionInfo( PChar(AFileName), 0, InfoSize, Pt);
    VerQueryValue(Pt,'\',InfoPtr,puLen);
    move(InfoPtr^, fVerBlk, sizeof(TVSFixedFileInfo) );
    FreeMem(Pt);
    result := true;
  end
  else
    result := false;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.VersionString : string;
begin
  if GetFileVersion( fFileName ) then
    result := Format('%u.%u.%u.%u',
              [HiWord(fVerBlk.dwProductVersionMS),
               LoWord(fVerBlk.dwProductVersionMS),
               HiWord(fVerBlk.dwProductVersionLS),
               LoWord(fVerBlk.dwProductVersionLS)])
  else
    result := '';
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isDebugBuild : boolean;
begin
  result := FALSE;
  if GetFileVersion( fFileName ) then
    result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
              VS_FF_DEBUG) <> 0
end;

{ ---------------------------------------------------------------------------- }
function TFIleInfo.isPreRelease : boolean;
begin
  result := FALSE;
  if GetFileVersion( fFileName ) then
    result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
              VS_FF_PRERELEASE) <> 0
end;

{ ---------------------------------------------------------------------------- }
function TFIleInfo.isPrivateBuild : boolean;
begin
  result := FALSE;
  if GetFileVersion( fFileName ) then
    result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
              VS_FF_PRIVATEBUILD) <> 0
end;

{ ---------------------------------------------------------------------------- }
function TFIleInfo.isSpecialBuild : boolean;
begin
  result := FALSE;
  if GetFileVersion( fFileName ) then
    result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
              VS_FF_SPECIALBUILD) <> 0
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.OS : string;
begin
  if GetFileVersion( fFileName ) then
    case fVerBlk.dwFileOS of
      VOS_DOS_WINDOWS16 : result := 'MS-DOS or 16 bit Windows';
      VOS_DOS_WINDOWS32 : result := '32 bit Windows';
      VOS_OS216_PM16    : result := '16 bit OS/2';
      VOS_OS232_PM32    : result := '32 bit OS/2';
      VOS_NT_WINDOWS32  : result := 'Win32 or Windows NT';
    else
      result := 'Unknown OS';
    end
  else
    result := '';
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.FileType : string;
var
  S : string;
begin
  S := '';
  if GetFileVersion( fFileName ) then
  begin
    case fVerBlk.dwFileType of
      VFT_APP  : S := 'Application';
      VFT_DLL  : S := 'Dynamic Link Library (DLL)';
      VFT_DRV  : begin
                   S := 'Device Driver - ';
                   case fVerBlk.dwFileSubtype of
                     VFT2_DRV_PRINTER     : S := S + 'Printer';
                     VFT2_DRV_KEYBOARD    : S := S + 'Keyboard';
                     VFT2_DRV_LANGUAGE    : S := S + 'Language';
                     VFT2_DRV_DISPLAY     : S := S + 'Display';
                     VFT2_DRV_MOUSE       : S := S + 'Mouse';
                     VFT2_DRV_NETWORK     : S := S + 'Network';
                     VFT2_DRV_SYSTEM      : S := S + 'System';
                     VFT2_DRV_INSTALLABLE : S := S + 'Installable';
                     VFT2_DRV_SOUND       : S := S + 'Sound';
                   else
                     S := S + 'Unknown';
                   end;
                 end;
      VFT_FONT : begin
                   S := 'Font File - ';
                   case fVerBlk.dwFileSubType of
                     VFT2_FONT_RASTER   : S := S + 'Raster';
                     VFT2_FONT_VECTOR   : S := S + 'Vector';
                     VFT2_FONT_TRUETYPE : S := S + 'TrueType';
                   else
                     S := S + 'Unknown';
                   end;
                 end;
      VFT_VXD        : S := 'Virtual Device';
      VFT_STATIC_LIB : S := 'Static Link Library';
    else
      S := 'Unknown File Type';
    end;
  end;
  Result := S;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.Path : string;
begin
  result := ExtractFilePath( fFileName );
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.FileName : string;
begin
  result := ExtractFileName( fFileName );
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.Name : string;
begin
  if Pos( FileExt, FileName ) > 0 then
    result := Copy( FileName, 0, pos( FileExt, FileName )-1 )
  else
    result := FileName;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.DosFileName : string;
begin
  result := StrPas( f.FindData.cAlternateFileName )
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.FileExt : string;
begin
  result := ExtractFileExt( fFileName );
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isDirectory : boolean;
begin
  result := f.Attr AND faDirectory = faDirectory;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isHidden : boolean;
begin
  result := f.Attr AND faHidden = faHidden;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isSystemFile : boolean;
begin
  result := f.Attr AND faSysFile = faSysFile;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isVolumeId : boolean;
begin
  result := f.Attr AND faVolumeId = faVolumeId;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.isArchive : boolean;
begin
  result := f.Attr AND faArchive = faArchive;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.FileSize : longint;
begin
  result := f.Size;
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.CreationTime : TDateTime;
var
  LTime : TFileTime;
  Systemtime : TSystemtime;
begin
  FileTimeToLocalFileTime( f.FindData.ftCreationTime, LTime);
  FileTimeToSystemTime( LTime, SystemTime );
  result := SystemTimeToDateTime( SystemTime);
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.LastAccessed : TDateTime;
var
  LTime : TFileTime;
  Systemtime : TSystemtime;
begin
  FileTimeToLocalFileTime( f.FindData.ftLastAccessTime, LTime);
  FileTimeToSystemTime( LTime, SystemTime );
  result := SystemTimeToDateTime( SystemTime);
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.LastWritten : TDateTime;
var
  LTime : TFileTime;
  Systemtime : TSystemtime;
begin
  FileTimeToLocalFileTime( f.FindData.ftLastWriteTime, LTime);
  FileTimeToSystemTime( LTime, SystemTime );
  result := SystemTimeToDateTime( SystemTime);
end;

{ ---------------------------------------------------------------------------- }
function TFileInfo.Execute : integer;
begin
  result := shellapi.ShellExecute( Application.Handle, 'open', pChar( fFileName ),
                                   '', pChar(Path),
                                   SW_SHOWDEFAULT );
  case result of
    0 :
     raise Exception.Create( 'Недостаточно памяти или ресурсов.' );
    ERROR_FILE_NOT_FOUND :
      raise Exception.Create( 'Указанный файл не найден.' );
    ERROR_PATH_NOT_FOUND :
      raise Exception.Create( 'Указанный путь не найден.' );
    ERROR_BAD_FORMAT :
      raise Exception.Create( 'Ошибка файла .EXE (не -Win32 .EXE или ошибка ' +
                              'в .EXE).' );
    SE_ERR_ACCESSDENIED :
      raise Exception.Create( 'Доступ к файлу запрещён.' );
    SE_ERR_ASSOCINCOMPLETE :
      raise Exception.Create( 'The filename association is incomplete or invalid.' );
    SE_ERR_DDEBUSY :
      raise Exception.Create( 'Транзакция DDE не может быть завершена, потому что ' +
                              'другая транзакция DDE находится в процессе выполнения.' );
    SE_ERR_DDEFAIL :
      raise Exception.Create( 'Ошибка транзакции DDE.' );
    SE_ERR_DDETIMEOUT :
      raise Exception.Create( 'DDE транзакция не может быть завершина из-за тайм-аута.' );
    SE_ERR_DLLNOTFOUND :
      raise Exception.Create( 'Указанная dynamic-link library не найдена.' );
    SE_ERR_NOASSOC :
      raise Exception.Create( 'Не найдено приложение связанной с данным расширением файла.' );
    SE_ERR_OOM :
      raise Exception.Create( 'Недостаточно памяти для завершения операции.' );
    SE_ERR_SHARE :
      raise Exception.Create( 'Файл используется другим приложением.' );
  else
  end;
end;

end.