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
public
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.