{
 * FmVIDemo.pas
 *
 * Main form for Version Information Component VIDemo demo program.
 *
 * $Rev: 1109 $
 * $Date: 2013-01-13 23:19:20 +0000 (Sun, 13 Jan 2013) $
 *
 * Any copyright in this file is dedicated to the Public Domain.
 * http://creativecommons.org/publicdomain/zero/1.0/
}

unit FmVIDemo;

{$UNDEF Supports_RTLNameSpaces}
{$IFDEF CONDITIONALEXPRESSIONS}
  {$IF CompilerVersion >= 15.0}   // >= Delphi 7
    {$WARN UNSAFE_CODE OFF}
  {$IFEND}
  {$IF CompilerVersion >= 23.0}   // Delphi XE2
    {$DEFINE Supports_RTLNameSpaces}
  {$IFEND}
{$ENDIF}

interface

uses
  // Delphi
  {$IFDEF Supports_RTLNameSpaces}
  Vcl.ComCtrls, Vcl.StdCtrls, Vcl.Buttons, Vcl.Dialogs, Vcl.Controls,
  System.Classes, Vcl.Forms, Winapi.Windows, Winapi.Messages, Vcl.ExtCtrls,
  {$ELSE}
  ComCtrls, StdCtrls, Buttons, Dialogs, Controls, Classes, Forms, Windows,
  Messages, ExtCtrls,
  {$ENDIF}
  // DelphiDabbler component
  PJVersionInfo;

type
  TMainForm = class(TForm)
    dlgBrowse: TOpenDialog;
    gpFixed: TGroupBox;
    lvFixed: TListView;
    gpVar: TGroupBox;
    lblTrans: TLabel;
    lblStr: TLabel;
    cmbTrans: TComboBox;
    lvStr: TListView;
    bvlSpacer1: TBevel;
    viInfo: TPJVersionInfo;
    sbFileName: TSpeedButton;
    edFileName: TEdit;
    btnRefresh: TButton;
    btnClose: TButton;
    sbHints: TStatusBar;
    procedure cmbTransChange(Sender: TObject);
    procedure lvMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure sbFileNameClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    procedure ClearDisplay;
      // Clear list views and combo box
    procedure Display;
      // Display version info for current file, if any
    procedure DisplayFFI;
      // Display fixed file info for current file
    procedure DisplayFFIItem(const Index: Integer; const FFI: TVSFixedFileInfo);
      // Display the fixed file item per the given index fixed file info
      // structure
    procedure DisplayTransInfo;
      // Display translation information in combo and selects first item if any
    procedure DisplayStringInfo(const TransIdx: Integer);
      // Display standard string information for given translation
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
      // Catch name of file dropped on window and enter in edit control
  end;

var
  MainForm: TMainForm;

implementation

uses
  // Delphi
  {$IFDEF Supports_RTLNameSpaces}
  System.SysUtils, System.Math, WinApi.ShellAPI;
  {$ELSE}
  SysUtils, Math, ShellAPI;
  {$ENDIF}

{$R *.DFM}

const
  // Index of fixed file info in lvFixed
  cIdxFileVersion = 0;
  cIdxProductVersion = 1;
  cIdxFileFlagsMask = 2;
  cIdxFileFlags = 3;
  cIdxFileOS = 4;
  cIdxFileType = 5;
  cIdxFileSubType = 6;
  cFirstFFIIndex = 0;
  cLastFFIIndex = 6;

// The following types and constant table definitions provide information
// required to display descriptions of fixed file information codes from version
// resources

type
  TTableEntry = record
    // maps codes to descriptions
    Code: DWORD;
    Desc: string;
  end;

