(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTFileDetails;

interface

uses
  Windows,Classes,AHMSystemClass,AHMSystemConst;

type
  TAHMFileAttributeFlags = (aArchive,aCompressed,aDirectory,aHidden,aNormal,aReadOnly,aSystem,aTemp);
  TAHMFileAttributeSet = Set of TAHMFileAttributeFlags;
  TAHMBuildType = (bDebug,bPreRelease,bPatched,bPrivateBuild,bInfoInferred,bSpecialBuild);
  TAHMBuildTypeSet = Set of TAHMBuildType;
  TAHMOSType = (oUnknown, oDOS, oOS216, oOS232, oNT);
  TAHMVerFileType = (tUnknown, tApplication, tDLL, tDriver, tFont, tVXD, tStaticLibrary);
  TAHMFileDetails = class(TAHMSystemsComponent)
  private
    FFilename: String;
    FOnUpdate: TNotifyevent;
    FFileSize: DWord;
    FAttribShort: String;
    FNameOnly: String;
    FFileExt: String;
    FFilePath: String;
    FFileAttributes: TAHMFileAttributeSet;
    FCreationTime: TDateTime;
    FLastWriteTime: TDateTime;
    FLastAccessTime: TDateTime;
    FDosFileName : String;
    FCompanyName, FFileDescription, FFileVersion,
    FInternalName, FLegalCopyright, FOriginalFilename,
    FProductName, FProductVersion: string;
    FFileSubType : String;
    FFileType:TAHMVerFileType;
    FBuildTypeSet : TAHMBuildTypeSet;
    FOSType : TAHMOSType;
    FComments : String;
    FOnError: TNotifyevent;
    procedure SetDesign(const DesignString: string);
    function GetCompanyName: string;
    function GetFileDescription: string;
    function GetFileVersion: string;
    function GetInternalName: string;
    function GetLegalCopyright: string;
    function GetOriginalFilename: string;
    function GetProductName: string;
    function GetProductVersion: string;
    function GetBuildTypeSet: TAHMBuildTypeSet;
    procedure SetBuildTypeSet(const Value: TAHMBuildTypeSet);
    function GetOSType: TAHMOSType;
    procedure SetOSType(const Value: TAHMOSType);
    function GetFileType: TAHMVerFileType;
    procedure SetFileType(const Value: TAHMVerFileType);
    function GetFileSubType: String;
    function GetComments: String;
    function Get_FileSize: DWord;
    function GetAttribShort: String;
    function GetCreationTime: TDateTime;
    function GetFileAttributes: TAHMFileAttributeSet;
    function GetFileExt: String;
    function GetFilePath: String;
    function GetLastAccessTime: TDateTime;
    function GetLastWriteTime: TDateTime;
    function GetNameOnly: String;
    procedure SetAttributes(const Value: TAHMFileAttributeSet);
    procedure SetDWord(const Value: DWord);
    procedure SetTDateTime(const Value: TDateTime);
    function GetDosFilename: String;
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    function GetVersionValue(Value : String) : String;
    { Public declarations }
    procedure SetFilename(NewFilename : String);
  published
    property AboutFile : string read FFilename write SetFilename stored False;
    property CompanyName: string read GetCompanyName write SetDesign stored false;
    property FileDescription: string read GetFileDescription write SetDesign stored false;
    property FileVersion: string read GetFileVersion write SetDesign stored false;
    property Comments: String read GetComments write SetDesign stored False;
    property InternalName: string read GetInternalName write SetDesign stored false;
    property LegalCopyright: string read GetLegalCopyright write SetDesign stored false;
    property OriginalFilename: string read GetOriginalFilename write SetDesign stored false;
    property ProductName: string read GetProductName write SetDesign stored false;
    property ProductVersion: string read GetProductVersion write SetDesign stored false;
    property BuildOptions : TAHMBuildTypeSet read GetBuildTypeSet write SetBuildTypeSet stored false;
    property OSType : TAHMOSType read GetOSType write SetOSType stored false;
    property FileType : TAHMVerFileType read GetFileType write SetFileType stored false;
    property FileSubType : String read GetFileSubType write SetDesign stored false;
    property CreationTime : TDateTime read GetCreationTime write SetTDateTime stored False;
    property LastAccessTime : TDateTime read GetLastAccessTime write SetTDateTime stored False;
    property LastWriteTime : TDateTime read GetLastWriteTime write SetTDateTime stored False;
    property Attributes : TAHMFileAttributeSet read GetFileAttributes write SetAttributes stored False;
    property FileSize : DWord read Get_FileSize write SetDword stored False;
    property FilePath : String read GetFilePath write SetDesign stored False;
    property FileExt : String read GetFileExt write SetDesign stored False;
    property AttribShort : String read GetAttribShort write SetDesign stored False;
    property NameandExt : String read GetNameOnly write SetDesign stored False;
    property DosFileName : String read GetDosFilename write SetDesign stored False;
    property OnUpdate : TNotifyevent read FOnUpdate write FOnUpdate;
    property OnError : TNotifyevent read FOnError write FOnError;
    { Published declarations }
  end;

implementation
uses Forms,Sysutils;

procedure TAHMFileDetails.SetDesign(const DesignString: string);
begin
  { enables viewing of properties in Design}
end;

function TAHMFileDetails.GetCompanyName: string;
begin
  result:=FCompanyName;
end;

function TAHMFileDetails.GetFileDescription: string;
begin
  result:=FFileDescription;
end;

function TAHMFileDetails.GetFileVersion: string;
begin
  result:=FFileVersion;
end;

function TAHMFileDetails.GetInternalName: string;
begin
  result:=FInternalName;
end;

function TAHMFileDetails.GetLegalCopyright: string;
begin
  result:=FLegalCopyright;
end;

function TAHMFileDetails.GetOriginalFilename: string;
begin
  result:=FOriginalFilename;
end;

function TAHMFileDetails.GetProductName: string;
begin
  result:=FProductName;
end;

function TAHMFileDetails.GetProductVersion: string;
begin
  result:=FProductVersion;
end;


function TAHMFileDetails.GetVersionValue(Value: String): String;
Var
  VersionSize : Longint;
  VNHandle : DWord;
  Vinfo     : PChar;
  Vitem     : Pointer;
  Rc        : Boolean;
  PFileName      : array [0..255] of Char;
  Ne, L : Integer;
  LenRes : DWord;
  Lang,Code : Word;
  Xlate     : String;
begin
  Result:=ahmscNoVersionDetails;
  StrPCopy(PFileName,FFilename);
  Vitem := @PFileName;
  VersionSize := GetFileVersionInfoSize(VItem,VNHandle);
  if VersionSize = 0 then Exit;
  GetMem(Vinfo,Word(VersionSize));
  RC:=GetFileVersionInfo(PFileName,VNhandle,VersionSize,Vinfo);
  if Not Rc then
  begin
    FreeMem(Vinfo,VersionSize);
    Exit;
  end;
  VerQueryValue(Vinfo,'\',Vitem,LenRes);
  VerQueryValue(Vinfo,StrPCopy(PFileName,ahmscvarfile),Vitem,LenRes);
  Lang := $409;
  Code := 0;
  if Rc then
  begin
    Ne := LenRes Div 4;
    For L := 1 to ne do
    begin
      Lang := LOWORD(LongInt(Vitem^));
      Code := HIWORD(LongInt(Vitem^));
      if Lang = $409 then break;
    end;
  end;
  Xlate := ahmscStringFileInfo + IntToHex(Lang,4) +IntToHex(Code,4) + '\';
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate + Value),Vitem,LenRes)<>False then result := StrPas(Vitem);
  FreeMem(Vinfo,VersionSize);
  if assigned(FOnUpdate) then FOnUpdate(Self);
