Delphi World - Получаем всю информацию о файле
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получаем всю информацию о файле

Автор: Brian Pedersen

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

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования