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

Данный объект может быть использован для получения исчерпывающей информации о любом файле. Так же включена функция выполнения файла 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.

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!