end;

function TAHMFileDetails.GetBuildTypeSet: TAHMBuildTypeSet;
begin
  result:=FBuildTypeSet;
end;

procedure TAHMFileDetails.SetBuildTypeSet(
  const Value: TAHMBuildTypeSet);
begin
  {Designtime viewing only}
end;

function TAHMFileDetails.GetOSType: TAHMOSType;
begin
  result:=FOsType;
end;

procedure TAHMFileDetails.SetOSType(const Value: TAHMOSType);
begin
  {Designtime viewing only}
end;

function TAHMFileDetails.GetFileType: TAHMVerFileType;
begin
  result:=FFileType;
end;

procedure TAHMFileDetails.SetFileType(const Value: TAHMVerFileType);
begin
  {Designtime viewing only}
end;

function TAHMFileDetails.GetFileSubType: String;
begin
  result:=FFileSubType;
end;

function TAHMFileDetails.GetComments: String;
begin
  result:=FComments;
end;



function FileDirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

{ TAHMFileDetails }

constructor TAHMFileDetails.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetFileName(Application.Exename);
end;

procedure TAHMFileDetails.Loaded;
begin
  inherited Loaded;
  SetFilename(FFileName);
end;

procedure TAHMFileDetails.SetFilename(NewFilename: String);
Var   Win32FindData : TWin32FindData;
      FICreationTime,FIAccessTime,FIWriteTime : Integer;
      VersionSize : Longint;
      VNHandle : DWord;
      Vinfo     : PChar;
      Vitem     : Pointer;
      Rc        : Boolean;
      PFileName      : array [0..255] of Char;
      Ne, L : Integer;
      LenRes : DWord;
      Lang,Code : Word;
      Xlate     : String;
      DoVersion : Boolean;