const
  cFileType: array[0..6] of TTableEntry =
    // maps file types to descriptions
  (
    (Code: VFT_APP; Desc: 'Application'),
    (Code: VFT_DLL; Desc: 'DLL'),
    (Code: VFT_DRV; Desc: 'Device driver'),
    (Code: VFT_FONT; Desc: 'Font'),
    (Code: VFT_STATIC_LIB; Desc: 'Static link library'),
    (Code: VFT_VXD; Desc: 'Virtual device driver'),
    (Code: VFT_UNKNOWN; Desc: 'Unknown')
  );

  cFileOSBase: array[0..4] of TTableEntry =
    // maps base OS codes to descriptions
  (
    ( Code: VOS_NT; Desc: 'Windows NT' ),
    ( Code: VOS_DOS; Desc: 'MS-DOS' ),
    ( Code: VOS_OS232; Desc: 'OS2 32 bit' ),
    ( Code: VOS_OS216; Desc: 'OS2 16 bit' ),
    ( Code: VOS_UNKNOWN; Desc: 'Any' )
  );

  cFileOSTarget: array[0..4] of TTableEntry =
    // maps target OS codes to descriptions
  (
    ( Code: VOS__WINDOWS32; Desc: '32 bit Windows' ),
    ( Code: VOS__WINDOWS16; Desc: 'Windows 3.x' ),
    ( Code: VOS__PM32; Desc: 'Presentation Manager 32' ),
    ( Code: VOS__PM16; Desc: 'Presentation Manager 16' ),
    ( Code: VOS__BASE; Desc: 'Unknown' )
  );

// The following procedures extract the required descriptions of fixed file
// information codes from the tables above

function CodeToDesc(Code: DWORD;
  Table: array of TTableEntry): string;
  // Return description of given code using given table
var
  I: Integer;
begin
  Result := '';
  for I := Low(Table) to High(Table) do
    if Table[I].Code = Code then
    begin
      Result := Table[I].Desc;
      Break;
    end;
end;

function FileOSDesc(OS: DWORD): string;
  // Describe OS
var
  Target, Base: DWORD;
begin
  // get target and base OS
  Target := OS and $0000FFFF;
  Base := OS and $FFFF0000;
  // build description
  if Base = VOS_UNKNOWN then
    Result := CodeToDesc(Target, cFileOSTarget)
  else if Target = VOS__BASE then
    Result := CodeToDesc(Base, cFileOSBase)
  else
    Result := Format('%s on %s',
      [CodeToDesc(Target, cFileOSTarget),
      CodeToDesc(Base, cFileOSBase)]);
end;

function FileFlagsToStr(Flags: DWORD): string;
  // Return string of file flags from given bit set
const
  cFileFlags: array[0..5] of TTableEntry =
  (
    (Code: VS_FF_DEBUG;        Desc: 'Debug'),
    (Code: VS_FF_PRERELEASE;   Desc: 'Pre-release'),
    (Code: VS_FF_PATCHED;      Desc: 'Patched'),
    (Code: VS_FF_PRIVATEBUILD; Desc: 'Private build'),
    (Code: VS_FF_INFOINFERRED; Desc: 'Inferred'),
    (Code: VS_FF_SPECIALBUILD; Desc: 'Special build')  );
var
  I: Integer;
begin
  Result := '';
  for I := Low(cFileFlags) to High(cFileFlags) do
    if Flags and cFileFlags[I].Code = cFileFlags[I].Code then
      if Result = '' then
        Result := cFileFlags[I].Desc
      else
        Result := Result + ', ' + cFileFlags[I].Desc
end;

function VerFmt(const MS, LS: DWORD): string;
  // Format the version number from the given DWORDs containing the info
begin
  Result := Format('%d.%d.%d.%d',
    [HiWord(MS), LoWord(MS), HiWord(LS), LoWord(LS)])
end;

{ TMainForm }

procedure TMainForm.btnCloseClick(Sender: TObject);
  // Close the app
begin
  Close;
end;

procedure TMainForm.btnRefreshClick(Sender: TObject);
  // Display version info for file name entered in edit control
begin
  // Store name of required file in version info component: this reads ver info
  viInfo.FileName := edFileName.Text;
  // Record file's name in caption
  Caption := Format('%s - %s',
    [Application.Title, ExtractFileName(viInfo.FileName)]);
  // Display info, if any
  Display
end;

procedure TMainForm.ClearDisplay;
  // Clear list views and combo box

  // ---------------------------------------------------------------------------
  procedure ClearLV(LV: TListView);
  var
    Idx: Integer;
  begin
    for Idx := 0 to Pred(LV.Items.Count) do
      if LV.Items[Idx].SubItems.Count > 0 then
        LV.Items[Idx].SubItems[0] := '';
  end;
  // ---------------------------------------------------------------------------

