Um dos recursos disponibilizados pelo Delphi é a customização das informações de versão a serem "anexadas" na linkagem.
Pouco utilizado, este recurso é muito interessante, pois possibilita o cadastro de diversas informações sobre o arquivo gerado, como: número de versão, nome do produto, nome interno do arquivo, nome da empresa, etc.
Podemos alterar as informações na página "Version Info", da página "Project Options":
Atenção com o item "Auto-increment build number": ele só será incrementado automaticamente quando for executada a opção "Build All" para compilar o projeto.
Porém, não existem rotinas "prontas" para obtermos estas informações. É necessário fazermos chamadas diretamente a API Win32, mais espeficamente, para as funções como a "GetFileVersionInfo" e a "VerQueryValue".
Abaixo encontramos uma função, a "FileVerInfo", que exemplifica o processo de obtenção das informações. Ela irá retornar "True" caso o arquivo informado no parâmetro "FileName" possuir as informações de versão, e devolverá por referência um "TStringList" contendo as informações.
//Código
function FileVerInfo(const FileName: string; var FileInfo: TStringList): Boolean;
const
Key: array[1..9] of string =('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments');
KeyBr: array [1..9] of string = ('Empresa', 'Descricao', 'Versao do Arquivo', 'Nome Interno', 'Copyright', 'Nome Original do Arquivo', 'Produto', 'Versao do Produto', 'Comentarios');
var
Dummy : THandle;
BufferSize, Len : Integer;
Buffer : PChar;
LoCharSet, HiCharSet : Word;
Translate, Return : Pointer;
StrFileInfo, Flags : string;
TargetOS, TypeArq : string;
FixedFileInfo : Pointer;
i : Byte;
begin
Result := False;
{ Obtemos o tamanho em bytes do "version information" }
BufferSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
if BufferSize <> 0 then
begin
GetMem(Buffer, Succ(BufferSize));
try
if GetFileVersionInfo(PChar(FileName), 0, BufferSize,
Buffer) then
{ Executamos a função "VerQueryValue" e conseguimos informações sobre o idioma /character-set }
if VerQueryValue(Buffer, '\VarFileInfo\Translation', Translate, UINT(Len)) then
begin
LoCharSet := LoWord(Longint(Translate^));
HiCharSet := HiWord(Longint(Translate^));
for i := 1 to 9 do
begin
{ Montamos a string de pesquisa }
StrFileInfo := Format('\StringFileInfo\0%x0%x\%s', [LoCharSet, HiCharSet, Key[i]]);
{ Adicionamos cada key pré-definido }
if VerQueryValue(Buffer,PChar(StrFileInfo), Return, UINT(Len)) then
FileInfo.Add(KeyBr[i] + ': ' + PChar(Return));
end;
if VerQueryValue(Buffer,'\',FixedFileInfo, UINT(Len))
then
with TVSFixedFileInfo(FixedFileInfo^) do
begin
Flags := '';
{Efetuamos um bitmask e obtemos os "flags" do arquivo}
if (dwFileFlags and VS_FF_DEBUG) = VS_FF_DEBUG then
Flags := Concat(Flags,'*Debug* ');
if (dwFileFlags and VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD then
Flags := Concat(Flags, '*Special Build* ');
if (dwFileFlags and VS_FF_PRIVATEBUILD) = VS_FF_PRIVATEBUILD then
Flags := Concat(Flags, '*Private Build* ');
if (dwFileFlags and VS_FF_PRERELEASE) = VS_FF_PRERELEASE then
Flags := Concat(Flags, '*Pre-Release Build* ');
if (dwFileFlags and VS_FF_PATCHED) = VS_FF_PATCHED then
Flags := Concat(Flags, '*Patched* ');
if Flags <> '' then FileInfo.Add('Atributos: ' + Flags);
TargetOS := 'Plataforma (OS): ';
{ Plataforma }
case dwFileOS of
VOS_UNKNOWN :
TargetOS := Concat(TargetOS, 'Desconhecido');
VOS_DOS :
TargetOS := Concat(TargetOS, 'MS-DOS');
VOS_OS216 :
TargetOS := Concat(TargetOS, '16-bit OS/2');
VOS_OS232 :
TargetOS := Concat(TargetOS, '32-bit OS/2');
VOS_NT :
TargetOS := Concat(TargetOS, 'Windows NT');
VOS_NT_WINDOWS32, 4:
TargetOS := Concat(TargetOS, 'Win32 API');
VOS_DOS_WINDOWS16:
TargetOS := Concat(TargetOS, '16-bit Windows ',
'sob MS-DOS');
else
TargetOS := Concat(TargetOS, 'Fora do Padrão. Código: ', IntToStr(dwFileOS));
end;
FileInfo.Add(TargetOS);
TypeArq := 'Tipo de Arquivo: ';
{ Tipo de Arquivo }
case dwFileType of
VFT_UNKNOWN :
TypeArq := Concat(TypeArq,'Desconhecido');
VFT_APP : TypeArq := Concat(TypeArq,'Aplicacao');
VFT_DLL : TypeArq := Concat(TypeArq,'Dynamic-Link Lib.');
VFT_DRV : begin
TypeArq := Concat(TypeArq,'Device driver - Driver ');
case dwFileSubtype of VFT2_UNKNOWN : TypeArq := Concat (TypeArq, 'Desconhecido');
VFT2_DRV_PRINTER : TypeArq := Concat(TypeArq,'de Impressao');
VFT2_DRV_KEYBOARD : TypeArq := Concat(TypeArq,'de Teclado');
VFT2_DRV_LANGUAGE : TypeArq := Concat(TypeArq,'de Idioma');
VFT2_DRV_DISPLAY : TypeArq := Concat(TypeArq,'de Vídeo');
VFT2_DRV_MOUSE : TypeArq := Concat(TypeArq,'de Mouse');
VFT2_DRV_NETWORK : TypeArq := Concat(TypeArq,'de Rede');
VFT2_DRV_SYSTEM : TypeArq := Concat(TypeArq,'de Sistema');
VFT2_DRV_INSTALLABLE : TypeArq := Concat(TypeArq,'Instalavel');
VFT2_DRV_SOUND : TypeArq := Concat(TypeArq,'Multimida');
end;
end;
VFT_FONT : begin
TypeArq := Concat(TypeArq,'Fonte - Fonte ');
case dwFileSubtype of VFT2_UNKNOWN : TypeArq := Concat(TypeArq, 'Desconhecida');
VFT2_FONT_RASTER : TypeArq := Concat(TypeArq,'Raster');
VFT2_FONT_VECTOR : TypeArq := Concat(TypeArq,'Vetorial');
VFT2_FONT_TRUETYPE : TypeArq := Concat(TypeArq,'TrueType');
end;
end;
VFT_VXD : TypeArq := Concat(TypeArq,'Virtual Device');
VFT_STATIC_LIB
: TypeArq := Concat(TypeArq,'Static-Link Lib.');
end;
FileInfo.Add(TypeArq);
end;
end;
finally
FreeMem(Buffer, Succ(BufferSize));
Result := FileInfo.Text <> '';
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
StrLst: TStringList;
begin
StrLst := TStringList.Create;
try
FileVerInfo('C:\WINDOWS\SYSTEM\TAPI.DLL', StrLst);
Memo1.Lines.Assign(StrLst);
finally
StrLst.Free;
end;
end;
Nenhum comentário:
Postar um comentário