begin
  DoVersion:=False;
  FAttribShort:='---- ----';
  FFilename:='';
  FFilePath:='';
  FNameOnly:='';
  FFileExt:='';
  FDosFilename:='';
  FFileSize:=0;
  FFileAttributes:=[];
  FCreationTime:=Now;
  FLastAccessTime:=Now;
  FlastWriteTime:=Now;
  FillChar(Win32FindData,SizeOf(Win32FindData),0);
  if (FileExists(NewFileName) or FileDirectoryExists(NewFileName)) and
   (FindFirstFile(PChar(NewFileName),Win32FindData)<>Invalid_Handle_Value) then
  FFilename := NewFilename else
  begin
    if (NewFileName<>'') and (assigned(FOnError)) then FOnError(Self);
    SetFileName(Application.Exename);
    exit;
  end;
  FCompanyName := ahmscNoVersionDetails;
  FFileDescription := ahmscNoVersionDetails;
  FFileVersion := ahmscNoVersionDetails;
  FInternalName := ahmscNoVersionDetails;
  FLegalCopyRight := ahmscNoVersionDetails;
  FOriginalFileName := ahmscNoVersionDetails;
  FProductName := ahmscNoVersionDetails;
  FProductVersion := ahmscNoVersionDetails;
  StrPCopy(PFileName,FFilename);
  Vitem := @PFileName;
  VersionSize := GetFileVersionInfoSize(VItem,VNHandle);
  VInfo:='';
  RC:=False;
  if (VersionSize <> 0) then
  begin
    GetMem(Vinfo,Word(VersionSize));
    RC:=GetFileVersionInfo(PFileName,VNhandle,VersionSize,Vinfo);
    if Not Rc then
    begin
      FreeMem(Vinfo,VersionSize);
      DoVersion:=False;
    end else DoVersion:=True;
  end;
  if DoVersion then
  begin
    VerQueryValue(Vinfo,StrPCopy(PFileName,ahmscvarfile),Vitem,LenRes);
    Lang := $409;
    Code := 0;
    if Rc then
    begin
      Ne := LenRes Div 4;
      For L := 1 to ne do
      begin
        Lang := LOWORD(LongInt(Vitem^));
        Code := HIWORD(LongInt(Vitem^));
        if Lang = $409 then break;
      end;
    end;
    Xlate := ahmscStringFileInfo + IntToHex(Lang,4) +IntToHex(Code,4) + '\';
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'CompanyName'),Vitem,LenRes)<>False then FCompanyName := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'FileDescription'),Vitem,LenRes)<>False then FFileDescription := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'FileVersion'),Vitem,LenRes)<>False then FFileVersion := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'InternalName'),Vitem,LenRes)<>False then FInternalName := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'LegalCopyRight'),Vitem,LenRes)<>False then FLegalCopyRight := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'OriginalFileName'),Vitem,LenRes)<>False then FOriginalFileName := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'ProductName'),Vitem,LenRes)<>False then FProductName := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'Comments'),Vitem,LenRes)<>False then FComments := StrPas(Vitem);
    if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'ProductVersion'),Vitem,LenRes)<>False then FProductVersion := StrPas(Vitem);
    if VerQueryValue(VInfo, '\',VItem, LenRes) then
    begin
      FBuildTypeSet:=[];
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_DEBUG) then Include(FBuildtypeSet,bDebug);
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_PRERELEASE) then Include(FBuildtypeSet,bPreRelease);
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_PATCHED) then Include(FBuildtypeSet,bPatched);
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_PRIVATEBUILD) then Include(FBuildtypeSet,bPrivateBuild);
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_INFOINFERRED) then Include(FBuildtypeSet,bInfoInferred);
      if BOOL(TVSFixedFileInfo(VItem^).dwFileFlags and VS_FF_SPECIALBUILD) then Include(FBuildtypeSet,bSpecialBuild);
      FOSType := TAHMOSType(TVSFixedFileInfo(VItem^).dwFileOs);
      FFileType := TAHMVerFileType(TVSFixedFileInfo(VItem^).dwFileType);
      FFileSubType := IntToStr (TVSFixedFileInfo(VItem^).dwFileSubType);
      case FFileType of
          tDriver  : case (TVSFixedFileInfo(VItem^).dwFileSubType) of
                    VFT2_UNKNOWN         : FFileSubType := 'Unknown';
                    VFT2_DRV_PRINTER     : FFileSubType := 'Printer';
                    VFT2_DRV_KEYBOARD    : FFileSubType := 'Keyboard';
                    VFT2_DRV_LANGUAGE    : FFileSubType := 'Language';
                    VFT2_DRV_DISPLAY     : FFileSubType := 'Display';
                    VFT2_DRV_MOUSE       : FFileSubType := 'Mouse';
                    VFT2_DRV_NETWORK     : FFileSubType := 'Network';
                    VFT2_DRV_SYSTEM      : FFileSubType := 'System';
                    VFT2_DRV_INSTALLABLE : FFileSubType := 'Installable';
                    VFT2_DRV_SOUND       : FFileSubType := 'Sound';
                    VFT2_DRV_COMM        : FFileSubType := 'Comm';
                  end;
         tFont : case (TVSFixedFileInfo(VItem^).dwFileSubType) of
                    VFT2_FONT_RASTER     : FFileSubType := 'Raster';
                    VFT2_FONT_VECTOR     : FFileSubType := 'Vector';
                    VFT2_FONT_TRUETYPE   : FFileSubType := 'TrueType';
                end;
      end;
    end;
    FreeMem(Vinfo,VersionSize);    
  end;
  {File specific details}
  FFilename:=NewFileName;
  FFilePath:=ExtractFilePath(FFileName);
  FNameOnly:=ExtractFileName(FFilename);
  FFileExt:=ExtractFileExt(FFileName);
  FFileSize:=(Win32FindData.NFileSizeHigh*MAXDWORD)+Win32FindData.nFileSizeLow;
  FileTimeToDosDateTime(Win32FindData.ftCreationTime, LongRec(FICreationTime).Hi,LongRec(FICreationTime).Lo);
  try FCreationTime:=FileDateToDateTime(FICreationTime); except end;
  FileTimeToDosDateTime(Win32FindData.ftLastAccessTime, LongRec(FIAccessTime).Hi,LongRec(FIAccessTime).Lo);
  try FLastAccessTime:=FileDateToDateTime(FIAccessTime); except end;
  FileTimeToDosDateTime(Win32FindData.ftLastWriteTime, LongRec(FIWriteTime).Hi,LongRec(FIWriteTime).Lo);
  try FLastWriteTime:=FileDateToDateTime(FIWriteTime); except end;
  FDosFileName:= String(Win32FindData.cAlternateFileName);
  if FDosFileName='' then FDosFilename:=FNameOnly;
  FFileAttributes:=[];
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_ARCHIVE)=FILE_ATTRIBUTE_ARCHIVE then Include(FFileAttributes,aArchive);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_COMPRESSED)=FILE_ATTRIBUTE_COMPRESSED then Include(FFileAttributes,aCompressed);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_HIDDEN)=FILE_ATTRIBUTE_HIDDEN then Include(FFileAttributes,aHidden);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then Include(FFileAttributes,aDirectory);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_NORMAL)=FILE_ATTRIBUTE_NORMAL then Include(FFileAttributes,aNormal);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_READONLY)=FILE_ATTRIBUTE_READONLY then Include(FFileAttributes,aReadOnly);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_SYSTEM)=FILE_ATTRIBUTE_SYSTEM then Include(FFileAttributes,aSystem);
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_TEMPORARY)=FILE_ATTRIBUTE_TEMPORARY then Include(FFileAttributes,aTemp);
  FAttribShort:='---- ----';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_ARCHIVE)=FILE_ATTRIBUTE_ARCHIVE then FAttribShort[4]:='A';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_COMPRESSED)=FILE_ATTRIBUTE_COMPRESSED then FAttribShort[7]:='C';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_HIDDEN)=FILE_ATTRIBUTE_HIDDEN then FAttribShort[2]:='H';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then FAttribShort[6]:='D';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_NORMAL)=FILE_ATTRIBUTE_NORMAL then FAttribShort[5]:='N';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_READONLY)=FILE_ATTRIBUTE_READONLY then FAttribShort[3]:='R';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_SYSTEM)=FILE_ATTRIBUTE_SYSTEM then FAttribShort[1]:='S';
  if (Win32FindData.dwFileAttributes AND FILE_ATTRIBUTE_TEMPORARY)=FILE_ATTRIBUTE_TEMPORARY then FAttribShort[8]:='T';
  if assigned(FOnUpdate) then FOnUpdate(Self);
