Bir programın sürümünü nasıl alırım?
csyasar30.04.2004 - 15:50:48
procedure GetBuildInfo(const AppName: string;
var V1, V2, V3, V4: Word);
var
VerInfoSize,
VerValueSize,
Dummy : DWORD;
VerInfo : Pointer;
VerValue : PVSFixedFileInfo;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(AppName), Dummy);
GetMem(VerInfo, VerInfoSize);
GetFileVersionInfo(PChar(AppName), 0, VerInfoSize, VerInfo);
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
with VerValue^ do
begin
V1 := dwFileVersionMS shr 16;
V2 := dwFileVersionMS and $FFFF;
V3 := dwFileVersionLS shr 16;
V4 := dwFileVersionLS and $FFFF;
end;
FreeMem(VerInfo, VerInfoSize);
end;

// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
var v1, v2, v3, v4: word;
begin
GetBuildInfo('C:\windows\notepad.exe', v1, v2, v3, v4);
Label1.Caption := Format('%d.%d.%d.%d', [V1, V2, V3, V4]);
end;
 
mege19.08.2004 - 18:27:41
Diğer elde edilebilir bilgiler, test edildi, delphi 7

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TFileVersionInfo = record
fCompanyName,
fFileDescription,
fFileVersion,
fInternalName,
fLegalCopyRight,
fLegalTradeMark,
fOriginalFileName,
fProductName,
fProductVersion,
fComments: string;
end;


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

var
Form1: TForm1;
FileVersionInfo: TFileVersionInfo;

implementation

{$R *.dfm}
procedure GetAppVersionInfo(sAppNamePath: string);
var
VerSize: integer;
VerBuf: PChar;
VerBufValue: pointer;
{$IFDEF Delphi3Below}
VerHandle: integer;
VerBufLen: integer;
{$ELSE}
VerHandle: cardinal;
VerBufLen: cardinal;
{$ENDIF}
VerKey: string;

function GetInfo(ThisKey: string): string;
begin
Result := '';
VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +
IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey;
if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then
Result := StrPas(VerBufValue);
end;

function QueryValue(ThisValue: string): string;
begin
Result := '';
if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and
VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then
Result := GetInfo(ThisValue);
end;

begin
if sAppNamePath = '' then
sAppNamePath := Application.ExeName;
VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
VerBuf := AllocMem(VerSize);
try
FileVersionInfo.fCompanyName := QueryValue('CompanyName');
FileVersionInfo.fFileDescription := QueryValue('FileDescription');
FileVersionInfo.fFileVersion := QueryValue('FileVersion');
FileVersionInfo.fInternalName := QueryValue('InternalName');
FileVersionInfo.fLegalCopyRight := QueryValue('LegalCopyRight');
FileVersionInfo.fLegalTradeMark := QueryValue('LegalTradeMark');
FileVersionInfo.fOriginalFileName := QueryValue('OriginalFileName');
FileVersionInfo.fProductName := QueryValue('ProductName');
FileVersionInfo.fProductVersion := QueryValue('ProductVersion');
FileVersionInfo.fComments := QueryValue('Comments');
finally
FreeMem(VerBuf, VerSize);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
GetAppVersionInfo(opendialog1.FileName);
showmessage('Özellikler : ' + #13+
'-----------------------------------' + #13+
'Şirket İsmi : ' + FileVersionInfo.fCompanyName + #13+
'Dosya Açıklaması : ' + FileVersionInfo.fFileDescription + #13+
'Dosya Versiyonu : ' + FileVersionInfo.fFileVersion + #13+
'Ürün Versiyonu : ' + FileVersionInfo.fProductVersion + #13
);
end
end;

end.


http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20648608.html
 
NOT : Bu sayfa google'un siteyi indekslemesi içindir. www.delphiturkiye.com/forum/ adresini kullanınız!
1998-2006 www.delphiturkiye.com