Mega Code Archive
Fileattributes
<![CDATA[
Share this article with friends
Rate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (0)
Everything About a File
Product:
Delphi 3.x (or higher) Category:
Files Operation Skill Level:
Scoring:
Last Update:
01/05/2001
Search Keys:
delphi delphi3000 article filename version TVSFixedFileInfo creationtime lastaccessed lastwritten name file OS private prerelease build debug Times Scored:
16 Visits:
1789
Uploader: Brian Pedersen
Company: ALTA A/S Reference: Caos Development
Question/Problem/Abstract:
This Object can be used to display anything about a file. It even inclused a Execute() function to execute the file.
Usage: Create object with filename or path.
Answer:
unit FileInfo;
{ ---------------------------------------------------------------------------- }
{ File Information Object }
{ (C)2000 ALTA A/S }
{ }
{ Extract File Information (version numbers, dates, file extension...) from }
{ files. Execute file or open file with associated program. }
{ File Can also be a volume or directory. }
{ }
{ Date Who What }
{ Nov.2000 B.Pedersen File Created }
{ Jan.2001 B.Pedersen Added Many more function about file version }
{ Fixed time zone problems with datetimes }
{ Thanks to the contributors of samples and fixes }
{ ---------------------------------------------------------------------------- }
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 ); // Create Object
destructor Destroy; override;
function Execute : integer; // Open file with associated
program
function VersionString : string; // File Version. String empty
if string not found
function OS : string; // Operating System
function Path : string; // File Path
function FileName : string; // File Name
function Name : string; // File Name without file
extension
function DosFileName : string; // DOS File Name
function FileExt : string; // File Extension
function FileType : string; // File Type
function FileSize : longint; // File Size
function isDebugBuild : boolean; // True if debug build flag is
set
function isPreRelease : boolean; // True if prerelease flag is
set
function isPrivateBuild : boolean; // True if private build flag
is set
function isSpecialBuild : boolean; // True if special build flag
is set
function isDirectory : boolean; // True if file is not a file
but a directory
function isHidden : boolean; // True if file is hidden
function isSystemFile : boolean; // True if file is a systemfile
function isVolumeId : boolean; // True if file is a volumeid
function isArchive : boolean; // True if file is archived
function CreationTime : TDateTime; // Creation Date/Time
function LastAccessed : TDateTime; // Last Accessed Date/Time
function LastWritten : TDateTime; // Last Written Date/Time
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( 'The operating system is out of memory or resources.' );
ERROR_FILE_NOT_FOUND :
raise Exception.Create( 'The specified file was not found.' );
ERROR_PATH_NOT_FOUND :
raise Exception.Create( 'The specified path was not found.' );
ERROR_BAD_FORMAT :
raise Exception.Create( 'The .EXE file is invalid (non-Win32 .EXE or error ' +
'in .EXE image).' );
SE_ERR_ACCESSDENIED :
raise Exception.Create( 'The operating system denied access to the specified file.' );
SE_ERR_ASSOCINCOMPLETE :
raise Exception.Create( 'The filename association is incomplete or invalid.' );
SE_ERR_DDEBUSY :
raise Exception.Create( 'The DDE transaction could not be completed because ' +
'other DDE transactions were being processed.' );
SE_ERR_DDEFAIL :
raise Exception.Create( 'The DDE transaction failed.' );
SE_ERR_DDETIMEOUT :
raise Exception.Create( 'The DDE transaction could not be completed because the ' +
'request timed out.' );
SE_ERR_DLLNOTFOUND :
raise Exception.Create( 'The specified dynamic-link library was not found.' );
SE_ERR_NOASSOC :
raise Exception.Create( 'There is no application associated with the given ' +
'filename extension.' );
SE_ERR_OOM :
raise Exception.Create( 'There was not enough memory to complete the operation.' );
SE_ERR_SHARE :
raise Exception.Create( 'A sharing violation occurred.' );
else
end;
end;
end.
Please rate this article!
Skill level:
Beginner Expert
Useful:
No! Very!
Overall rating:
Poor Excellent
Comments to this article
Write a new comment
CRC32 Checksum
Mike Heydon (Jan 5 2001 4:48AM)
I have added another function called
function TFileInfo.Crc32 : DWord; which returns the 32 bit CRC of the file. There is not enough space in the comments block (200 words max) to list it, but it is straight forward enough and there are CRC32 algorythms in Delphi3000 articles.
Looking Good !
Respond
fVerBlk also gives FileType
Mike Heydon (Jan 5 2001 2:15AM)
Add following to object ...
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;
Respond
Local Time Zones
Mike Heydon (Jan 5 2001 1:58AM)
Local Time Zones need to be catered for (File time is 2 hours out in South Africa using functions as listed)
Change
function TFileInfo.CreationTime : TDateTime;
var Systemtime : TSystemtime;
begin
FileTimeToSystemTime( f.FindData.ftCreationTime, SystemTime );
result := SystemTimeToDateTime( SystemTime);
end;
To ........
function TFileInfo.CreationTime : TDateTime;
var LTime : TFileTime;
Systemtime : TSystemtime;
begin
FileTimeToLocalFileTime( f.FindData.ftCreationTime,LTime);
FileTimeToSystemTime( LTime, SystemTime );
result := SystemTimeToDateTime( SystemTime);
end;
LastAccessed and LastWritten need to be modified in similar way.
]]>