Este ejemplo muestra cómo obtener la información de un fichero ejecutable o de una librería (versión, extensión, nombre, compañía, descripción, tamaño, fecha de creación, fecha de última modificación, fecha de último acceso, ...). Para ello hemos utilizado varias funcines del Api de Windows: "GetFileVersionInfo", "GetFileTime", ... a continuación mostramos el código fuente/Source code completo en Delphi 6:

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, shellapi;

type
  TformMenuPrincipal = class(TForm)
    txtFichero: TEdit;
    Label1: TLabel;
    bSeleccionar: TButton;
    dlAbrir: TOpenDialog;
    bInformacionFichero: TButton;
    lInfo: TMemo;
    Label2: TLabel;
    bGuardar: TButton;
    Button1: TButton;
    dlGuardar: TSaveDialog;
    LWEB: TLabel;
    procedure bSeleccionarClick(Sender: TObject);
    procedure bInformacionFicheroClick(Sender: TObject);

    //para arrastrar y soltar
    procedure SoltarFichero  (var Msg: TWMDropFiles); message WM_DROPFILES;
  
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure bGuardarClick(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

//si se utilizar drag and drop (arrastrar y soltar)
procedure TformMenuPrincipal.SoltarFichero (var Msg : TWMDropFiles);
var
  CFileName: array[0..MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
    begin
      txtFichero.Text := CFileName;
      bInformacionFicheroClick(nil);
      Msg.Result := 0;
    end;
  finally
    DragFinish(Msg.Drop); //finaliza arrastrar y soltar
  end;
end;


function versionFichero (const FileName: TFileName; var Major, Minor, Release, Build : word): boolean;
var
  size, len: longword;
  handle: THandle;
  buffer: pchar;
  pinfo: ^VS_FIXEDFILEINFO;
begin
  Result := False;
  size := GetFileVersionInfoSize(Pointer(FileName), handle);
  if size > 0 then begin
    GetMem(buffer, size);
    if GetFileVersionInfo(Pointer(FileName), 0, size, buffer)
    then
      if VerQueryValue(buffer, '\', pointer(pinfo), len) then begin
        Major   := HiWord(pinfo.dwFileVersionMS);
        Minor   := LoWord(pinfo.dwFileVersionMS);
        Release := HiWord(pinfo.dwFileVersionLS);
        Build   := LoWord(pinfo.dwFileVersionLS);
        Result  := True;
      end;
    FreeMem(buffer);
  end;
end;


procedure TformMenuPrincipal.bSeleccionarClick(Sender: TObject);
begin
  dlAbrir.Title := 'Seleccione el fichero...';
  dlAbrir.Filter := 'Aplicación (*.exe)|*.exe|Librería (*.dll)|*.dll|Com (*.com)|*.com|Todos los archivos (*.*)|*.*';
  if dlAbrir.Execute then
  begin
    txtFichero.Text := dlAbrir.FileName;
    bInformacionFicheroClick(nil);
  end;
end;

function obtenerInfoFichero (info : string; fichero : string) : string;
type
  PaLeerBuffer = array [0..MAX_PATH] of char;
var
  Size, Size2 : DWord;
  Pt, Pt2 : Pointer;
  Idioma : string;
begin
  Result := '';
  Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  if Size > 0 then
  begin
    GetMem (Pt, Size);
    if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
    begin
      VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
      Idioma:=IntToHex( DWord(Pt2^) ,8 );
      Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
      VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
      if Size2 > 0 then
      begin
       Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);
      end
      else
        result := '';
      FreeMem (Pt);
    end;
  end
  else
    result := '';
end;

function tamanoFichero (sFileToExamine: string) : Integer;
var
  SearchRec: TSearchRec;
  sgPath: string;
  inRetval, I1: Integer;
begin
  sgPath := ExpandFileName(sFileToExamine);
  try
    inRetval := FindFirst(ExpandFileName(sFileToExamine), faAnyFile, SearchRec);
    if inRetval = 0 then
      I1 := SearchRec.Size
    else
      I1 := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
  Result := I1;
end;


function quitarExtension (nombreFichero : string) : string;
begin
  result := copy(ExtractFileName(nombreFichero), 1,
      pos(ExtractFileExt(nombreFichero), ExtractFileName(nombreFichero)) - 1);
end;


function obtenerFechasFichero (const FileName: string; var Created: TDateTime;
         var Accessed: TDateTime; var Modified: TDateTime): Boolean;
var
  h: THandle;
  Info1, Info2, Info3: TFileTime;
  SysTimeStruct: SYSTEMTIME;
  TimeZoneInfo: TTimeZoneInformation;
  Bias: Double;
begin
  Result := False;
  Bias   := 0;
  h      := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if h > 0 then
  begin
    try
      if GetTimeZoneInformation(TimeZoneInfo) <> $FFFFFFFF then
        Bias := TimeZoneInfo.Bias / 1440; // 60x24
      GetFileTime(h, @Info1, @Info2, @Info3);
      if FileTimeToSystemTime(Info1, SysTimeStruct) then
        Created := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info2, SysTimeStruct) then
        Accessed := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info3, SysTimeStruct) then
        Modified := SystemTimeToDateTime(SysTimeStruct) - Bias;
      Result := True;
    finally
      FileClose(h);
    end;
  end;
end;


procedure TformMenuPrincipal.bInformacionFicheroClick(Sender: TObject);
var
  major, minor, release, build : word;
  version : string;
  sizeFichero : Longint;
  fechaCreacion, ultimoAcceso, ultimaModificacion : TDateTime;
begin
  if versionFichero(txtFichero.Text,major,minor,release, build) then
    version := Format('Versión: %d.%d.%d.%d', [Major, Minor, Release, Build])
  else
    version := 'Versión no disponible';
  lInfo.Clear;
  lInfo.Lines.Add('Nombre: ' + ExtractFileName(txtFichero.Text));
  lInfo.Lines.Add('Extensión: ' + ExtractFileExt(txtFichero.Text));
  lInfo.Lines.Add('Ubicación: ' + ExtractFilePath(txtFichero.Text));
  lInfo.Lines.Add('Nombre sin extensión: ' + quitarExtension (extractfilename(txtFichero.text)));
  lInfo.Lines.Add(version);
  lInfo.Lines.Add('Compañía: ' + obtenerInfoFichero ('CompanyName', txtFichero.Text));
  lInfo.Lines.Add('Descripción: ' + obtenerInfoFichero ('FileDescription', txtFichero.Text));
  lInfo.Lines.Add('Nombre interno: ' + obtenerInfoFichero ('InternalName', txtFichero.Text));
  lInfo.Lines.Add('Derechos de copia: ' + obtenerInfoFichero ('LegalCopyright', txtFichero.Text));
  lInfo.Lines.Add('Nombre original: ' + obtenerInfoFichero ('OriginalFilename', txtFichero.Text));
  lInfo.Lines.Add('Nombre producto: ' + obtenerInfoFichero ('ProductName', txtFichero.Text));
  lInfo.Lines.Add('Versión producto: ' + obtenerInfoFichero ('ProductVersion', txtFichero.Text));
  lInfo.Lines.Add('Versión fichero: ' + obtenerInfoFichero ('FileVersion', txtFichero.Text));
  lInfo.Lines.Add('Comentarios: ' + obtenerInfoFichero ('Comments', txtFichero.Text));
  sizeFichero := tamanoFichero(txtFichero.Text);
  if sizeFichero = 0 then
    lInfo.Lines.Add('Tamaño (Bytes): Para obtener el tamaño el fichero debe estar cerrado.')
  else
    lInfo.Lines.Add('Tamaño (Bytes): ' + IntToStr(tamanoFichero(txtFichero.Text)));

  //fechas
  if obtenerFechasFichero (txtFichero.Text, fechaCreacion, ultimoAcceso, ultimaModificacion) then
  begin
    lInfo.Lines.Add('Fecha creación: ' + DateToStr (fechaCreacion));
    lInfo.Lines.Add('Fecha último acceso: ' + DateToStr(ultimoAcceso));
    lInfo.Lines.Add('Fecha modificación: ' + DateToStr(ultimaModificacion));
  end;
end;


function GetFileTimes(const FileName: string; var Created: TDateTime;
var Accessed: TDateTime; var Modified: TDateTime): Boolean;
var
  h: THandle;
  Info1, Info2, Info3: TFileTime;
  SysTimeStruct: SYSTEMTIME;
  TimeZoneInfo: TTimeZoneInformation;
  Bias: Double;
begin
  Result := False;
  Bias   := 0;
  h      := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if h > 0 then
  begin
    try
      if GetTimeZoneInformation(TimeZoneInfo) <> $FFFFFFFF then
        Bias := TimeZoneInfo.Bias / 1440; // 60x24
      GetFileTime(h, @Info1, @Info2, @Info3);
      if FileTimeToSystemTime(Info1, SysTimeStruct) then
        Created := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info2, SysTimeStruct) then
        Accessed := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info3, SysTimeStruct) then
        Modified := SystemTimeToDateTime(SysTimeStruct) - Bias;
      Result := True;
    finally
      FileClose(h);
    end;
  end;
end;


procedure TformMenuPrincipal.FormCreate(Sender: TObject);
begin
  //permitimos arrastrar y soltar
  DragAcceptFiles(Handle, True);
  if ParamCount > 0 then
  begin
    if ParamStr(1) <> '' then
    begin
      if FileExists(ParamStr(1)) then
      begin
        txtFichero.Text := ParamStr(1);
        bInformacionFicheroClick(nil);
      end;
    end;
  end
  else
    txtFichero.Text := Application.ExeName;
end;

procedure TformMenuPrincipal.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TformMenuPrincipal.bGuardarClick(Sender: TObject);
begin
  dlGuardar.Title := 'Guardar información de fichero...';
  dlGuardar.FileName := ChangeFileExt(ExtractFileName(txtFichero.Text), '.txt');
  if dlGuardar.Execute then
    lInfo.Lines.SaveToFile (dlGuardar.FileName);  
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.

Publicado el: 2005-03-25