Данный объект может быть использован для получения исчерпывающей информации о любом файле. Так же включена функция выполнения файла Execute().
Использование: создайте объект с именем файла или путём
unit FileInfo;
interfaceuses
forms, shellapi, windows, sysutils;
type
EFileInfo = exception;
TLangInfoBuffer = array [1..4] of SmallInt;
TFileInfo = classprivate
f : TSearchRec;
fVerBlk : TVSFixedFileInfo;
fFileName : string;
function GetFileVersion( AFileName : string ) : boolean;
publicconstructor Create( AFileName : string ); // Создаём объектdestructor Destroy; override;
function Execute : integer; // Открывает файл в программе, связанной с нимfunction VersionString : string; // Версия файла. Строка пустая, если строка не найденаfunction OS : string; // Операционная системаfunction Path : string; // Путь файлаfunction FileName : string; // Имя файлаfunctionname : string; // Имя файла без расширенияfunction DosFileName : string; // Имя файла в DOSfunction 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;
implementationconstructor TFileInfo.Create(AFileName: string);
var
ret: integer;
begininherited 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 thenbegin
GetMem(Pt,InfoSize);
GetFileVersionInfo( PChar(AFileName), 0, InfoSize, Pt);
VerQueryValue(Pt,'\',InfoPtr,puLen);
move(InfoPtr^, fVerBlk, sizeof(TVSFixedFileInfo) );
FreeMem(Pt);
result := true;
endelse
result := false;
end;
function TFileInfo.VersionString: string;
beginif 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;
beginif GetFileVersion( fFileName ) thencase 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';
endelse
result := '';
end;
function TFileInfo.FileType : string;
var
S: string;
begin
S := '';
if GetFileVersion( fFileName ) thenbegincase 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;
beginif 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( 'Файл используется другим приложением.' );
elseend;
end;
end.
Приведенный код - это единица Delphi, называемая FileInfo, которая содержит класс TFileInfo. Класс предназначен для предоставления информации о файле,such as его версия, операционная система, тип и т.д.
Вот подробное описание кода:
Класс TFileInfo имеет несколько свойств:
FileName: Имя файла.
Path: Путь к файлу.
Name: Базовое имя файла без расширения.
DosFileName: DOS-совместимое имя файла.
FileExt: Расширение файла.
FileType: Тип файла (например, приложение, динамическая связка библиотеки).
Класс имеет несколько методов:
GetFileVersion: Возвращает номер версии файла.
VersionString: Возвращает строковое представление номера версии.
isDebugBuild, isPreRelease, isPrivateBuild и isSpecialBuild: Возвращают булевые значения, указывающие, является ли файл построенным для отладки, предпускового релиза, частного строительства или специального строительства.
OS: Возвращает операционную систему, связанную с файлом.
FileType: Возвращает строковое представление типа файла.
FileSize: Возвращает размер файла в байтах.
CreationTime, LastAccessed и LastWritten: Возвращают времена, представляющие момент создания, последнего доступа и последней записи файла соответственно.
Класс также имеет несколько функций:
Execute: Открывает файл с помощью ассоциированного программы или приложения.
Код использует различные библиотеки Delphi, включая forms, shellapi, windows и sysutils.
В целом, этот код предоставляет обширный набор методов для получения информации о файле в приложении Delphi.
Объект FileInfo позволяет получать подробную информацию о любом файле, включая имя файла, его расширение, тип, размер, дату создания, последнего доступа и записи, а также выполнять файл.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.