end;


function TAHMFileDetails.Get_FileSize: DWord;
begin
  result:=FFileSize;
end;

function TAHMFileDetails.GetAttribShort: String;
begin
  result:=FAttribShort;
end;

function TAHMFileDetails.GetCreationTime: TDateTime;
begin
  result:=FCreationTime;
end;

function TAHMFileDetails.GetFileAttributes: TAHMFileAttributeSet;
begin
  result:=FFIleAttributes;
end;

function TAHMFileDetails.GetFileExt: String;
begin
  result:=FFileExt;
end;

function TAHMFileDetails.GetFilePath: String;
begin
  result:=FFilePath;
end;

function TAHMFileDetails.GetLastAccessTime: TDateTime;
begin
  result:=FLastAccessTime;
end;

function TAHMFileDetails.GetLastWriteTime: TDateTime;
begin
  result:=FLastWriteTime;
end;

function TAHMFileDetails.GetNameOnly: String;
begin
  result:=FNameOnly;
end;

procedure TAHMFileDetails.SetAttributes(const Value: TAHMFileAttributeSet);
begin
 {Designtime viewing only}
end;

procedure TAHMFileDetails.SetDword(const Value: DWord);
begin
 {Designtime viewing only}
end;

procedure TAHMFileDetails.SetTDateTime(const Value: TDateTime);
begin
 {Designtime viewing only}
end;

function TAHMFileDetails.GetDosFilename: String;
begin
  result:=FDosFileName;
end;

end.