begin
  ClearLV(lvFixed);
  ClearLV(lvStr);
  cmbTrans.Items.Clear;
  cmbTrans.ItemIndex := -1;
end;

procedure TMainForm.cmbTransChange(Sender: TObject);
  // When user selects a translation from combo box, display its string info
begin
  DisplayStringInfo(cmbTrans.ItemIndex);
end;

procedure TMainForm.Display;
  // Display version info for current file, if any
begin
  // Display version info: display gets cleared and message displayed if no info
  if viInfo.HaveInfo then
  begin
    DisplayFFI;
    DisplayTransInfo;
    DisplayStringInfo(cmbTrans.ItemIndex);
  end
  else
  begin
    ClearDisplay;
    MessageDlg(
      'No version resource information available for ' + viInfo.FileName,
      mtInformation, [mbOK], 0);
  end;
end;

procedure TMainForm.DisplayFFI;
  // Display fixed file info for current file
var
  Idx: Integer; // scans thru all fixed file items
begin
  // Display each fixed file item
  for Idx := cFirstFFIIndex to cLastFFIIndex do
  begin
    // Ensure there's a sub item in list view for this item
    if lvFixed.Items[Idx].SubItems.Count = 0 then
      lvFixed.Items[Idx].SubItems.Add('');
    // Display the item
    DisplayFFIItem(Idx, viInfo.FixedFileInfo);
  end;
end;

procedure TMainForm.DisplayFFIItem(const Index: Integer;
  const FFI: TVSFixedFileInfo);
  // Display the fixed file item per the given index fixed file info structure

  // ---------------------------------------------------------------------------
  procedure AddItem(const Index: Integer; const Value: string);
    {Set the first sub item of the given list item to the given value}
  begin
    lvFixed.Items[Index].SubItems[0] := Value;
  end;
  // ---------------------------------------------------------------------------

begin
  // Display the required item
  case Index of
    cIdxFileVersion:
      AddItem(cIdxFileVersion,
        VerFmt(FFI.dwFileVersionMS, FFI.dwFileVersionLS));
    cIdxProductVersion:
      AddItem(cIdxProductVersion,
        VerFmt(FFI.dwProductVersionMS, FFI.dwProductVersionLS));
    cIdxFileFlagsMask:
      AddItem(cIdxFileFlagsMask,
        FileFlagsToStr(FFI.dwFileFlagsMask));
    cIdxFileFlags:
      AddItem(cIdxFileFlags, FileFlagsToStr(FFI.dwFileFlags));
    cIdxFileOS:
      AddItem(cIdxFileOS, FileOSDesc(FFI.dwFileOS));
    cIdxFileType:
      AddItem(cIdxFileType, CodeToDesc(FFI.dwFileType, cFileType));
    cIdxFileSubType:
      case FFI.dwFileType of
        VFT_FONT, VFT_DRV, VFT_VXD:
          AddItem(cIdxFileSubType, Format('%0.8X', [FFI.dwFileSubType]));
        else AddItem(cIdxFileSubType, 'None');
      end;
  end;
end;

procedure TMainForm.DisplayStringInfo(const TransIdx: Integer);
  // Display standard string information for given translation
const
  // Details of names of all standard string information
  cStrInfoNames: array[0..11] of string = (
    'Comments',
    'CompanyName',
    'FileDescription',
    'FileVersion',
    'InternalName',
    'LegalCopyright',
    'LegalTrademarks',
    'OriginalFileName',
    'PrivateBuild',
    'ProductName',
    'ProductVersion',
    'SpecialBuild'
  );
var
  Idx: Integer; // index of string info name in table
begin
  // Select required translation in version info component
  viInfo.CurrentTranslation := TransIdx;
  // Display each piece of string info
  for Idx := Low(cStrInfoNames) to High(cStrInfoNames) do
  begin
    // Ensure we have a sub-item of list item in which to display info
    if lvStr.Items[Idx].SubItems.Count = 0 then
      lvStr.Items[Idx].SubItems.Add('');
    // Display string info or empty string if translation is not valid
    if viInfo.CurrentTranslation > -1 then
      // display string information
      lvStr.Items[Idx].SubItems[0] :=
        viInfo.StringFileInfo[cStrInfoNames[Idx]]
    else
      // clear string information
      lvStr.Items[Idx].SubItems[0] := '';
  end;
end;

procedure TMainForm.DisplayTransInfo;
  // Display translation information in combo and selects first item if any
var
  TransIdx: Integer;  // loops thru all translations
begin
  // Set up translations in combo box: indexes of items in combo = trans index
  cmbTrans.Clear;
  for TransIdx := 0 to Pred(viInfo.NumTranslations) do
  begin
    viInfo.CurrentTranslation := TransIdx;
    cmbTrans.Items.Add(Format('%s - %s', [viInfo.Language, viInfo.CharSet]));
  end;
  // Select first translation if there is one
  if viInfo.NumTranslations > 0 then
    cmbTrans.ItemIndex := 0
  else
    cmbTrans.ItemIndex := -1;
end;

procedure TMainForm.FormCreate(Sender: TObject);
  // App starting: initialise (tell Windows we accept file drag/drops)
begin
  DragAcceptFiles(Handle, True);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
  // App closing: tidy up (no more file drag/drops)
begin
  DragAcceptFiles(Handle, False);
end;

procedure TMainForm.lvMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
  // Display any info that is too wide for list view column in pop-up window
  // when mouse passes over the item
const
  {$J+}
  LastItem: TListItem = nil;  // list item under cursor last time event called
  {$J-}
var
  LV: TListView;    // list view triggering this event
  Item: TListItem;  // list item, if any, under mouse cursor
  StrW: Integer;    // width of string in right column for current list item

  // ---------------------------------------------------------------------------
  procedure SetHint(const HintStr: string);
    {Set list view's hint to given string, and switch on hinting if string non-
    empty}
  begin
    LV.Hint := HintStr;
    LV.ShowHint := HintStr <> '';
    sbHints.AutoHint := HintStr = ''; // only auto hint for interactive controls
  end;
  // ---------------------------------------------------------------------------

begin
  // Get reference to list view triggering this event
  LV := Sender as TListView;
  // Get list item under mouse cursor if any
  Item := LV.GetItemAt(X, Y);
  if Item <> LastItem then
  begin
    // Item has changed: ensure any active hint is cancelled so any new one will
    // be displayed
    LastItem := Item;
    Application.CancelHint;
  end;
  if Assigned(Item)
    and (X > LV.Columns[0].WidthType)
    and (Item.SubItems.Count > 0) then
  begin
    // Mouse cursor is over right column of a valid list item
    // .. we display narative as hint only if narrative is wider than column
    StrW := LV.StringWidth(Item.SubItems[0]);
    if StrW > LV.Columns[1].WidthType - 12 then
      SetHint(Item.SubItems[0])
    else
      SetHint('');
  end
  else
    // Mouse is not over an area containing narative text: no hint
    SetHint('');
end;

procedure TMainForm.sbFileNameClick(Sender: TObject);
  // Get a file name from uer and display in edit box
begin
  if dlgBrowse.Execute then
    edFileName.Text := dlgBrowse.FileName;
end;

procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
  // Catch name of file dropped on window and enter in edit control
var
  NumDropped: Integer;  // no of files dropped
  NameLen: Integer;     // length of a file name
  FileName: string;     // name of a dropped file
begin
  inherited;
  // Find number of files dropped
  NumDropped := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0);
  try
    if NumDropped > 0 then
    begin
      // Find size required for filename buffer (without terminal #0)
      NameLen := DragQueryFile(Msg.Drop, 0, nil, 0);
      // Get name of dropped file: only interested in first if more than 1
      SetLength(FileName, NameLen);   // Delphi adds space for terminal #0
      DragQueryFile(Msg.Drop, 0, PChar(FileName), NameLen + 1);
      // Place name of file in edit control
      edFileName.Text := FileName;
    end;
  finally
    // Release handle assoc. with drag/drop
    DragFinish(Msg.Drop);
  end;
end;

end.