Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков КРЭКЕРСТВО + ПРОГРАММИРОВАНИЕ 2017
(актуальность: май 2017)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



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

Автор: 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.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS