Ver Mensaje Individual
  #6  
Antiguo 26-09-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
agustibaldo,

Cita:
Empezado por agustibaldo
...Caracteres extraños al ejecutar función <GetFileVersionInfo>...
Revisa este código:
Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TFileVersion = Record
    CompanyName : String;
    FileDescription : String;
    FileVersion : String;
    InternalName : String;
    LegalCopyright : String;
    LegalTrademarks : String;
    OriginalFileName : String;
    ProductName : String;
    ProductVersion : String;
    Comments : String;
    PrivateBuild : String;
    SpecialBuild : String;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetFileInfo(const FileName: String): TFileVersion;
type
   PLandCodepage = ^TLandCodepage;
   TLandCodepage = Record
      Language : Word;
      CodePage : Word;
   end;

var
   Dummy,
   LenBuffer: Cardinal;
   Buffer, lpBuffer: Pointer;
   Language: String;

begin

   LenBuffer := GetFileVersionInfoSize(PChar(FileName), Dummy);

   if LenBuffer = 0 then
      RaiseLastOSError;

   GetMem(Buffer, LenBuffer);

   try

      if not GetFileVersionInfo(PChar(FileName), 0, LenBuffer, Buffer) then
         RaiseLastOSError;

      if not VerQueryValue(Buffer, '\VarFileInfo\Translation\', lpBuffer, LenBuffer) then
         RaiseLastOSError;

      Language := Format('%.4x%.4x', [PLandCodepage(lpBuffer)^.Language, PLandCodepage(lpBuffer)^.CodePage]);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\CompanyName'), lpBuffer, LenBuffer) then
         Result.CompanyName := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\FileDescription'), lpBuffer, LenBuffer) then
         Result.FileDescription := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\FileVersion'), lpBuffer, LenBuffer) then
         Result.FileVersion := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\InternalName'), lpBuffer, LenBuffer) then
         Result.InternalName := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\LegalCopyright'), lpBuffer, LenBuffer) then
         Result.LegalCopyright := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\LegalTrademarks'), lpBuffer, LenBuffer) then
         Result.LegalTrademarks := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\OriginalFileName'), lpBuffer, LenBuffer) then
         Result.OriginalFileName := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\ProductName'), lpBuffer, LenBuffer) then
         Result.ProductName := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\ProductVersion'), lpBuffer, LenBuffer) then
         Result.ProductVersion := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\Comments'), lpBuffer, LenBuffer) then
         Result.Comments := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\PrivateBuild'), lpBuffer, LenBuffer) then
         Result.PrivateBuild := PChar(lpBuffer);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\SpecialBuild'), lpBuffer, LenBuffer) then
         Result.SpecialBuild := PChar(lpBuffer);

   finally

      FreeMem(Buffer);

   end;

end;

function GetFileDescription(const FileName: String): String;
type
   PLandCodepage = ^TLandCodepage;
   TLandCodepage = Record
      Language : Word;
      CodePage : Word;
   end;

var
   Dummy,
   LenBuffer: Cardinal;
   Buffer, lpBuffer: Pointer;
   Language: String;

begin

   LenBuffer := GetFileVersionInfoSize(PChar(FileName), Dummy);

   if LenBuffer = 0 then
      Exit;

   GetMem(Buffer, LenBuffer);

   try

      GetFileVersionInfo(PChar(FileName), 0, LenBuffer, Buffer);

      VerQueryValue(Buffer, '\VarFileInfo\Translation\', lpBuffer, LenBuffer);

      Language := Format('%.4x%.4x', [PLandCodepage(lpBuffer)^.Language, PLandCodepage(lpBuffer)^.CodePage]);

      if VerQueryValue(Buffer, PChar('\StringFileInfo\' + Language + '\FileDescription'), lpBuffer, LenBuffer) then
         Result := PChar(lpBuffer);

   finally

      FreeMem(Buffer);

   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   FileVersion : TFileVersion;

begin

   FileVersion := GetFileInfo(Application.ExeName);

   ListBox1.Clear;

   if FileVersion.CompanyName <> EmptyStr then
      ListBox1.Items.Add('CompanyName: ' + FileVersion.CompanyName);

   if FileVersion.FileDescription <> EmptyStr then
      ListBox1.Items.Add('FileDescription: ' + FileVersion.FileDescription);

   if FileVersion.FileVersion <> EmptyStr then
      ListBox1.Items.Add('FileVersion: ' + FileVersion.FileVersion);

   if FileVersion.InternalName <> EmptyStr then
      ListBox1.Items.Add('InternalName: ' + FileVersion.InternalName);

   if FileVersion.LegalCopyright <> EmptyStr then
      ListBox1.Items.Add('LegalCopyright: ' + FileVersion.LegalCopyright);

   if FileVersion.LegalTrademarks <> EmptyStr then
      ListBox1.Items.Add('LegalTrademarks: ' + FileVersion.LegalTrademarks);

   if FileVersion.OriginalFileName <> EmptyStr then
      ListBox1.Items.Add('OriginalFileName: ' + FileVersion.OriginalFileName);

   if FileVersion.ProductName <> EmptyStr then
      ListBox1.Items.Add('ProductName: ' + FileVersion.ProductName);

   if FileVersion.ProductVersion <> EmptyStr then
      ListBox1.Items.Add('ProductVersion: ' + FileVersion.ProductVersion);

   if FileVersion.Comments <> EmptyStr then
      ListBox1.Items.Add('Comments: ' + FileVersion.Comments);

   if FileVersion.PrivateBuild <> EmptyStr then
      ListBox1.Items.Add('PrivateBuild: ' + FileVersion.PrivateBuild);

   if FileVersion.SpecialBuild <> EmptyStr then
      ListBox1.Items.Add('SpecialBuild: ' + FileVersion.SpecialBuild);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   ShowMessage(GetFileDescription(Application.ExeName));
end;

end.
El código anterior en Delphi 7 y Delphi 2010 sobre Windows 7 Professional x32, muestra la información asociada al ejecutable de la aplicación por medio de las APIs GetFileVersionInfoSize, GetFileVersionInfo y VerQueryValue.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 26-09-2013 a las 01:13:46.
Responder Con Cita