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

Автор: {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.
 
faq/delphi/system/get_everything_about_file.txt · Последние изменения: 2006/05/14 14:39 (внешнее изменение)
 
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki