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